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