Update of /cvsroot/fink/fink/perlmod/Fink
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv23866

Modified Files:
        ChangeLog Engine.pm PkgVersion.pm Validation.pm 
Log Message:
Begin to implement OBSOLETE package handling: a package is obsolete if
its Description begins with "[OBSOLETE" (any case)

'fink cleanup --obsoletes' (only avail with --dry-run so far) lists
all such packages that are installed

TODO:
 * 'fink cleanup --obsoletes' live mode
 * disable warning when obsolete pkg Depends on a BDO package
 * add warning (error in -m mode) when package has any sort of
   (anti)dependency on an obsolete one


Index: PkgVersion.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/PkgVersion.pm,v
retrieving revision 1.565
retrieving revision 1.566
diff -u -d -r1.565 -r1.566
--- PkgVersion.pm       3 Oct 2006 06:01:29 -0000       1.565
+++ PkgVersion.pm       3 Oct 2006 07:44:49 -0000       1.566
@@ -4967,6 +4967,26 @@
        return scalar(grep { $_->is_essential } $self->get_splitoffs(1, 1));
 }
 
+=item is_obsolete
+
+  my $bool = $pv->is_obsolete;
+
+Returns true if the package is marked as obsolete. That status is
+indicated by a Description that begins with the word "[OBSOLETE" (any
+case)
+
+=cut
+
+sub is_obsolete {
+       my $self = shift;
+
+       return 0 unless $self->has_param('Description');  # assume not obsolete
+
+       my $desc  = $self->param('Description');
+       return $desc =~ /^\s*\[obsolete(?![a-z])/i;
+}
+
+
 =item info_level
 
   my $info_level = $pv->info_level;

Index: Engine.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Engine.pm,v
retrieving revision 1.383
retrieving revision 1.384
diff -u -d -r1.383 -r1.384
--- Engine.pm   22 Sep 2006 01:40:25 -0000      1.383
+++ Engine.pm   3 Oct 2006 07:44:49 -0000       1.384
@@ -1030,7 +1030,7 @@
                [ 'buildlocks|bl' => \$modes{bl},       "Delete stale buildlock 
packages." ],
                [ 'dpkg-status'   => \$modes{dpkg},
                        "Remove uninstalled packages from dpkg status 
database." ],
-#              [ 'obsoletes'     => \$modes{obs},      "Uninstall obsolete 
packages." ],
+               [ 'obsoletes'     => \$modes{obs},      "Uninstall obsolete 
packages." ],
                [ 'all|a'         => \$modes{all},      "All of the above 
actions." ],
                [ 'keep-src|k'    => \$opts{keep_old},
                        "Move old source files to $basepath/src/old/ instead of 
deleting them." ],
@@ -1411,7 +1411,44 @@
 sub cleanup_obsoletes {
        my %opts = (dryrun => 0, @_);
 
-       print "cleanup --obsoletes is not yet available.\n";
+       my %obsolete_pkgs = ();  # NAME=>PkgVersion-object
+       my ($maxlen_name, $maxlen_vers) = (0, 0);
+
+       # start with all packages in dpkg status db (likely to be
+       # installed, so more efficient than starting with package
+       # database) as ref to hash of NAME=>{fields hash}
+       my $status_pkgs = Fink::Status->list();
+ 
+       # get installed version of each as hash of NAME=>VERSION
+       my %installed = map { $_ => Fink::Status->query_package($_) } keys 
%$status_pkgs;
+
+       # find the obsolete ones
+       Fink::Package->require_packages();
+       foreach my $name (sort keys %installed) {
+               my $vers = $installed{$name};  # actually %v-%r
+               next unless defined $vers && length $vers;
+
+               # find PkgVersion for this version of the package
+               my $po = Fink::Package->package_by_name($name);
+               my $vo = $po->get_version($vers);
+
+               next unless $vo->is_obsolete();
+
+               # track longest package name and version string
+               $maxlen_name = length $name if length $name > $maxlen_name;
+               $maxlen_vers = length $vers if length $vers > $maxlen_vers;
+
+               $obsolete_pkgs{$name} = $vo;
+       }
+
+       foreach my $name (sort keys %obsolete_pkgs) {
+               my $vo = $obsolete_pkgs{$name};
+               printf "   %${maxlen_name}s  %${maxlen_vers}s  %s\n", $name, 
$vo->get_fullversion(), $vo->get_shortdescription(100000);
+       }
+
+       return 0 if $opts{dryrun};
+
+       print "cleanup --obsoletes only available in --dry-run mode so far.\n";
        return 1;
 }
 

Index: Validation.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Validation.pm,v
retrieving revision 1.232
retrieving revision 1.233
diff -u -d -r1.232 -r1.233
--- Validation.pm       13 Sep 2006 17:46:22 -0000      1.232
+++ Validation.pm       3 Oct 2006 07:44:50 -0000       1.233
@@ -709,6 +709,8 @@
        if (not (defined $value and length $value)) {
                print "Error: No package description supplied. ($filename)\n";
                $looks_good = 0;
+       } elsif ($value =~ /^\s*\[obsolete(?![a-z])/i) {
+               # "obsolete" packages can have long names
        } elsif (length($value) > 60) {
                print "Error: Length of package description exceeds 60 
characters. ($filename)\n";
                $looks_good = 0;

Index: ChangeLog
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/ChangeLog,v
retrieving revision 1.1385
retrieving revision 1.1386
diff -u -d -r1.1385 -r1.1386
--- ChangeLog   3 Oct 2006 06:01:29 -0000       1.1385
+++ ChangeLog   3 Oct 2006 07:44:49 -0000       1.1386
@@ -1,5 +1,14 @@
 2006-10-03  Daniel Macks  <[EMAIL PROTECTED]>
 
+       * PkgVersion.pm: implement is_obsolete method based on Description
+       field matching /^[obsolete/i
+       * Validation.pm: Allow Description to begin with /^[obsolete/i and
+       disable other Description tests if so
+       * Engine.pm: Enable --obsoletes --dry-run mode to 'fink cleanup',
+       which lists installed is_obsolete packages
+
+2006-10-03  Daniel Macks  <[EMAIL PROTECTED]>
+
        * PkgVersion.pm: TestScript only exists for parent and only in -m
        mode; move Type:perl 'make test' from CompileScript to TestScript
 


-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys -- and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
_______________________________________________
Fink-commits mailing list
Fink-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/fink-commits

Reply via email to