equal
deleted
inserted
replaced
11 my $csvfile; #output csv file name |
11 my $csvfile; #output csv file name |
12 my $authon= ''; #does it require authorisation? default is false |
12 my $authon= ''; #does it require authorisation? default is false |
13 |
13 |
14 my $ispackage; |
14 my $ispackage; |
15 my $summaryheader="ID\tPackage\tFeatures\tFormat\tHttp\n" ; |
15 my $summaryheader="ID\tPackage\tFeatures\tFormat\tHttp\n" ; |
|
16 my $newtdformat = 0; |
16 |
17 |
17 sub getpage |
18 sub getpage |
18 { |
19 { |
19 #arguments |
20 #arguments |
20 ($page,$host,$auth,$myfile)=@_; |
21 ($page,$host,$auth,$myfile)=@_; |
52 sub prntfeatures |
53 sub prntfeatures |
53 { |
54 { |
54 |
55 |
55 ($release,$package,$features,$myfile,$domain)=@_; |
56 ($release,$package,$features,$myfile,$domain)=@_; |
56 |
57 |
|
58 $release =~ s/\\//sg; |
|
59 |
|
60 if ($newtdformat) { |
|
61 $package =~ s/backlog//sgi; |
|
62 print $myfile " $release, $domain, $package, $myfeat\n"; |
|
63 |
|
64 } else { |
|
65 |
57 $features = $features."<dt"; |
66 $features = $features."<dt"; |
58 |
67 |
59 |
68 |
60 |
69 |
61 while ( $features =~ /dt\>(.*?)\<\/dt(.*?)\<dt/sg ){ |
70 while ( $features =~ /dt\>(.*?)\<\/dt(.*?)\<dt/sg ){ |
74 undef $mystr; |
83 undef $mystr; |
75 $mysubfeat =~ s/,/ /sg; |
84 $mysubfeat =~ s/,/ /sg; |
76 $mysubfeat =~ s/\n//sg; |
85 $mysubfeat =~ s/\n//sg; |
77 $mysubfeat =~ s/\<.*?\>//sg; |
86 $mysubfeat =~ s/\<.*?\>//sg; |
78 |
87 |
79 $release =~ s/\\//sg; |
88 |
80 print $myfile " $release, $domain, $package, $myfeat, $mysubfeat\n"; |
89 print $myfile " $release, $domain, $package, $myfeat, $mysubfeat\n"; |
81 |
90 |
82 $mysubfeat = ""; |
91 $mysubfeat = ""; |
83 } |
92 } |
84 |
93 |
85 |
94 } |
86 } |
95 } |
87 |
96 |
88 sub loadfile |
97 sub loadfile |
89 { |
98 { |
90 |
99 |
108 |
117 |
109 $roadmap=loadfile $infile; |
118 $roadmap=loadfile $infile; |
110 open ( outputfile, ">>".$outfile); |
119 open ( outputfile, ">>".$outfile); |
111 |
120 |
112 |
121 |
113 |
122 if ($newtdformat) { |
114 foreach (@releases) { |
123 print "Processing new TD roadmap format\n"; |
115 |
124 if ($roadmap =~ m /Contents\<\/h2\>.*?\<\/table/sg) { $roadmap =$';} |
116 $exp="\\<h2\\>.*?\\>".$_; |
125 foreach (@releases) { |
117 |
126 $exp=$_." Roadmap"; |
|
127 |
|
128 if ($roadmap =~ m /($exp)/sg) { |
|
129 print "PASS - Found entry for $_ \n"; |
|
130 $relroad =$'; |
|
131 |
|
132 if ($roadmap =~ m /table\>(.*?)\<\/table/sg) { $relroad =$1;} |
|
133 |
|
134 while ($relroad =~ m/title\=\"(.*?)\"\>(.*)/g) { |
|
135 $package=$1; |
|
136 $myfeat=$2; |
|
137 $myfeat=~ s/\<\/td\>\<td\>/-/sg; #TODO change - to , when the old format is dead |
|
138 $myfeat=~ s/\<.*?\>//sg; |
|
139 prntfeatures($_,$package,$myfeat,outputfile,$domain); |
|
140 |
|
141 } |
|
142 } |
|
143 } |
|
144 } else { |
|
145 |
|
146 foreach (@releases) { |
|
147 |
|
148 $exp="\\<h2\\>.*?\\>".$_; |
|
149 |
118 if ($roadmap =~ m /($exp)/sg) { |
150 if ($roadmap =~ m /($exp)/sg) { |
119 print "PASS - Found entry for $_ \n"; |
151 print "PASS - Found entry for $_ \n"; |
120 $relroad =$'; |
152 $relroad =$'; |
121 |
153 |
122 if ($relroad =~ m /(.*?)\<h2/sg) { $relroad =$1;} |
154 if ($relroad =~ m /(.*?)\<h2/sg) { $relroad =$1;} |
136 prntfeatures($_,$pname[$i],$features,outputfile,$domain); |
168 prntfeatures($_,$pname[$i],$features,outputfile,$domain); |
137 @ppos =""; |
169 @ppos =""; |
138 @pname =""; |
170 @pname =""; |
139 undef ($features); |
171 undef ($features); |
140 } |
172 } |
141 |
173 } |
142 |
174 |
143 } |
175 } |
144 |
176 |
145 |
177 |
146 |
178 |
226 |
258 |
227 #help print |
259 #help print |
228 sub printhelp |
260 sub printhelp |
229 { |
261 { |
230 |
262 |
231 print "\n\n version 0.5 |
263 print "\n\n version 0.6 |
232 \ngettd.pl -t=url -d=domain \n\nrequired parameters:\n\t -t url containing the technology domain roadmap\n\t -d the technology domain name |
264 \ngettd.pl -t=url -d=domain \n\nRequired parameters for Technology Roadmaps:\n\t -t url containing the technology domain roadmap\n\t -d the technology domain name |
233 \n\nOptional parameters\n\t-o filename ,the output is logged into the output.csv file by default\n\t-h for help |
265 \n\nOptional Parmeters for Technology Roadmaps\n\t-new if the roadmap has the new wiki format |
234 \n\t-a setup authorisation by cookie follow instructions \n\tin http://developer.symbian.org/wiki/index.php/Roadmap_merger_script#Cookies |
266 \n\nRequired Parameters for Package backlogs\n\t-p for package backlog analysis. just run gettd.pl -p |
235 \n\t -p adds support for package backlog analysis. just run gettd.pl -p |
267 \n\nOptional Pararmeters for Package backlogs\n\t -compare [f1] [f2] compares two package summary files for changes ignores order |
236 \n\t -compare [f1] [f2] compares two package summary files for changes ignores order |
268 \n\nCommonOptional parameters\n\t-o filename ,the output is logged into the output.csv file by default\n\t-h for help |
237 \n\t recommend to run under cygwin environment\n"; |
269 \n\t recommend to run under cygwin environment and perl version v5.10.0 \n"; |
238 exit; |
270 exit; |
239 } |
271 } |
240 |
272 |
241 |
273 |
242 |
274 |
272 my $help; |
304 my $help; |
273 my @compare; |
305 my @compare; |
274 |
306 |
275 |
307 |
276 GetOptions('h' => \$help,'t=s'=> \$target_url, 'd=s' => \$tdomain , 'o=s' => \$csvfile, |
308 GetOptions('h' => \$help,'t=s'=> \$target_url, 'd=s' => \$tdomain , 'o=s' => \$csvfile, |
277 'a' => \$authon , 'p' => \$ispackage, 'compare=s{2}' =>\@compare); |
309 'a' => \$authon , 'p' => \$ispackage, 'compare=s{2}' =>\@compare, 'new' => \$isnewformat); |
278 |
310 |
279 if (@compare) { |
311 if (@compare) { |
280 compare_bklogs @compare; |
312 compare_bklogs @compare; |
281 |
313 |
282 } |
314 } |
290 |
322 |
291 $tdomain =" "; |
323 $tdomain =" "; |
292 $target_url = "http://developer.symbian.org/wiki/index.php/Category:Package_Backlog"; |
324 $target_url = "http://developer.symbian.org/wiki/index.php/Category:Package_Backlog"; |
293 |
325 |
294 } |
326 } |
295 |
327 if ($isnewformat){ |
|
328 $newtdformat = 1; |
|
329 |
|
330 } |
296 |
331 |
297 if ( not $target_url) { |
332 if ( not $target_url) { |
298 |
333 |
299 print "ERROR-missing arguments target url\n"; |
334 print "ERROR-missing arguments target url\n"; |
300 printhelp; |
335 printhelp; |