Commit | Line | Data |
93cd2f30 |
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 |