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