1 package ExtUtils::Installed;
5 #use warnings; # XXX requires 5.6
7 use ExtUtils::Packlist;
8 use ExtUtils::MakeMaker;
14 my $Is_VMS = $^O eq 'VMS';
15 my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/);
17 require VMS::Filespec if $Is_VMS;
19 use vars qw($VERSION);
20 $VERSION = '1.999_001';
21 $VERSION = eval $VERSION;
24 my ($self, $path, $prefix) = @_;
25 return unless defined $prefix && defined $path;
28 $prefix = VMS::Filespec::unixify($prefix);
29 $path = VMS::Filespec::unixify($path);
32 # Unix path normalization.
33 $prefix = File::Spec->canonpath($prefix);
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";
61 my $conf= $self->{':private:'}{Config};
62 if ($type eq "prog") {
63 return($self->_is_prefix($path, $conf->{prefix} || $conf->{prefixexp})
64 && !($self->_is_doc($path)) ? 1 : 0);
70 my ($self, $path, @under) = @_;
71 $under[0] = "" if (! @under);
72 foreach my $dir (@under) {
73 return(1) if ($self->_is_prefix($path, $dir));
80 my ($self, @dirs)= @_;
81 # File::Find does not know how to deal with VMS filepaths.
83 $_ = VMS::Filespec::unixify($_)
90 return wantarray ? @dirs : $dirs[0];
94 my ($self, $module, $packlist_file, $modfile)= @_;
98 packlist => scalar(ExtUtils::Packlist->new($packlist_file)),
99 packlist_file => $packlist_file,
103 $data->{version} = $self->{':private:'}{Config}{version};
105 $data->{modfile} = $modfile;
106 # Find the top-level module file in @INC
107 $data->{version} = '';
108 foreach my $dir (@{$self->{':private:'}{INC}}) {
109 my $p = File::Spec->catfile($dir, $modfile);
111 $module = _module_name($p, $module) if $Is_VMS;
113 $data->{version} = MM->parse_version($p);
114 $data->{version_from} = $p;
115 $data->{packlist_valid} = exists $data->{packlist}{$p};
120 $self->{$module}= $data;
125 my ($class) = shift(@_);
126 $class = ref($class) || $class;
130 return $INSTALLED if $INSTALLED and ($args{default_get} || $args{default});
132 my $self = bless {}, $class;
134 $INSTALLED= $self if $args{default_set} || $args{default};
137 if ($args{config_override}) {
139 $self->{':private:'}{Config} = { %{$args{config_override}} };
141 "The 'config_override' parameter must be a hash reference."
145 $self->{':private:'}{Config} = \%Config;
148 for my $tuple ([inc_override => INC => [ @INC ] ],
149 [ extra_libs => EXTRA => [] ])
151 my ($arg,$key,$val)=@$tuple;
154 $self->{':private:'}{$key} = [ @{$args{$arg}} ];
156 "The '$arg' parameter must be an array reference."
160 $self->{':private:'}{$key} = $val;
165 @{$self->{':private:'}{LIBDIRS}} = grep { -e $_ && !$dupe{$_}++ }
166 @{$self->{':private:'}{EXTRA}}, @{$self->{':private:'}{INC}};
169 my @dirs= $self->_fix_dirs(@{$self->{':private:'}{LIBDIRS}});
171 # Read the core packlist
172 my $archlib = $self->_fix_dirs($self->{':private:'}{Config}{archlibexp});
173 $self->_make_entry("Perl",File::Spec->catfile($archlib, '.packlist'));
176 # Read the module packlists
178 # Only process module .packlists
179 return if $_ ne ".packlist" || $File::Find::dir eq $archlib;
181 # Hack of the leading bits of the paths & convert to a module name
182 my $module = $File::Find::name;
183 my $found = $module =~ s!^.*?/auto/(.*)/.packlist!$1!s
185 # warn "Woah! \$_=$_\n\$module=$module\n\$File::Find::dir=$File::Find::dir\n",
190 my $modfile = "$module.pm";
193 return if $self->{$module}; #shadowing?
194 $self->_make_entry($module,$File::Find::name,$modfile);
205 # VMS's non-case preserving file-system means the package name can't
206 # be reconstructed from the filename.
208 my($file, $orig_module) = @_;
211 if (open PACKFH, $file) {
213 if (/package\s+(\S+)\s*;/) {
215 # Make a sanity check, that lower case $module
216 # is identical to lowercase $pack before
218 if (lc($pack) eq lc($orig_module)) {
227 print STDERR "Couldn't figure out the package name for $file\n"
235 $self= $self->new(default=>1) if !ref $self;
237 # Bug/feature of sort in scalar context requires this.
239 ? sort grep { not /^:private:$/ } keys %$self
240 : grep { not /^:private:$/ } keys %$self;
244 my ($self, $module, $type, @under) = @_;
245 $self= $self->new(default=>1) if !ref $self;
248 Carp::croak("$module is not installed") if (! exists($self->{$module}));
249 $type = "all" if (! defined($type));
250 Carp::croak('type must be "all", "prog" or "doc"')
251 if ($type ne "all" && $type ne "prog" && $type ne "doc");
254 foreach my $file (keys(%{$self->{$module}{packlist}})) {
256 if ($self->_is_type($file, $type) &&
257 $self->_is_under($file, @under));
263 my ($self, $module, $type, @under) = @_;
264 $self= $self->new(default=>1) if !ref $self;
266 foreach my $file ($self->files($module, $type, @under)) {
267 $dirs{dirname($file)}++;
269 return sort keys %dirs;
273 my ($self, $module, $type, @under) = @_;
274 $self= $self->new(default=>1) if !ref $self;
276 foreach my $dir ($self->directories($module, $type, @under)) {
279 while ($last ne $dir) {
281 $dir = dirname($dir);
282 last if !$self->_is_under($dir, @under);
286 return(sort(keys(%dirs)));
290 my ($self, $module, $remove) = @_;
291 $self= $self->new(default=>1) if !ref $self;
292 Carp::croak("$module is not installed") if (! exists($self->{$module}));
293 return($self->{$module}{packlist}->validate($remove));
297 my ($self, $module) = @_;
298 $self= $self->new(default=>1) if !ref $self;
299 Carp::croak("$module is not installed") if (! exists($self->{$module}));
300 return($self->{$module}{packlist});
304 my ($self, $module) = @_;
305 $self= $self->new(default=>1) if !ref $self;
306 Carp::croak("$module is not installed") if (! exists($self->{$module}));
307 return($self->{$module}{version});
311 my ($self, $module) = @_;
312 $self= $self->new(default=>1) if !ref $self;
313 local $self->{":private:"}{Config};
314 require Data::Dumper;
315 print Data::Dumper->new([$self])->Sortkeys(1)->Indent(1)->Dump();
325 ExtUtils::Installed - Inventory management of installed modules
329 use ExtUtils::Installed;
330 my ($inst) = ExtUtils::Installed->new();
331 my (@modules) = $inst->modules();
332 my (@missing) = $inst->validate("DBI");
333 my $all_files = $inst->files("DBI");
334 my $files_below_usr_local = $inst->files("DBI", "all", "/usr/local");
335 my $all_dirs = $inst->directories("DBI");
336 my $dirs_below_usr_local = $inst->directory_tree("DBI", "prog");
337 my $packlist = $inst->packlist("DBI");
341 ExtUtils::Installed provides a standard way to find out what core and module
342 files have been installed. It uses the information stored in .packlist files
343 created during installation to provide this information. In addition it
344 provides facilities to classify the installed files and to extract directory
345 information from the .packlist files.
349 The new() function searches for all the installed .packlists on the system, and
350 stores their contents. The .packlists can be queried with the functions
351 described below. Where it searches by default is determined by the settings found
352 in C<%Config::Config>, and what the value is of the PERL5LIB environment variable.
356 Unless specified otherwise all method can be called as class methods, or as object
357 methods. If called as class methods then the "default" object will be used, and if
358 necessary created using the current processes %Config and @INC. See the
359 'default' option to new() for details.
366 This takes optional named parameters. Without parameters, this
367 searches for all the installed .packlists on the system using
368 information from C<%Config::Config> and the default module search
369 paths C<@INC>. The packlists are read using the
370 L<ExtUtils::Packlist> module.
372 If the named parameter C<config_override> is specified,
373 it should be a reference to a hash which contains all information
374 usually found in C<%Config::Config>. For example, you can obtain
375 the configuration information for a separate perl installation and
378 my $yoda_cfg = get_fake_config('yoda');
379 my $yoda_inst = ExtUtils::Installed->new(config_override=>$yoda_cfg);
381 Similarly, the parameter C<inc_override> may be a reference to an
382 array which is used in place of the default module search paths
386 my @dirs = split(/\Q$Config{path_sep}\E/, $ENV{PERL5LIB});
387 my $p5libs = ExtUtils::Installed->new(inc_override=>\@dirs);
389 B<Note>: You probably do not want to use these options alone, almost always
390 you will want to set both together.
392 The parameter c<extra_libs> can be used to specify B<additional> paths to
393 search for installed modules. For instance
395 my $installed = ExtUtils::Installed->new(extra_libs=>["/my/lib/path"]);
397 This should only be necessary if C</my/lib/path> is not in PERL5LIB.
399 Finally there is the 'default', and the related 'default_get' and 'default_set'
400 options. These options control the "default" object which is provided by the
401 class interface to the methods. Setting C<default_get> to true tells the constructor
402 to return the default object if it is defined. Setting C<default_set> to true tells
403 the constructor to make the default object the constructed object. Setting the
404 C<default> option is like setting both to true. This is used primarily internally
405 and probably isn't interesting to any real user.
409 This returns a list of the names of all the installed modules. The perl 'core'
410 is given the special name 'Perl'.
414 This takes one mandatory parameter, the name of a module. It returns a list of
415 all the filenames from the package. To obtain a list of core perl files, use
416 the module name 'Perl'. Additional parameters are allowed. The first is one
417 of the strings "prog", "doc" or "all", to select either just program files,
418 just manual files or all files. The remaining parameters are a list of
419 directories. The filenames returned will be restricted to those under the
420 specified directories.
424 This takes one mandatory parameter, the name of a module. It returns a list of
425 all the directories from the package. Additional parameters are allowed. The
426 first is one of the strings "prog", "doc" or "all", to select either just
427 program directories, just manual directories or all directories. The remaining
428 parameters are a list of directories. The directories returned will be
429 restricted to those under the specified directories. This method returns only
430 the leaf directories that contain files from the specified module.
432 =item directory_tree()
434 This is identical in operation to directories(), except that it includes all the
435 intermediate directories back up to the specified directories.
439 This takes one mandatory parameter, the name of a module. It checks that all
440 the files listed in the modules .packlist actually exist, and returns a list of
441 any missing files. If an optional second argument which evaluates to true is
442 given any missing files will be removed from the .packlist
446 This returns the ExtUtils::Packlist object for the specified module.
450 This returns the version number for the specified module.
456 See the example in L<ExtUtils::Packlist>.
460 Alan Burlison <Alan.Burlison@uk.sun.com>