lib/ExtUtils/Packlist.pm

   1 package ExtUtils::Packlist;
   2 use strict;
   3 use Carp qw();
   4 use vars qw($VERSION);
   5 $VERSION = '0.02';
   6
   7 # Used for generating filehandle globs.  IO::File might not be available!
   8 my $fhname = "FH1";
   9
  10 sub mkfh()
  11 {
  12 no strict;
  13 my $fh = \*{$fhname++};
  14 use strict;
  15 return($fh);
  16 }
  17
  18 sub new($$)
  19 {
  20 my ($class, $packfile) = @_;
  21 $class = ref($class) || $class;
  22 my %self;
  23 tie(%self, $class, $packfile);
  24 return(bless(\%self, $class));
  25 }
  26
  27 sub TIEHASH
  28 {
  29 my ($class, $packfile) = @_;
  30 my $self = { packfile => $packfile };
  31 bless($self, $class);
  32 $self->read($packfile) if (defined($packfile) && -f $packfile);
  33 return($self);
  34 }
  35
  36 sub STORE
  37 {
  38 $_[0]->{data}->{$_[1]} = $_[2];
  39 }
  40
  41 sub FETCH
  42 {
  43 return($_[0]->{data}->{$_[1]});
  44 }
  45
  46 sub FIRSTKEY
  47 {
  48 my $reset = scalar(keys(%{$_[0]->{data}}));
  49 return(each(%{$_[0]->{data}}));
  50 }
  51
  52 sub NEXTKEY
  53 {
  54 return(each(%{$_[0]->{data}}));
  55 }
  56
  57 sub EXISTS
  58 {
  59 return(exists($_[0]->{data}->{$_[1]}));
  60 }
  61
  62 sub DELETE
  63 {
  64 return(delete($_[0]->{data}->{$_[1]}));
  65 }
  66
  67 sub CLEAR
  68 {
  69 %{$_[0]->{data}} = ();
  70 }
  71
  72 sub DESTROY
  73 {
  74 }
  75
  76 sub read($;$)
  77 {
  78 my ($self, $packfile) = @_;
  79 $self = tied(%$self) || $self;
  80
  81 if (defined($packfile)) { $self->{packfile} = $packfile; }
  82 else { $packfile = $self->{packfile}; }
  83 Carp::croak("No packlist filename specified") if (! defined($packfile));
  84 my $fh = mkfh();
  85 open($fh, "<$packfile") || Carp::croak("Can't open file $packfile: $!");
  86 $self->{data} = {};
  87 my ($line);
  88 while (defined($line = <$fh>))
  89    {
  90    chomp $line;
  91    my ($key, @kvs) = split(' ', $line);
  92    $key =~ s!/./!/!g;   # Some .packlists have spurious '/./' bits in the paths
  93    if (! @kvs)
  94       {
  95       $self->{data}->{$key} = undef;
  96       }
  97    else
  98       {
  99       my ($data) = {};
 100       foreach my $kv (@kvs)
 101          {
 102          my ($k, $v) = split('=', $kv);
 103          $data->{$k} = $v;
 104          }
 105       $self->{data}->{$key} = $data;
 106       }
 107    }
 108 close($fh);
 109 }
 110
 111 sub write($;$)
 112 {
 113 my ($self, $packfile) = @_;
 114 $self = tied(%$self) || $self;
 115 if (defined($packfile)) { $self->{packfile} = $packfile; }
 116 else { $packfile = $self->{packfile}; }
 117 Carp::croak("No packlist filename specified") if (! defined($packfile));
 118 my $fh = mkfh();
 119 open($fh, ">$packfile") || Carp::croak("Can't open file $packfile: $!");
 120 foreach my $key (sort(keys(%{$self->{data}})))
 121    {
 122    print $fh ("$key");
 123    if (ref($self->{data}->{$key}))
 124       {
 125       my $data = $self->{data}->{$key};
 126       foreach my $k (sort(keys(%$data)))
 127          {
 128          print $fh (" $k=$data->{$k}");
 129          }
 130       }
 131    print $fh ("\n");
 132    }
 133 close($fh);
 134 }
 135
 136 sub validate($;$)
 137 {
 138 my ($self, $remove) = @_;
 139 $self = tied(%$self) || $self;
 140 my @missing;
 141 foreach my $key (sort(keys(%{$self->{data}})))
 142    {
 143    if (! -e $key)
 144       {
 145       push(@missing, $key);
 146       delete($self->{data}{$key}) if ($remove);
 147       }
 148    }
 149 return(@missing);
 150 }
 151
 152 1;
 153
 154 __END__
 155
 156 =head1 NAME
 157
 158 ExtUtils::Packlist - manage .packlist files
 159
 160 =head1 SYNOPSIS
 161
 162    use ExtUtils::Packlist;
 163    my ($pl) = ExtUtils::Packlist->new('.packlist');
 164    $pl->read('/an/old/.packlist');
 165    my @missing_files = $pl->validate();
 166    $pl->write('/a/new/.packlist');
 167
 168    $pl->{'/some/file/name'}++;
 169       or
 170    $pl->{'/some/other/file/name'} = { type => 'file',
 171                                       from => '/some/file' };
 172
 173 =head1 DESCRIPTION
 174
 175 ExtUtils::Packlist provides a standard way to manage .packlist files.
 176 Functions are provided to read and write .packlist files.  The original
 177 .packlist format is a simple list of absolute pathnames, one per line.  In
 178 addition, this package supports an extended format, where as well as a filename
 179 each line may contain a list of attributes in the form of a space separated
 180 list of key=value pairs.  This is used by the installperl script to
 181 differentiate between files and links, for example.
 182
 183 =head1 USAGE
 184
 185 The hash reference returned by the new() function can be used to examine and
 186 modify the contents of the .packlist.  Items may be added/deleted from the
 187 .packlist by modifying the hash.  If the value associated with a hash key is a
 188 scalar, the entry written to the .packlist by any subsequent write() will be a
 189 simple filename.  If the value is a hash, the entry written will be the
 190 filename followed by the key=value pairs from the hash.  Reading back the
 191 .packlist will recreate the original entries.
 192
 193 =head1 FUNCTIONS
 194
 195 =over
 196
 197 =item new()
 198
 199 This takes an optional parameter, the name of a .packlist.  If the file exists,
 200 it will be opened and the contents of the file will be read.  The new() method
 201 returns a reference to a hash.  This hash holds an entry for each line in the
 202 .packlist.  In the case of old-style .packlists, the value associated with each
 203 key is undef.  In the case of new-style .packlists, the value associated with
 204 each key is a hash containing the key=value pairs following the filename in the
 205 .packlist.
 206
 207 =item read()
 208
 209 This takes an optional parameter, the name of the .packlist to be read.  If
 210 no file is specified, the .packlist specified to new() will be read.  If the
 211 .packlist does not exist, Carp::croak will be called.
 212
 213 =item write()
 214
 215 This takes an optional parameter, the name of the .packlist to be written.  If
 216 no file is specified, the .packlist specified to new() will be overwritten.
 217
 218 =item validate()
 219
 220 This checks that every file listed in the .packlist actually exists.  If an
 221 argument which evaluates to true is given, any missing files will be removed
 222 from the internal hash.  The return value is a list of the missing files, which
 223 will be empty if they all exist.
 224
 225 =back
 226
 227 =head1 AUTHOR
 228
 229 Alan Burlison <Alan.Burlison@uk.sun.com>
 230
 231 =cut