X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExtUtils%2FPacklist.pm;h=ea4ec5e61fbeefec1c972ff09fe125051e060f8f;hb=73eb9af10bd9a853ec4e3979456335a8665265a4;hp=a0128492b2a32fb16027faf2f50046e2e68bb7f3;hpb=93cd2f30b31cefdc267907e40ed2196467fd129c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/ExtUtils/Packlist.pm b/lib/ExtUtils/Packlist.pm
index a012849..ea4ec5e 100644
--- a/lib/ExtUtils/Packlist.pm
+++ b/lib/ExtUtils/Packlist.pm
@@ -1,8 +1,9 @@
 package ExtUtils::Packlist;
+
+use 5.006_001;
 use strict;
 use Carp qw();
-use vars qw($VERSION);
-$VERSION = '0.02';
+our $VERSION = '0.04';
 
 # Used for generating filehandle globs.  IO::File might not be available!
 my $fhname = "FH1";
@@ -89,7 +90,7 @@ while (defined($line = <$fh>))
    {
    chomp $line;
    my ($key, @kvs) = split(' ', $line);
-   $key =~ s!/./!/!g;   # Some .packlists have spurious '/./' bits in the paths
+   $key =~ s!/\./!/!g;   # Some .packlists have spurious '/./' bits in the paths
    if (! @kvs)
       {
       $self->{data}->{$key} = undef;
@@ -149,6 +150,13 @@ foreach my $key (sort(keys(%{$self->{data}})))
 return(@missing);
 }
 
+sub packlist_file($)
+{
+my ($self) = @_;
+$self = tied(%$self) || $self;
+return($self->{packfile});
+}
+
 1;
 
 __END__
@@ -192,7 +200,7 @@ filename followed by the key=value pairs from the hash.  Reading back the
 
 =head1 FUNCTIONS
 
-=over
+=over 4
 
 =item new()
 
@@ -222,8 +230,58 @@ argument which evaluates to true is given, any missing files will be removed
 from the internal hash.  The return value is a list of the missing files, which
 will be empty if they all exist.
 
+=item packlist_file()
+
+This returns the name of the associated .packlist file
+
 =back
 
+=head1 EXAMPLE
+
+Here's C<modrm>, a little utility to cleanly remove an installed module.
+
+    #!/usr/local/bin/perl -w
+
+    use strict;
+    use IO::Dir;
+    use ExtUtils::Packlist;
+    use ExtUtils::Installed;
+
+    sub emptydir($) {
+	my ($dir) = @_;
+	my $dh = IO::Dir->new($dir) || return(0);
+	my @count = $dh->read();
+	$dh->close();
+	return(@count == 2 ? 1 : 0);
+    }
+
+    # Find all the installed packages
+    print("Finding all installed modules...\n");
+    my $installed = ExtUtils::Installed->new();
+
+    foreach my $module (grep(!/^Perl$/, $installed->modules())) {
+       my $version = $installed->version($module) || "???";
+       print("Found module $module Version $version\n");
+       print("Do you want to delete $module? [n] ");
+       my $r = <STDIN>; chomp($r);
+       if ($r && $r =~ /^y/i) {
+	  # Remove all the files
+	  foreach my $file (sort($installed->files($module))) {
+	     print("rm $file\n");
+	     unlink($file);
+	  }
+	  my $pf = $installed->packlist($module)->packlist_file();
+	  print("rm $pf\n");
+	  unlink($pf);
+	  foreach my $dir (sort($installed->directory_tree($module))) {
+	     if (emptydir($dir)) {
+		print("rmdir $dir\n");
+		rmdir($dir);
+	     }
+	  }
+       }
+    }
+
 =head1 AUTHOR
 
 Alan Burlison <Alan.Burlison@uk.sun.com>