fix diagnostics to report "our" vs "my" correctly
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Installed.pm
CommitLineData
354f3b56 1package ExtUtils::Installed;
2use strict;
3use Carp qw();
4use ExtUtils::Packlist;
5use ExtUtils::MakeMaker;
6use Config;
7use File::Find;
8use File::Basename;
9use vars qw($VERSION);
9b604809 10$VERSION = '0.02';
354f3b56 11
12sub _is_type($$$)
13{
14my ($self, $path, $type) = @_;
15return(1) if ($type eq "all");
16if ($type eq "doc")
17 {
18 return(substr($path, 0, length($Config{installman1dir}))
19 eq $Config{installman1dir}
20 ||
21 substr($path, 0, length($Config{installman3dir}))
22 eq $Config{installman3dir}
23 ? 1 : 0)
24 }
25if ($type eq "prog")
26 {
27 return(substr($path, 0, length($Config{prefix})) eq $Config{prefix}
28 &&
29 substr($path, 0, length($Config{installman1dir}))
30 ne $Config{installman1dir}
31 &&
32 substr($path, 0, length($Config{installman3dir}))
33 ne $Config{installman3dir}
34 ? 1 : 0);
35 }
36return(0);
37}
38
39sub _is_under($$;)
40{
41my ($self, $path, @under) = @_;
42$under[0] = "" if (! @under);
43foreach my $dir (@under)
44 {
45 return(1) if (substr($path, 0, length($dir)) eq $dir);
46 }
47return(0);
48}
49
50sub new($)
51{
52my ($class) = @_;
53$class = ref($class) || $class;
54my $self = {};
55
56# Read the core packlist
57$self->{Perl}{packlist} =
58 ExtUtils::Packlist->new("$Config{installarchlib}/.packlist");
0ff3fa1a 59$self->{Perl}{version} = $Config{version};
354f3b56 60
61# Read the module packlists
62my $sub = sub
63 {
64 # Only process module .packlists
65 return if ($_) ne ".packlist" || $File::Find::dir eq $Config{installarchlib};
66
67 # Hack of the leading bits of the paths & convert to a module name
68 my $module = $File::Find::name;
69 $module =~ s!$Config{archlib}/auto/(.*)/.packlist!$1!;
70 $module =~ s!$Config{sitearch}/auto/(.*)/.packlist!$1!;
71 my $modfile = "$module.pm";
72 $module =~ s!/!::!g;
73
74 # Find the top-level module file in @INC
75 $self->{$module}{version} = '';
76 foreach my $dir (@INC)
77 {
78 my $p = MM->catfile($dir, $modfile);
79 if (-f $p)
80 {
81 $self->{$module}{version} = MM->parse_version($p);
82 last;
83 }
84 }
85
86 # Read the .packlist
87 $self->{$module}{packlist} = ExtUtils::Packlist->new($File::Find::name);
88 };
89find($sub, $Config{archlib}, $Config{sitearch});
90
91return(bless($self, $class));
92}
93
94sub modules($)
95{
96my ($self) = @_;
97return(sort(keys(%$self)));
98}
99
100sub files($$;$)
101{
102my ($self, $module, $type, @under) = @_;
103
104# Validate arguments
105Carp::croak("$module is not installed") if (! exists($self->{$module}));
106$type = "all" if (! defined($type));
107Carp::croak('type must be "all", "prog" or "doc"')
108 if ($type ne "all" && $type ne "prog" && $type ne "doc");
109
110my (@files);
111foreach my $file (keys(%{$self->{$module}{packlist}}))
112 {
113 push(@files, $file)
114 if ($self->_is_type($file, $type) && $self->_is_under($file, @under));
115 }
116return(@files);
117}
118
119sub directories($$;$)
120{
121my ($self, $module, $type, @under) = @_;
122my (%dirs);
123foreach my $file ($self->files($module, $type, @under))
124 {
125 $dirs{dirname($file)}++;
126 }
127return(sort(keys(%dirs)));
128}
129
130sub directory_tree($$;$)
131{
132my ($self, $module, $type, @under) = @_;
133my (%dirs);
134foreach my $dir ($self->directories($module, $type, @under))
135 {
136 $dirs{$dir}++;
9b604809 137 my ($last) = ("");
354f3b56 138 while ($last ne $dir)
139 {
140 $last = $dir;
141 $dir = dirname($dir);
142 last if (! $self->_is_under($dir, @under));
143 $dirs{$dir}++;
144 }
145 }
146return(sort(keys(%dirs)));
147}
148
149sub validate($;$)
150{
151my ($self, $module, $remove) = @_;
152Carp::croak("$module is not installed") if (! exists($self->{$module}));
153return($self->{$module}{packlist}->validate($remove));
154}
155
156sub packlist($$)
157{
158my ($self, $module) = @_;
159Carp::croak("$module is not installed") if (! exists($self->{$module}));
160return($self->{$module}{packlist});
161}
162
163sub version($$)
164{
165my ($self, $module) = @_;
166Carp::croak("$module is not installed") if (! exists($self->{$module}));
167return($self->{$module}{version});
168}
169
170sub DESTROY
171{
172}
173
1741;
175
176__END__
177
178=head1 NAME
179
180ExtUtils::Installed - Inventory management of installed modules
181
182=head1 SYNOPSIS
183
184 use ExtUtils::Installed;
185 my ($inst) = ExtUtils::Installed->new();
186 my (@modules) = $inst->modules();
187 my (@missing) = $inst->validate("DBI");
188 my $all_files = $inst->files("DBI");
189 my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local");
190 my $all_dirs = $inst->directories("DBI");
191 my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog");
192 my $packlist = $inst->packlist("DBI");
193
194=head1 DESCRIPTION
195
196ExtUtils::Installed provides a standard way to find out what core and module
197files have been installed. It uses the information stored in .packlist files
198created during installation to provide this information. In addition it
199provides facilities to classify the installed files and to extract directory
200information from the .packlist files.
201
202=head1 USAGE
203
204The new() function searches for all the installed .packlists on the system, and
205stores their contents. The .packlists can be queried with the functions
206described below.
207
208=head1 FUNCTIONS
209
210=over
211
212=item new()
213
214This takes no parameters, and searches for all the installed .packlists on the
215system. The packlists are read using the ExtUtils::packlist module.
216
217=item modules()
218
219This returns a list of the names of all the installed modules. The perl 'core'
220is given the special name 'Perl'.
221
222=item files()
223
224This takes one mandatory parameter, the name of a module. It returns a list of
225all the filenames from the package. To obtain a list of core perl files, use
226the module name 'Perl'. Additional parameters are allowed. The first is one
227of the strings "prog", "man" or "all", to select either just program files,
228just manual files or all files. The remaining parameters are a list of
229directories. The filenames returned will be restricted to those under the
230specified directories.
231
232=item directories()
233
234This takes one mandatory parameter, the name of a module. It returns a list of
235all the directories from the package. Additional parameters are allowed. The
236first is one of the strings "prog", "man" or "all", to select either just
237program directories, just manual directories or all directories. The remaining
238parameters are a list of directories. The directories returned will be
239restricted to those under the specified directories. This method returns only
240the leaf directories that contain files from the specified module.
241
242=item directory_tree()
243
244This is identical in operation to directory(), except that it includes all the
245intermediate directories back up to the specified directories.
246
247=item validate()
248
249This takes one mandatory parameter, the name of a module. It checks that all
250the files listed in the modules .packlist actually exist, and returns a list of
251any missing files. If an optional second argument which evaluates to true is
252given any missing files will be removed from the .packlist
253
254=item packlist()
255
256This returns the ExtUtils::Packlist object for the specified module.
257
258=item version()
259
260This returns the version number for the specified module.
261
262=back
263
ddf41153 264=head1 EXAMPLE
265
266See the example in L<ExtUtils::Packlist>.
267
354f3b56 268=head1 AUTHOR
269
270Alan Burlison <Alan.Burlison@uk.sun.com>
271
272=cut