lib/ExtUtils/Installed.pm

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