package ExtUtils::Packlist;

use 5.00503;
use strict;
use Carp qw();
use vars qw($VERSION);
$VERSION = '0.04';

# Used for generating filehandle globs.  IO::File might not be available!
my $fhname = "FH1";

sub mkfh()
{
no strict;
my $fh = \*{$fhname++};
use strict;
return($fh);
}

sub new($$)
{
my ($class, $packfile) = @_;
$class = ref($class) || $class;
my %self;
tie(%self, $class, $packfile);
return(bless(\%self, $class));
}

sub TIEHASH
{
my ($class, $packfile) = @_;
my $self = { packfile => $packfile };
bless($self, $class);
$self->read($packfile) if (defined($packfile) && -f $packfile);
return($self);
}

sub STORE
{
$_[0]->{data}->{$_[1]} = $_[2];
}

sub FETCH
{
return($_[0]->{data}->{$_[1]});
}

sub FIRSTKEY
{
my $reset = scalar(keys(%{$_[0]->{data}}));
return(each(%{$_[0]->{data}}));
}

sub NEXTKEY
{
return(each(%{$_[0]->{data}}));
}

sub EXISTS
{
return(exists($_[0]->{data}->{$_[1]}));
}

sub DELETE
{
return(delete($_[0]->{data}->{$_[1]}));
}

sub CLEAR
{
%{$_[0]->{data}} = ();
}

sub DESTROY
{
}

sub read($;$)
{
my ($self, $packfile) = @_;
$self = tied(%$self) || $self;

if (defined($packfile)) { $self->{packfile} = $packfile; }
else { $packfile = $self->{packfile}; }
Carp::croak("No packlist filename specified") if (! defined($packfile));
my $fh = mkfh();
open($fh, "<$packfile") || Carp::croak("Can't open file $packfile: $!");
$self->{data} = {};
my ($line);
while (defined($line = <$fh>))
   {
   chomp $line;
   my ($key, @kvs) = $line;
   if ($key =~ /^(.*?)( \w+=.*)$/)
      {
      $key = $1;
      @kvs = split(' ', $2);
      }
   $key =~ s!/\./!/!g;   # Some _packlists have spurious '/./' bits in the paths
   if (! @kvs)
      {
      $self->{data}->{$key} = undef;
      }
   else
      {
      my ($data) = {};
      foreach my $kv (@kvs)
         {
         my ($k, $v) = split('=', $kv);
         $data->{$k} = $v;
         }
      $self->{data}->{$key} = $data;
      }
   }
close($fh);
}

sub write($;$)
{
my ($self, $packfile) = @_;
$self = tied(%$self) || $self;
if (defined($packfile)) { $self->{packfile} = $packfile; }
else { $packfile = $self->{packfile}; }
Carp::croak("No packlist filename specified") if (! defined($packfile));
my $fh = mkfh();
open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!");
foreach my $key (sort(keys(%{$self->{data}})))
   {
   print $fh ("$key");
   if (ref($self->{data}->{$key}))
      {
      my $data = $self->{data}->{$key};
      foreach my $k (sort(keys(%$data)))
         {
         print $fh (" $k=$data->{$k}");
         }
      }
   print $fh ("\n");
   }
close($fh);
}

sub validate($;$)
{
my ($self, $remove) = @_;
$self = tied(%$self) || $self;
my @missing;
foreach my $key (sort(keys(%{$self->{data}})))
   {
   if (! -e $key)
      {
      push(@missing, $key);
      delete($self->{data}{$key}) if ($remove);
      }
   }
return(@missing);
}

sub packlist_file($)
{
my ($self) = @_;
$self = tied(%$self) || $self;
return($self->{packfile});
}

1;

__END__

=head1 NAME

ExtUtils::Packlist - manage _packlist files

=head1 SYNOPSIS

   use ExtUtils::Packlist;
   my ($pl) = ExtUtils::Packlist->new('_packlist');
   $pl->read('/an/old/_packlist');
   my @missing_files = $pl->validate();
   $pl->write('/a/new/_packlist');

   $pl->{'/some/file/name'}++;
      or
   $pl->{'/some/other/file/name'} = { type => 'file',
                                      from => '/some/file' };

=head1 DESCRIPTION

ExtUtils::Packlist provides a standard way to manage _packlist files.
Functions are provided to read and write _packlist files.  The original
_packlist format is a simple list of absolute pathnames, one per line.  In
addition, this package supports an extended format, where as well as a filename
each line may contain a list of attributes in the form of a space separated
list of key=value pairs.  This is used by the installperl script to
differentiate between files and links, for example.

=head1 USAGE

The hash reference returned by the new() function can be used to examine and
modify the contents of the _packlist.  Items may be added/deleted from the
_packlist by modifying the hash.  If the value associated with a hash key is a
scalar, the entry written to the _packlist by any subsequent write() will be a
simple filename.  If the value is a hash, the entry written will be the
filename followed by the key=value pairs from the hash.  Reading back the
_packlist will recreate the original entries.

=head1 FUNCTIONS

=over 4

=item new()

This takes an optional parameter, the name of a _packlist.  If the file exists,
it will be opened and the contents of the file will be read.  The new() method
returns a reference to a hash.  This hash holds an entry for each line in the
_packlist.  In the case of old-style _packlists, the value associated with each
key is undef.  In the case of new-style _packlists, the value associated with
each key is a hash containing the key=value pairs following the filename in the
_packlist.

=item read()

This takes an optional parameter, the name of the _packlist to be read.  If
no file is specified, the _packlist specified to new() will be read.  If the
_packlist does not exist, Carp::croak will be called.

=item write()

This takes an optional parameter, the name of the _packlist to be written.  If
no file is specified, the _packlist specified to new() will be overwritten.

=item validate()

This checks that every file listed in the _packlist actually exists.  If an
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>

=cut
