1 package ExtUtils::Installed;
6 use ExtUtils::Packlist;
7 use ExtUtils::MakeMaker;
13 my $Is_VMS = $^O eq 'VMS';
14 my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/);
16 require VMS::Filespec if $Is_VMS;
18 use vars qw($VERSION);
20 $VERSION = eval $VERSION;
23 my ($self, $path, $prefix) = @_;
24 return unless defined $prefix && defined $path;
27 $prefix = VMS::Filespec::unixify($prefix);
28 $path = VMS::Filespec::unixify($path);
31 # Sloppy Unix path normalization.
35 return 1 if substr($path, 0, length($prefix)) eq $prefix;
40 return 1 if $path =~ m{^\Q$prefix\E}i;
46 my ($self, $path) = @_;
48 my $man1dir = $self->{':private:'}{Config}{man1direxp};
49 my $man3dir = $self->{':private:'}{Config}{man3direxp};
50 return(($man1dir && $self->_is_prefix($path, $man1dir))
52 ($man3dir && $self->_is_prefix($path, $man3dir))
57 my ($self, $path, $type) = @_;
58 return 1 if $type eq "all";
60 return($self->_is_doc($path)) if $type eq "doc";
62 if ($type eq "prog") {
63 return($self->_is_prefix($path, $self->{':private:'}{Config}{prefix} || $self->{':private:'}{Config}{prefixexp})
65 !($self->_is_doc($path))
72 my ($self, $path, @under) = @_;
73 $under[0] = "" if (! @under);
74 foreach my $dir (@under) {
75 return(1) if ($self->_is_prefix($path, $dir));
82 my ($class) = shift(@_);
83 $class = ref($class) || $class;
89 if ($args{config_override}) {
91 $self->{':private:'}{Config} = { %{$args{config_override}} };
93 "The 'config_override' parameter must be a hash reference."
97 $self->{':private:'}{Config} = \%Config;
100 for my $tuple ([inc_override => INC => [ @INC ] ],
101 [ extra_libs => EXTRA => [] ])
103 my ($arg,$key,$val)=@$tuple;
106 $self->{':private:'}{$key} = [ @{$args{$arg}} ];
108 "The '$arg' parameter must be an array reference."
112 $self->{':private:'}{$key} = $val;
117 @{$self->{':private:'}{INC}} = grep { -e $_ && !$dupe{$_}++ }
118 @{$self->{':private:'}{INC}}, @{$self->{':private:'}{EXTRA}};
120 my $perl5lib = defined $ENV{PERL5LIB} ? $ENV{PERL5LIB} : "";
122 my @dirs = ( $self->{':private:'}{Config}{archlibexp},
123 $self->{':private:'}{Config}{sitearchexp},
124 split(/\Q$Config{path_sep}\E/, $perl5lib),
125 @{$self->{':private:'}{EXTRA}},
128 # File::Find does not know how to deal with VMS filepaths.
130 $_ = VMS::Filespec::unixify($_)
137 my $archlib = $dirs[0];
139 # Read the core packlist
140 $self->{Perl}{packlist} =
141 ExtUtils::Packlist->new( File::Spec->catfile($archlib, '.packlist') );
142 $self->{Perl}{version} = $self->{':private:'}{Config}{version};
144 # Read the module packlists
146 # Only process module .packlists
147 return if $_ ne ".packlist" || $File::Find::dir eq $archlib;
149 # Hack of the leading bits of the paths & convert to a module name
150 my $module = $File::Find::name;
153 $found = $module =~ s!\Q$_\E/?auto/(.*)/.packlist!$1!s
157 # warn "Woah! \$_=$_\n\$module=$module\n\$File::Find::dir=$File::Find::dir\n",
161 my $modfile = "$module.pm";
164 # Find the top-level module file in @INC
165 $self->{$module}{version} = '';
166 foreach my $dir (@{$self->{':private:'}{INC}}) {
167 my $p = File::Spec->catfile($dir, $modfile);
169 $module = _module_name($p, $module) if $Is_VMS;
171 $self->{$module}{version} = MM->parse_version($p);
177 $self->{$module}{packlist} =
178 ExtUtils::Packlist->new($File::Find::name);
181 @dirs= grep { -e $_ && !$dupe{$_}++ } @dirs;
182 $self->{':private:'}{LIBDIRS} = \@dirs;
183 find($sub, @dirs) if @dirs;
185 return(bless($self, $class));
188 # VMS's non-case preserving file-system means the package name can't
189 # be reconstructed from the filename.
191 my($file, $orig_module) = @_;
194 if (open PACKFH, $file) {
196 if (/package\s+(\S+)\s*;/) {
198 # Make a sanity check, that lower case $module
199 # is identical to lowercase $pack before
201 if (lc($pack) eq lc($orig_module)) {
210 print STDERR "Couldn't figure out the package name for $file\n"
221 # Bug/feature of sort in scalar context requires this.
223 ? sort grep { not /^:private:$/ } keys %$self
224 : grep { not /^:private:$/ } keys %$self;
228 my ($self, $module, $type, @under) = @_;
231 Carp::croak("$module is not installed") if (! exists($self->{$module}));
232 $type = "all" if (! defined($type));
233 Carp::croak('type must be "all", "prog" or "doc"')
234 if ($type ne "all" && $type ne "prog" && $type ne "doc");
237 foreach my $file (keys(%{$self->{$module}{packlist}})) {
239 if ($self->_is_type($file, $type) &&
240 $self->_is_under($file, @under));
246 my ($self, $module, $type, @under) = @_;
248 foreach my $file ($self->files($module, $type, @under)) {
249 $dirs{dirname($file)}++;
251 return sort keys %dirs;
255 my ($self, $module, $type, @under) = @_;
257 foreach my $dir ($self->directories($module, $type, @under)) {
260 while ($last ne $dir) {
262 $dir = dirname($dir);
263 last if !$self->_is_under($dir, @under);
267 return(sort(keys(%dirs)));
271 my ($self, $module, $remove) = @_;
272 Carp::croak("$module is not installed") if (! exists($self->{$module}));
273 return($self->{$module}{packlist}->validate($remove));
277 my ($self, $module) = @_;
278 Carp::croak("$module is not installed") if (! exists($self->{$module}));
279 return($self->{$module}{packlist});
283 my ($self, $module) = @_;
284 Carp::croak("$module is not installed") if (! exists($self->{$module}));
285 return($self->{$module}{version});
295 ExtUtils::Installed - Inventory management of installed modules
299 use ExtUtils::Installed;
300 my ($inst) = ExtUtils::Installed->new();
301 my (@modules) = $inst->modules();
302 my (@missing) = $inst->validate("DBI");
303 my $all_files = $inst->files("DBI");
304 my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local");
305 my $all_dirs = $inst->directories("DBI");
306 my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog");
307 my $packlist = $inst->packlist("DBI");
311 ExtUtils::Installed provides a standard way to find out what core and module
312 files have been installed. It uses the information stored in .packlist files
313 created during installation to provide this information. In addition it
314 provides facilities to classify the installed files and to extract directory
315 information from the .packlist files.
319 The new() function searches for all the installed .packlists on the system, and
320 stores their contents. The .packlists can be queried with the functions
321 described below. Where it searches by default is determined by the settings found
322 in C<%Config::Config>, and what the value is of the PERL5LIB environment variable.
330 This takes optional named parameters. Without parameters, this
331 searches for all the installed .packlists on the system using
332 information from C<%Config::Config> and the default module search
333 paths C<@INC>. The packlists are read using the
334 L<ExtUtils::Packlist> module.
336 If the named parameter C<config_override> is specified,
337 it should be a reference to a hash which contains all information
338 usually found in C<%Config::Config>. For example, you can obtain
339 the configuration information for a separate perl installation and
342 my $yoda_cfg = get_fake_config('yoda');
343 my $yoda_inst = ExtUtils::Installed->new(config_override=>$yoda_cfg);
345 Similarly, the parameter C<inc_override> may be a reference to an
346 array which is used in place of the default module search paths
350 my @dirs = split(/\Q$Config{path_sep}\E/, $ENV{PERL5LIB});
351 my $p5libs = ExtUtils::Installed->new(inc_override=>\@dirs);
353 The parameter c<extra_libs> can be used to specify B<additional> paths to
354 search for installed modules. For instance
356 my $installed = ExtUtils::Installed->new(extra_libs=>["/my/lib/path"]);
358 This should only be necessary if C</my/lib/path> is not in PERL5LIB.
362 This returns a list of the names of all the installed modules. The perl 'core'
363 is given the special name 'Perl'.
367 This takes one mandatory parameter, the name of a module. It returns a list of
368 all the filenames from the package. To obtain a list of core perl files, use
369 the module name 'Perl'. Additional parameters are allowed. The first is one
370 of the strings "prog", "doc" or "all", to select either just program files,
371 just manual files or all files. The remaining parameters are a list of
372 directories. The filenames returned will be restricted to those under the
373 specified directories.
377 This takes one mandatory parameter, the name of a module. It returns a list of
378 all the directories from the package. Additional parameters are allowed. The
379 first is one of the strings "prog", "doc" or "all", to select either just
380 program directories, just manual directories or all directories. The remaining
381 parameters are a list of directories. The directories returned will be
382 restricted to those under the specified directories. This method returns only
383 the leaf directories that contain files from the specified module.
385 =item directory_tree()
387 This is identical in operation to directories(), except that it includes all the
388 intermediate directories back up to the specified directories.
392 This takes one mandatory parameter, the name of a module. It checks that all
393 the files listed in the modules .packlist actually exist, and returns a list of
394 any missing files. If an optional second argument which evaluates to true is
395 given any missing files will be removed from the .packlist
399 This returns the ExtUtils::Packlist object for the specified module.
403 This returns the version number for the specified module.
409 See the example in L<ExtUtils::Packlist>.
413 Alan Burlison <Alan.Burlison@uk.sun.com>