home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Bundle.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-17  |  1.3 KB  |  56 lines
  1. # $File: //member/autrijus/.vimrc $ $Author: autrijus $
  2. # $Revision: #14 $ $Change: 4137 $ $DateTime: 2003/02/08 11:41:59 $
  3.  
  4. package Module::Install::Admin::Bundle;
  5. use Module::Install::Base; @ISA = qw(Module::Install::Base);
  6.  
  7. $VERSION = '0.01';
  8.  
  9. sub bundle {
  10.     my $self = shift;
  11.     my $bundle_dir = $self->_top->{bundle};
  12.  
  13.     require Cwd;
  14.     require CPANPLUS::Backend;
  15.  
  16.     my $cwd  = Cwd::getcwd();
  17.     my $cp   = CPANPLUS::Backend->new;
  18.     my $conf = $cp->configure_object;
  19.     my $modtree = $cp->module_tree;
  20.  
  21.     mkdir $bundle_dir;
  22.  
  23.     my %bundles;
  24.     while (my ($name, $version) = splice(@_, 0, 2)) {
  25.         my $fetch_result = $cp->fetch(
  26.             modules     => [$name],
  27.             fetchdir    => $bundle_dir,
  28.         );
  29.         my $rv = $fetch_result->rv or next;
  30.         my $file = $rv->{$name} or next;
  31.     $file = Cwd::abs_path($file);
  32.  
  33.         my $extract_result = $cp->extract(
  34.             files       => [$file],
  35.             extractdir  => $bundle_dir,
  36.         );
  37.  
  38.     unlink $file;
  39.  
  40.         $rv = $extract_result->rv or next;
  41.     my $filename = $rv->{$file} or next;
  42.     $bundles{$name} = $filename;
  43.     }
  44.  
  45.     chdir $cwd;
  46.  
  47.     local *FH;
  48.     open FH, ">>$bundle_dir.yml" or die $!;
  49.     foreach my $name (sort keys %bundles) {
  50.     print FH "$name: '$bundles{$name}'\n";
  51.     }
  52.     close FH;
  53. }
  54.  
  55. 1;
  56.