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