/[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 - (hide 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 mcummings 16 #!/usr/bin/perl
2    
3     # -----------------------------------------------------------------------------
4     #
5     # up2date-ng.pl
6     #
7 ian 22 # date : 2006-04-22
8 mcummings 16 # author : Christian Hartmann <ian@gentoo.org>
9 ian 23 # version : 0.14
10 mcummings 16 # 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 ian 23 my $VERSION = "0.14";
36 mcummings 16 my $portdir = getParamFromFile(getFileContents("/etc/make.conf"),"PORTDIR","lastseen") || "/usr/portage";
37     my @scan_portage_categories = qw(dev-perl perl-core);
38 ian 22 my $package_mask_file = "up2date_package.mask";
39 ian 23 my $package_altname_file = "up2date_package.altname";
40 mcummings 16 my @timeData = localtime(time);
41     my %modules = ();
42     my @tmp_availableVersions = ();
43     my @packages2update = ();
44     my @tmp_v = ();
45 ian 22 my %pmask = ();
46 ian 23 my %paltname = ();
47     my @need_packagealtname = ();
48 mcummings 16 my $p_modulename = "";
49     my $xml_packagelist_table = "";
50     my $mail_packagelist_table = "";
51 ian 18 my $html_packagelist_table = "";
52 ian 22 my $cat_pkg = "";
53 mcummings 16 my $DEBUG = 0;
54     my $generate_xml = 0;
55     my $generate_mail = 0;
56 ian 18 my $generate_html = 0;
57 ian 20 my $generate_packagelist = 0;
58     my $generate_all = 0;
59 mcummings 16 my $verbose = 0;
60 ian 22 my $tmp;
61 mcummings 16 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 ian 20 '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 mcummings 16 ) || printUsage();
82    
83 ian 20 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 mcummings 16
92 ian 22 # - 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 ian 23 $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 ian 22 {
107 ian 23 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 ian 22 }
147 ian 23 }
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 ian 22
167 ian 23 if ($line ne "" && $line ne " ")
168 ian 22 {
169 ian 23 $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 ian 22 }
177     }
178     }
179     else
180     {
181 ian 23 print $green." *".$reset." No package.altname file available - Skipping\n";
182 ian 22 }
183    
184 mcummings 16 # - 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 ian 20 foreach my $p_original_modulename (sort keys %{$modules{'portage_lc'}})
194 mcummings 16 {
195     if ($DEBUG) { print $p_original_modulename."\n"; }
196     $p_modulename=$p_original_modulename;
197     $p_modulename=~s/-/::/g;
198 ian 20
199     if (! defined $modules{'cpan_lc'}{$p_modulename})
200 mcummings 16 {
201 ian 20 # - Could not find a matching package name - probably not a CPAN-module >
202 ian 23 if ($DEBUG) { print "- Could not find CPAN-Module ('".$p_modulename."') for package '".$p_original_modulename."'!\n"; }
203 ian 20
204 ian 23 # - Look for an entry in up2date_package.altname for this package >
205     if ($paltname{'portage'}{$p_original_modulename})
206 mcummings 16 {
207 ian 23 # - 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 mcummings 16 }
229 ian 23 else
230 mcummings 16 {
231 ian 23 # - 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 mcummings 16 }
236 ian 23 }
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 mcummings 16
266 ian 23 if (defined $pmask{'package'}{$cat_pkg}{'operator'})
267 mcummings 16 {
268 ian 23 # - package is masked >
269     if ($pmask{'package'}{$tmp}{'operator'} eq "*")
270 ian 22 {
271 ian 23 # - 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 ian 22 {
280 ian 23 # - cpan version has been masked - skip >
281     if ($DEBUG) { print "cpan version has been masked - skip\n"; }
282 ian 22 next;
283     }
284 ian 23 }
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 ian 22 {
290 ian 23 # - cpan version has been masked - skip >
291     if ($DEBUG) { print "cpan version has been masked - skip\n"; }
292     next;
293 ian 22 }
294 ian 23 }
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 ian 22 {
300 ian 23 # - cpan version has been masked - skip >
301     if ($DEBUG) { print "cpan version has been masked - skip\n"; }
302     next;
303 ian 22 }
304     }
305 ian 23 }
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 mcummings 16 {
326 ian 23 $mail_packagelist_table .= " ";
327 mcummings 16 }
328 ian 23 $mail_packagelist_table .= " ".$modules{'portage_lc'}{$p_original_modulename};
329     for(0..(20-length($modules{'cpan_lc'}{$p_modulename})))
330 mcummings 16 {
331 ian 23 $mail_packagelist_table .= " ";
332 mcummings 16 }
333 ian 23 $mail_packagelist_table .= " ".$modules{'cpan_lc'}{$p_modulename};
334     $mail_packagelist_table .= "\n";
335     }
336 ian 18
337 ian 23 if ($generate_html)
338 mcummings 16 {
339 ian 23 $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 mcummings 16 }
345     }
346 ian 23 else
347     {
348     if ($DEBUG) { print $p_original_modulename." is uptodate\n"; }
349     }
350 mcummings 16 }
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 ian 21 my $dateXML = int($timeData[5]+1900)."-".($timeData[4]+1)."-".$timeData[3];
362 mcummings 16 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 ian 23 print $green." *".$reset." done!\n\n";
371 mcummings 16 }
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 ian 23 print $green." *".$reset." done!\n\n";
386 mcummings 16 }
387    
388 ian 18 # - 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 ian 21 my $dateHTML = int($timeData[5]+1900)."-".($timeData[4]+1)."-".$timeData[3];
394 ian 18 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 ian 23 print $green." *".$reset." done!\n\n";
403 ian 18 }
404 mcummings 16
405 ian 20 # - 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 ian 23 print $green." *".$reset." done!\n\n";
417 ian 20 }
418    
419 ian 23 # - 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 mcummings 16 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 ian 22
445 mcummings 16 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 ian 19 if ($#tmp_availableVersions>-1)
462     {
463 ian 23 $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 ian 20 $modules{'portage'}{lc($tp)}{'name'}=$tp;
477     $modules{'portage'}{lc($tp)}{'category'}=$tc;
478 ian 19 }
479 mcummings 16 }
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 ian 20 my @packagelist = ();
608 mcummings 16
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 ian 20 push(@packagelist,$_);
618 mcummings 16 }
619     }
620     }
621    
622 ian 20 return @packagelist;
623 mcummings 16 }
624    
625    
626     # Description:
627     # Returns version of an ebuild. (Without -rX string etc.)
628 ian 23 # $version = getEbuildVersionSpecial("foo-1.23-r1.ebuild");
629 mcummings 16 sub getEbuildVersionSpecial
630     {
631     my $ebuildVersion = shift;
632 ian 23 $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 mcummings 16 return $ebuildVersion;
636     }
637    
638     sub getCPANPackages
639     {
640 ian 20 my $cpan_pn = "";
641    
642 mcummings 16 for $mod (CPAN::Shell->expand("Module","/./"))
643     {
644     if ( (defined $mod->cpan_version) && ($mod->cpan_version ne "undef") )
645     {
646 ian 20 $cpan_pn = $mod->id;
647     $modules{'cpan'}{$cpan_pn}=$mod->cpan_version;
648     $modules{'cpan_lc'}{lc($cpan_pn)}=$mod->cpan_version;
649 mcummings 16
650     # - Remove any leading/trailing stuff (like "v" in "v5.2.0") we don't want >
651 ian 20 $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 mcummings 16 }
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 ian 18 print " Distributed under the terms of the GPL-2\n";
666 mcummings 16 print "\n";
667     }
668    
669     sub printUsage
670     {
671 ian 20 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 mcummings 16 print "\n";
683    
684     exit(0);
685     }
686 ian 21
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 ian 23 This document refers to version 0.14 of up2date-ng
696 ian 21
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