/[gentoo-perl]/up2date-ng/trunk/bin/up2date-ng.pl
Gentoo

Contents of /up2date-ng/trunk/bin/up2date-ng.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 23 - (show annotations) (download) (as text)
Sat Apr 22 19:13:02 2006 UTC (8 years, 8 months ago) by ian
File MIME type: text/x-perl
File size: 24342 byte(s)
fixed ebuild-version-regexp; invented package.altname file to translate module names cpan<->portage
1 #!/usr/bin/perl
2
3 # -----------------------------------------------------------------------------
4 #
5 # up2date-ng.pl
6 #
7 # date : 2006-04-22
8 # author : Christian Hartmann <ian@gentoo.org>
9 # version : 0.14
10 # license : GPL-2
11 # description : Scripts that compares the versions of perl packages in portage
12 # with the version of the packages on CPAN
13 #
14 # header : $Header: $
15 #
16 # -----------------------------------------------------------------------------
17 #
18 # This program is free software; you can redistribute it and/or modify it under
19 # the terms of the GNU General Public License as published by the Free Software
20 # Foundation; either version 2 of the License, or (at your option) any later
21 # version.
22 #
23 # -----------------------------------------------------------------------------
24
25 # - modules >
26 use warnings;
27 use strict;
28 use DirHandle;
29 use CPAN;
30 use Term::ANSIColor;
31 use Getopt::Long;
32 Getopt::Long::Configure("bundling");
33
34 # - init vars & contants >
35 my $VERSION = "0.14";
36 my $portdir = getParamFromFile(getFileContents("/etc/make.conf"),"PORTDIR","lastseen") || "/usr/portage";
37 my @scan_portage_categories = qw(dev-perl perl-core);
38 my $package_mask_file = "up2date_package.mask";
39 my $package_altname_file = "up2date_package.altname";
40 my @timeData = localtime(time);
41 my %modules = ();
42 my @tmp_availableVersions = ();
43 my @packages2update = ();
44 my @tmp_v = ();
45 my %pmask = ();
46 my %paltname = ();
47 my @need_packagealtname = ();
48 my $p_modulename = "";
49 my $xml_packagelist_table = "";
50 my $mail_packagelist_table = "";
51 my $html_packagelist_table = "";
52 my $cat_pkg = "";
53 my $DEBUG = 0;
54 my $generate_xml = 0;
55 my $generate_mail = 0;
56 my $generate_html = 0;
57 my $generate_packagelist = 0;
58 my $generate_all = 0;
59 my $verbose = 0;
60 my $tmp;
61 my $mod;
62
63 # - init colors >
64 my $yellow = color("yellow bold");
65 my $green = color("bold green");
66 my $white = color("bold white");
67 my $cyan = color("bold cyan");
68 my $reset = color("reset");
69
70 # - get options >
71 printHeader();
72 GetOptions(
73 'generate-xml' => \$generate_xml,
74 'generate-mail' => \$generate_mail,
75 'generate-html' => \$generate_html,
76 'generate-packagelist' => \$generate_packagelist,
77 'generate-all' => \$generate_all,
78 'debug' => \$DEBUG,
79 'verbose|v' => \$verbose,
80 'help|h' => sub { printUsage(); }
81 ) || printUsage();
82
83 if ($generate_all)
84 {
85 $generate_xml=1;
86 $generate_mail=1;
87 $generate_html=1;
88 $generate_packagelist=1;
89 }
90 if ($generate_xml+$generate_mail+$generate_html+$generate_packagelist+$DEBUG+$verbose == 0) { printUsage(); }
91
92 # - Parse up2date_package.mask >
93 if (-f $package_mask_file)
94 {
95 print $green." *".$reset." parsing ".$package_mask_file."\n";
96
97 $pmask{'all'} = getFileContents($package_mask_file);
98
99 foreach my $line (split(/\n/,$pmask{'all'}))
100 {
101 $line=~s/^[ |\t]+//; # leading whitespaces and tabs
102 $line=~s/[ |\t]+$//; # trailing whitespaces and tabs
103 $line=~s/#(.*)//g; # remove comments
104
105 if ($line ne "")
106 {
107 if (substr($line,0,2) eq ">=")
108 {
109 # - block package versions greater/equal then given version (e.g. >=dev-perl/Video-Info-0.999) >
110 $tmp=substr($line,2,length($line)-2);
111 $tmp=~s/([a-zA-Z\-]+)\/([a-zA-Z\-]+)-([0-9a-zA-Z\._\-]+)/$1\/$2/;
112 $pmask{'package'}{$tmp}{'version'}=$3;
113 $pmask{'package'}{$tmp}{'operator'}=">=";
114 }
115 elsif (substr($line,0,1) eq ">")
116 {
117 # - block package versions greater then given version (e.g. >dev-perl/Video-Info-0.993) >
118 $tmp=substr($line,1,length($line)-1);
119 $tmp=~s/([a-zA-Z\-]+)\/([a-zA-Z\-]+)-([0-9a-zA-Z\._\-]+)/$1\/$2/;
120 $pmask{'package'}{$tmp}{'version'}=$3;
121 $pmask{'package'}{$tmp}{'operator'}=">";
122 }
123 elsif (substr($line,0,1) eq "=")
124 {
125 # - block one package version (e.g. =dev-perl/Video-Info-0.999) >
126 $tmp=substr($line,1,length($line)-1);
127 $tmp=~s/([a-zA-Z\-]+)\/([a-zA-Z\-]+)-([0-9a-zA-Z\._\-]+)/$1\/$2/;
128 $pmask{'package'}{$tmp}{'version'}=$3;
129 $pmask{'package'}{$tmp}{'operator'}="=";
130 }
131 else
132 {
133 # - block whole package (e.g. dev-perl/Video-Info) >
134 $tmp=$line;
135 $pmask{'package'}{$tmp}{'operator'}="*";
136 $pmask{'package'}{$tmp}{'version'}=0;
137 }
138
139 if ($DEBUG)
140 {
141 print "package: ".$tmp."\n";
142 print "pmask{'package'}{'".$tmp."'}{'version'} : ".$pmask{'package'}{$tmp}{'version'}."\n";
143 print "pmask{'package'}{'".$tmp."'}{'operator'}: ".$pmask{'package'}{$tmp}{'operator'}."\n";
144 print "\n";
145 }
146 }
147 }
148 }
149 else
150 {
151 print $green." *".$reset." No package.mask file available - Skipping\n";
152 }
153
154 # - Parse up2date_package.mask >
155 if (-f $package_altname_file)
156 {
157 print $green." *".$reset." parsing ".$package_altname_file."\n";
158
159 $paltname{'all'} = getFileContents($package_altname_file);
160
161 foreach my $line (split(/\n/,$paltname{'all'}))
162 {
163 $line=~s/^[ |\t]+//; # leading whitespaces and tabs
164 $line=~s/[ |\t]+$//; # trailing whitespaces and tabs
165 $line=~s/#(.*)//g; # remove comments
166
167 if ($line ne "" && $line ne " ")
168 {
169 $line=~s/[ |\t]+/ /; # remove multiple whitespaces and tabs
170 my @tmp=split(/ /,$line);
171
172 # - set $paltname{'portage'}{<portage-packagename>} = <cpan-packagename> (in lowercase) >
173 $paltname{'portage'}{lc($tmp[0])}=lc($tmp[1]);
174
175 if ($DEBUG) { print $tmp[0]." ".$paltname{'portage'}{lc($tmp[0])}."\n"; }
176 }
177 }
178 }
179 else
180 {
181 print $green." *".$reset." No package.altname file available - Skipping\n";
182 }
183
184 # - get package/version info from portage and cpan >
185 print "\n";
186 print $green." *".$reset." getting infos from CPAN\n";
187 getCPANPackages();
188 print "\n";
189 print $green." *".$reset." getting package information from portage-tree\n";
190 getPerlPackages();
191
192 # - get some work done >
193 foreach my $p_original_modulename (sort keys %{$modules{'portage_lc'}})
194 {
195 if ($DEBUG) { print $p_original_modulename."\n"; }
196 $p_modulename=$p_original_modulename;
197 $p_modulename=~s/-/::/g;
198
199 if (! defined $modules{'cpan_lc'}{$p_modulename})
200 {
201 # - Could not find a matching package name - probably not a CPAN-module >
202 if ($DEBUG) { print "- Could not find CPAN-Module ('".$p_modulename."') for package '".$p_original_modulename."'!\n"; }
203
204 # - Look for an entry in up2date_package.altname for this package >
205 if ($paltname{'portage'}{$p_original_modulename})
206 {
207 # - found entry in package.altname >
208 if ($paltname{'portage'}{$p_original_modulename} ne "-")
209 {
210 if ($DEBUG) { print "- Found entry for this package. Using '".$paltname{'portage'}{$p_original_modulename}."' now.\n"; }
211
212 $p_modulename=$paltname{'portage'}{$p_original_modulename};
213
214 if (! defined $modules{'cpan_lc'}{$p_modulename})
215 {
216 # - entry in package.altname does not match >
217 if ($DEBUG) { print "- Could not find CPAN-Module for given entry ('".$paltname{'portage'}{$p_original_modulename}."')! Please correct! Skipping..\n"; }
218 push(@need_packagealtname,$modules{'portage'}{$p_original_modulename}{'name'});
219 next;
220 }
221 }
222 else
223 {
224 # - Package has been marked as "non-CPAN-module" >
225 if ($DEBUG) { print "- Package '".$p_modulename."' has been marked as non-CPAN-module. Skipping.\n"; }
226 next;
227 }
228 }
229 else
230 {
231 # - no entry in package.altname found for $p_modulename >
232 if ($DEBUG) { print "- No entry in package.altname found for package '".$p_modulename."'!\n"; }
233 push(@need_packagealtname,$modules{'portage'}{$p_original_modulename}{'name'});
234 next;
235 }
236 }
237
238 # - Package found >
239
240 # - Convert portage version >
241 @tmp_v=split(/\./,$modules{'portage_lc'}{$p_original_modulename});
242 if ($#tmp_v > 1)
243 {
244 if ($DEBUG) { print " converting version -> ".$modules{'portage_lc'}{$p_original_modulename}; }
245 $modules{'portage_lc'}{$p_original_modulename}=$tmp_v[0].".";
246 for (1..$#tmp_v) { $modules{'portage_lc'}{$p_original_modulename}.= $tmp_v[$_]; }
247 if ($DEBUG) { print " -> ".$modules{'portage_lc'}{$p_original_modulename}."\n"; }
248 }
249
250 # - Convert CPAN version >
251 @tmp_v=split(/\./,$modules{'cpan_lc'}{$p_modulename});
252 if ($#tmp_v > 1)
253 {
254 if ($DEBUG) { print " converting version -> ".$modules{'cpan_lc'}{$p_modulename}; }
255 $modules{'cpan_lc'}{$p_modulename}=$tmp_v[0].".";
256 for (1..$#tmp_v) { $modules{'cpan_lc'}{$p_modulename}.= $tmp_v[$_]; }
257 if ($DEBUG) { print " -> ".$modules{'cpan_lc'}{$p_modulename}."\n"; }
258 }
259
260 # - Portage package matches CPAN package >
261 if ($modules{'cpan_lc'}{$p_modulename} > $modules{'portage_lc'}{$p_original_modulename})
262 {
263 # - package needs some lovin - check if package/version has been masked >
264 $cat_pkg = $modules{'portage'}{$p_original_modulename}{'category'}."/".$modules{'portage'}{$p_original_modulename}{'name'};
265
266 if (defined $pmask{'package'}{$cat_pkg}{'operator'})
267 {
268 # - package is masked >
269 if ($pmask{'package'}{$tmp}{'operator'} eq "*")
270 {
271 # - all versions of this package have been masked - skip >
272 if ($DEBUG) { print "All versions of this package have been masked - skip\n"; }
273 next;
274 }
275 elsif ($pmask{'package'}{$tmp}{'operator'} eq ">=")
276 {
277 # - all versions greater/equal than {'version'} have been masked >
278 if ($modules{'cpan_lc'}{$p_modulename} >= $pmask{'package'}{$tmp}{'version'})
279 {
280 # - cpan version has been masked - skip >
281 if ($DEBUG) { print "cpan version has been masked - skip\n"; }
282 next;
283 }
284 }
285 elsif ($pmask{'package'}{$tmp}{'operator'} eq ">")
286 {
287 # - all versions greater than {'version'} have been masked >
288 if ($modules{'cpan_lc'}{$p_modulename} > $pmask{'package'}{$tmp}{'version'})
289 {
290 # - cpan version has been masked - skip >
291 if ($DEBUG) { print "cpan version has been masked - skip\n"; }
292 next;
293 }
294 }
295 elsif ($pmask{'package'}{$tmp}{'operator'} eq "=")
296 {
297 # - this version has been masked >
298 if ($modules{'cpan_lc'}{$p_modulename} == $pmask{'package'}{$tmp}{'version'})
299 {
300 # - cpan version has been masked - skip >
301 if ($DEBUG) { print "cpan version has been masked - skip\n"; }
302 next;
303 }
304 }
305 }
306
307 if ($verbose) { print $modules{'portage'}{$p_original_modulename}{'category'}."/".$modules{'portage'}{$p_original_modulename}{'name'}." needs updating. Ebuild: ".$modules{'portage_lc'}{$p_original_modulename}."; CPAN: ".$modules{'cpan_lc'}{$p_modulename}."\n"; }
308
309 # - store packagename - it needs to be updated >
310 push(@packages2update,$modules{'portage'}{$p_original_modulename}{'category'}."/".$modules{'portage'}{$p_original_modulename}{'name'});
311
312 if ($generate_xml)
313 {
314 $xml_packagelist_table .= " <tr>\n";
315 $xml_packagelist_table .= " <ti>".$modules{'portage'}{$p_original_modulename}{'name'}."</ti>\n";
316 $xml_packagelist_table .= " <ti>".$modules{'portage_lc'}{$p_original_modulename}."</ti>\n";
317 $xml_packagelist_table .= " <ti>".$modules{'cpan_lc'}{$p_modulename}."</ti>\n";
318 $xml_packagelist_table .= " </tr>\n";
319 }
320
321 if ($generate_mail)
322 {
323 $mail_packagelist_table .= " ".$modules{'portage'}{$p_original_modulename}{'name'};
324 for(0..(35-length($modules{'portage_lc'}{$p_original_modulename})-length($p_original_modulename)))
325 {
326 $mail_packagelist_table .= " ";
327 }
328 $mail_packagelist_table .= " ".$modules{'portage_lc'}{$p_original_modulename};
329 for(0..(20-length($modules{'cpan_lc'}{$p_modulename})))
330 {
331 $mail_packagelist_table .= " ";
332 }
333 $mail_packagelist_table .= " ".$modules{'cpan_lc'}{$p_modulename};
334 $mail_packagelist_table .= "\n";
335 }
336
337 if ($generate_html)
338 {
339 $html_packagelist_table .= "\t\t\t<tr>\n";
340 $html_packagelist_table .= "\t\t\t\t<td>".$modules{'portage'}{$p_original_modulename}{'name'}."</td>\n";
341 $html_packagelist_table .= "\t\t\t\t<td>".$modules{'portage_lc'}{$p_original_modulename}."</td>\n";
342 $html_packagelist_table .= "\t\t\t\t<td>".$modules{'cpan_lc'}{$p_modulename}."</td>\n";
343 $html_packagelist_table .= "\t\t\t</tr>\n";
344 }
345 }
346 else
347 {
348 if ($DEBUG) { print $p_original_modulename." is uptodate\n"; }
349 }
350 }
351
352 print "\n";
353 print $green." *".$reset." total packages suspected as outdated: ".($#packages2update+1)."\n";
354 print "\n";
355
356 # - Generate xml >
357 if ($generate_xml)
358 {
359 print $green." *".$reset." called with --generate-xml\n";
360 my $xml = getFileContents("template_outdated-cpan-packages.xml");
361 my $dateXML = int($timeData[5]+1900)."-".($timeData[4]+1)."-".$timeData[3];
362 chomp($xml_packagelist_table);
363 $xml =~ s/<TMPL_PACKAGELIST_TABLE>/$xml_packagelist_table/;
364 $xml =~ s/<TMPL_VAR_DATE>/$dateXML/g;
365
366 print $green." *".$reset." creating outdated-cpan-packages.xml\n";
367 open(FH,">outdated-cpan-packages.xml") || die ("Cannot open/write to file outdated-cpan-packages.xml");
368 print FH $xml;
369 close(FH);
370 print $green." *".$reset." done!\n\n";
371 }
372
373 # - Generate mail >
374 if ($generate_mail)
375 {
376 print $green." *".$reset." called with --generate-mail\n";
377 my $mail = getFileContents("template_outdated-cpan-packages.mail");
378 $mail_packagelist_table .= "\nTotal packages suspected as outdated: ".($#packages2update+1)."\n";
379 $mail =~ s/<TMPL_PACKAGELIST_TABLE>/$mail_packagelist_table/;
380
381 print $green." *".$reset." creating outdated-cpan-packages.mail\n";
382 open(FH,">outdated-cpan-packages.mail") || die ("Cannot open/write to file outdated-cpan-packages.mail");
383 print FH $mail;
384 close(FH);
385 print $green." *".$reset." done!\n\n";
386 }
387
388 # - Generate html >
389 if ($generate_html)
390 {
391 print $green." *".$reset." called with --generate-html\n";
392 my $html = getFileContents("template_outdated-cpan-packages.html");
393 my $dateHTML = int($timeData[5]+1900)."-".($timeData[4]+1)."-".$timeData[3];
394 chomp($html_packagelist_table);
395 $html =~ s/<TMPL_PACKAGELIST_TABLE>/$html_packagelist_table/;
396 $html =~ s/<TMPL_VAR_DATE>/$dateHTML/g;
397
398 print $green." *".$reset." creating outdated-cpan-packages.html\n";
399 open(FH,">outdated-cpan-packages.html") || die ("Cannot open/write to file outdated-cpan-packages.html");
400 print FH $html;
401 close(FH);
402 print $green." *".$reset." done!\n\n";
403 }
404
405 # - Generate packagelist >
406 if ($generate_packagelist)
407 {
408 print $green." *".$reset." called with --generate-packagelist\n";
409 print $green." *".$reset." creating outdated-cpan-packages.packagelist\n";
410 open(FH,">outdated-cpan-packages.packagelist") || die ("Cannot open/write to file outdated-cpan-packages.packagelist");
411 foreach (@packages2update)
412 {
413 print FH $_."\n";
414 }
415 close(FH);
416 print $green." *".$reset." done!\n\n";
417 }
418
419 # - Any packages not found? Do we need additional entries in package.altname? >
420 if ($#need_packagealtname >= 0)
421 {
422 print $yellow." *".$reset." ".($#need_packagealtname+1)." packages were found where a package.altname entry is missing or wrong:\n";
423 foreach (@need_packagealtname)
424 {
425 print " - ".$_."\n";
426 }
427 print " Please add entries for these packages to the package.altname file.\n";
428 }
429
430 print "\n";
431 exit(0);
432
433 # -----------------------------------------------------------------------------
434 # subs >
435 # -----------------------------------------------------------------------------
436
437 sub getPerlPackages
438 {
439 my %excludeDirs = ("." => 1, ".." => 1, "metadata" => 1, "licenses" => 1, "eclass" => 1, "distfiles" => 1, "virtual" => 1, "profiles" => 1);
440 my @matches = ();
441 my $dhp;
442 my $tc;
443 my $tp;
444
445 foreach $tc (@scan_portage_categories)
446 {
447 $dhp = new DirHandle($portdir."/".$tc);
448 while (defined($tp = $dhp->read))
449 {
450 # - not excluded and $_ is a dir?
451 if (! $excludeDirs{$tp} && -d $portdir."/".$tc."/".$tp)
452 {
453 @tmp_availableVersions=();
454 my @tmp_availableEbuilds = getAvailableEbuilds($portdir,$tc."/".$tp);
455 foreach (@tmp_availableEbuilds)
456 {
457 push(@tmp_availableVersions,getEbuildVersionSpecial($_));
458 }
459
460 # - get highest version >
461 if ($#tmp_availableVersions>-1)
462 {
463 $modules{'portage_lc_realversion'}{lc($tp)}=(sort(@tmp_availableVersions))[$#tmp_availableVersions];
464 $modules{'portage_lc'}{lc($tp)}=$modules{'portage_lc_realversion'}{lc($tp)};
465
466 # - get rid of -rX >
467 $modules{'portage_lc'}{lc($tp)}=~s/([a-zA-Z0-9\-_\/]+)-r[0-9+]/$1/;
468 $modules{'portage_lc'}{lc($tp)}=~s/([a-zA-Z0-9\-_\/]+)-rc[0-9+]/$1/;
469 $modules{'portage_lc'}{lc($tp)}=~s/([a-zA-Z0-9\-_\/]+)_p[0-9+]/$1/;
470
471 # - get rid of other stuff we don't want >
472 $modules{'portage_lc'}{lc($tp)}=~s/([a-zA-Z0-9\-_\/]+)_alpha/$1/;
473 $modules{'portage_lc'}{lc($tp)}=~s/([a-zA-Z0-9\-_\/]+)_beta/$1/;
474 $modules{'portage_lc'}{lc($tp)}=~s/[a-zA-Z]+$//;
475
476 $modules{'portage'}{lc($tp)}{'name'}=$tp;
477 $modules{'portage'}{lc($tp)}{'category'}=$tc;
478 }
479 }
480 }
481 undef $dhp;
482 }
483 }
484
485 # Description:
486 # Returns the value of $param. Expects filecontents in $file.
487 # $valueOfKey = getParamFromFile($filecontents,$key);
488 # e.g.
489 # $valueOfKey = getParamFromFile(getFileContents("/path/to.ebuild","IUSE","firstseen");
490 sub getParamFromFile
491 {
492 my $file = shift;
493 my $param = shift;
494 my $mode = shift; # ("firstseen","lastseen") - default is "lastseen"
495 my $c = 0;
496 my $d = 0;
497 my @lines = ();
498 my @aTmp = (); # temp (a)rray
499 my $sTmp = ""; # temp (s)calar
500 my $text = ""; # complete text/file after being cleaned up and striped
501 my $value = ""; # value of $param
502 my $this = "";
503
504 # - 1. split file in lines >
505 @lines = split(/\n/,$file);
506
507 # - 2 & 3 >
508 for($c=0;$c<=$#lines;$c++)
509 {
510 # - 2. remove leading and trailing whitespaces and tabs from every line >
511 $lines[$c]=~s/^[ |\t]+//; # leading whitespaces and tabs
512 $lines[$c]=~s/[ |\t]+$//; # trailing whitespaces and tabs
513
514 # - 3. remove comments >
515 $lines[$c]=~s/#(.*)//g;
516
517 if ($lines[$c]=~/^$param="(.*)"/)
518 {
519 # single-line with quotationmarks >
520 $value=$1;
521
522 if ($mode eq "firstseen")
523 {
524 # - 6. clean up value >
525 $value=~s/^[ |\t]+//; # remove leading whitespaces and tabs
526 $value=~s/[ |\t]+$//; # remove trailing whitespaces and tabs
527 $value=~s/\t/ /g; # replace tabs with whitespaces
528 $value=~s/ {2,}/ /g; # replace 1+ whitespaces with 1 whitespace
529 return $value;
530 }
531 }
532 elsif ($lines[$c]=~/^$param="(.*)/)
533 {
534 # multi-line with quotationmarks >
535 $value=$1." ";
536 for($d=$c+1;$d<=$#lines;$d++)
537 {
538 # - look for quotationmark >
539 if ($lines[$d]=~/(.*)"/)
540 {
541 # - found quotationmark; append contents and leave loop >
542 $value.=$1;
543 last;
544 }
545 else
546 {
547 # - no quotationmark found; append line contents to $value >
548 $value.=$lines[$d]." ";
549 }
550 }
551
552 if ($mode eq "firstseen")
553 {
554 # - 6. clean up value >
555 $value=~s/^[ |\t]+//; # remove leading whitespaces and tabs
556 $value=~s/[ |\t]+$//; # remove trailing whitespaces and tabs
557 $value=~s/\t/ /g; # replace tabs with whitespaces
558 $value=~s/ {2,}/ /g; # replace 1+ whitespaces with 1 whitespace
559 return $value;
560 }
561 }
562 elsif ($lines[$c]=~/^$param=(.*)/)
563 {
564 # - single-line without quotationmarks >
565 $value=$1;
566
567 if ($mode eq "firstseen")
568 {
569 # - 6. clean up value >
570 $value=~s/^[ |\t]+//; # remove leading whitespaces and tabs
571 $value=~s/[ |\t]+$//; # remove trailing whitespaces and tabs
572 $value=~s/\t/ /g; # replace tabs with whitespaces
573 $value=~s/ {2,}/ /g; # replace 1+ whitespaces with 1 whitespace
574 return $value;
575 }
576 }
577 }
578
579 # - 6. clean up value >
580 $value=~s/^[ |\t]+//; # remove leading whitespaces and tabs
581 $value=~s/[ |\t]+$//; # remove trailing whitespaces and tabs
582 $value=~s/\t/ /g; # replace tabs with whitespaces
583 $value=~s/ {2,}/ /g; # replace 1+ whitespaces with 1 whitespace
584
585 return $value;
586 }
587
588 # Description:
589 # Returnvalue is the content of the given file.
590 # $filecontent = getFileContents($file);
591 sub getFileContents
592 {
593 my $content = "";
594
595 open(FH,"<".$_[0]) || die("Cannot open file ".$_[0]);
596 while(<FH>) { $content.=$_; }
597 close(FH);
598 return $content;
599 }
600
601 # Description:
602 # @listOfEbuilds = getAvailableEbuilds($PORTDIR, category/packagename);
603 sub getAvailableEbuilds
604 {
605 my $PORTDIR = shift;
606 my $catPackage = shift;
607 my @packagelist = ();
608
609 if (-e $PORTDIR."/".$catPackage)
610 {
611 # - get list of ebuilds >
612 my $dh = new DirHandle($PORTDIR."/".$catPackage);
613 while (defined($_ = $dh->read))
614 {
615 if ($_ =~ m/(.+)\.ebuild$/)
616 {
617 push(@packagelist,$_);
618 }
619 }
620 }
621
622 return @packagelist;
623 }
624
625
626 # Description:
627 # Returns version of an ebuild. (Without -rX string etc.)
628 # $version = getEbuildVersionSpecial("foo-1.23-r1.ebuild");
629 sub getEbuildVersionSpecial
630 {
631 my $ebuildVersion = shift;
632 $ebuildVersion=substr($ebuildVersion,0,length($ebuildVersion)-7);
633 $ebuildVersion =~ s/^([a-zA-Z0-9\-_\/\+]*)-([0-9\.]+[a-zA-Z]?)([\-r|\-rc|_alpha|_beta|_pre|_p]?)/$2$3/;
634
635 return $ebuildVersion;
636 }
637
638 sub getCPANPackages
639 {
640 my $cpan_pn = "";
641
642 for $mod (CPAN::Shell->expand("Module","/./"))
643 {
644 if ( (defined $mod->cpan_version) && ($mod->cpan_version ne "undef") )
645 {
646 $cpan_pn = $mod->id;
647 $modules{'cpan'}{$cpan_pn}=$mod->cpan_version;
648 $modules{'cpan_lc'}{lc($cpan_pn)}=$mod->cpan_version;
649
650 # - Remove any leading/trailing stuff (like "v" in "v5.2.0") we don't want >
651 $modules{'cpan'}{$cpan_pn}=~s/^[a-zA-Z]+//;
652 $modules{'cpan'}{$cpan_pn}=~s/[a-zA-Z]+$//;
653 $modules{'cpan_lc'}{lc($cpan_pn)}=~s/^[a-zA-Z]+//;
654 $modules{'cpan_lc'}{lc($cpan_pn)}=~s/[a-zA-Z]+$//;
655 }
656 }
657
658 return 0;
659 }
660
661 sub printHeader
662 {
663 print "\n";
664 print $green." up2date-ng.pl".$reset." version ".$VERSION." - brought to you by the Gentoo perl-herd-maintainer ;-)\n";
665 print " Distributed under the terms of the GPL-2\n";
666 print "\n";
667 }
668
669 sub printUsage
670 {
671 print " --generate-xml : generate GuideXML file with table of outdated packages\n";
672 print " (using template_outdated-cpan-packages.xml)\n";
673 print " --generate-mail : generate an mail body\n";
674 print " (using template_outdated-cpan-packages.mail)\n";
675 print " --generate-html : generate html file with table of outdated packages\n";
676 print " (using template_outdated-cpan-packages.html)\n";
677 print " --generate-packagelist : generate list of outdated packages\n";
678 print " --generate-all : enables generation on xml, mail, html and packagelist\n";
679 print " -v, --verbose : be a bit more verbose\n";
680 print " --debug : show debug information\n";
681 print " -h, --help : show this help\n";
682 print "\n";
683
684 exit(0);
685 }
686
687 # - Here comes the POD >
688
689 =head1 NAME
690
691 up2date-ng - Compare module versions (ebuild vs CPAN)
692
693 =head1 VERSION
694
695 This document refers to version 0.14 of up2date-ng
696
697 =head1 SYNOPSIS
698
699 up2date-ng [option]...
700
701 =head1 DESCRIPTION
702
703 up2date-ng is a tool that compares the versions of perl packages in portage
704 with the version of the packages on CPAN. up2date-ng is developed and used
705 by the Gentoo perl-herd maintainers to keep track of which cpan related
706 ebuilds could be versionbumped.
707
708 =head1 AGRUMENTS
709
710 --generate-xml generate GuideXML file with table of outdated packages
711 (using template_outdated-cpan-packages.xml)
712
713 --generate-mail generate an mail body
714 (using template_outdated-cpan-packages.mail)
715
716 --generate-html generate html file with table of outdated packages
717 (using template_outdated-cpan-packages.html)
718
719 --generate-packagelist generate list of outdated packages
720
721 --generate-all enables generation on xml, mail, html and packagelist
722
723 -v, --verbose be a bit more verbose
724
725 --debug show debug information
726
727 -h, --help show options and versionnumber
728
729 =head1 AUTHOR
730
731 Christian Hartmann <ian@gentoo.org>
732
733 =head1 TODO
734
735 Put your stuff here and poke me.
736
737 =head1 REPORTING BUGS
738
739 Please report bugs via http://bugs.gentoo.org/ or https://bugs.gentoo.org/
740
741 =head1 LICENSE
742
743 up2date-ng - Compare module versions (ebuild vs CPAN)
744 Copyright (C) 2006 Christian Hartmann
745
746 This program is free software; you can redistribute it and/or modify
747 it under the terms of the GNU General Public License as published by
748 the Free Software Foundation; either version 2 of the License, or
749 (at your option) any later version.
750
751 This program is distributed in the hope that it will be useful,
752 but WITHOUT ANY WARRANTY; without even the implied warranty of
753 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
754 GNU General Public License for more details.
755
756 You should have received a copy of the GNU General Public License
757 along with this program; if not, write to the Free Software
758 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
759
760 =cut

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.20