[Bps-public-commit] r10786 - in Shipwright/lib/Shipwright: Script

sunnavy at bestpractical.com sunnavy at bestpractical.com
Sun Feb 10 06:21:19 EST 2008


Author: sunnavy
Date: Sun Feb 10 06:21:19 2008
New Revision: 10786

Modified:
   Shipwright/lib/Shipwright/Script/Import.pm
   Shipwright/lib/Shipwright/Source/Base.pm
   Shipwright/lib/Shipwright/Source/CPAN.pm
   Shipwright/lib/Shipwright/Source/Compressed.pm
   Shipwright/lib/Shipwright/Source/Directory.pm
   Shipwright/lib/Shipwright/Source/FTP.pm
   Shipwright/lib/Shipwright/Source/HTTP.pm
   Shipwright/lib/Shipwright/Source/SVK.pm
   Shipwright/lib/Shipwright/Source/SVN.pm

Log:
refactor a bit, also bug fixes

Modified: Shipwright/lib/Shipwright/Script/Import.pm
==============================================================================
--- Shipwright/lib/Shipwright/Script/Import.pm	(original)
+++ Shipwright/lib/Shipwright/Script/Import.pm	Sun Feb 10 06:21:19 2008
@@ -89,8 +89,14 @@
                         $shipwright->backend->map || {} ));
         }
 
-        Shipwright::Util::DumpFile( $shipwright->source->map_path,
-            $shipwright->backend->map || {} );
+        Shipwright::Util::DumpFile(
+            $shipwright->source->map_path,
+            Hash::Merge::merge(
+                $shipwright->backend->map || {},
+                Shipwright::Util::LoadFile( $shipwright->source->map_path )
+                  || {}
+            )
+        );
 
         $self->source(
             $shipwright->source->run(

Modified: Shipwright/lib/Shipwright/Source/Base.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/Base.pm	(original)
+++ Shipwright/lib/Shipwright/Source/Base.pm	Sun Feb 10 06:21:19 2008
@@ -36,8 +36,6 @@
         Shipwright::Util->run($_);
     }
     $self->_copy( %{ $args{copy} } ) if $args{copy};
-    $self->_make_maps( $self->name, $self->source )
-      unless $self->name =~ /^cpan-/;
 }
 
 # you should subclass this method.
@@ -77,7 +75,9 @@
 
             $source = read_file( File::Spec->catfile('Build.PL') )
               or die "can't read Build.PL: $!";
-            if ( $source =~ /Module::Build/ && $self->name ne 'Module-Build' ) {
+            if (   $source =~ /Module::Build/
+                && $self->name ne 'cpan-Module-Build' )
+            {
                 unless ( $require->{build_requires}{'Module::Build'} ) {
                     $require->{build_requires} = { 'Module::Build' => 0 };
                 }
@@ -102,7 +102,7 @@
               or die "can't read Makefile.PL: $!";
 
             if (   $source =~ /ExtUtils::/
-                && $self->name ne 'ExtUtils-MakeMaker' )
+                && $self->name ne 'cpan-ExtUtils-MakeMaker' )
             {
                 unless ( defined $require->{requires}{'ExtUtils::MakeMaker'}
                     && $require->{requires}{'ExtUtils::MakeMaker'} >= 6.31 )
@@ -171,56 +171,70 @@
                     next;
                 }
 
+                my $name = $module;
                 if ( $self->_is_skipped($module) ) {
-                    delete $require->{$type}{$module};
-                    next;
+                    delete $require->{$type}{$module} unless $map->{$module};
                 }
+                else {
 
-                opendir my $dir, $self->directory;
-                my @sources = readdir $dir;
+                    opendir my $dir, $self->directory;
+                    my @sources = readdir $dir;
 
-                close $dir;
+                    close $dir;
 
-                my $name;
-                if ( $map->{$module} ) {
-                    $name = $map->{$module};
-                }
-                else {
-                    $name = $module;
-                    $name =~ s/::/-/g;
-                }
+                    #reload map
+                    if ( -e $self->map_path ) {
+                        $map = Shipwright::Util::LoadFile( $self->map_path );
+                    }
 
-                unless ( grep { $name eq $_ } @sources ) {
-                    my $s;
-                    my $cwd = getcwd;
-                    chdir $self->directory;
-                    if (   $require->{$type}{$module}{source}
-                        && $require->{$type}{$module}{source} ne 'CPAN' )
-                    {
-                        $s = Shipwright::Source->new(
-                            %$self,
-                            source => $require->{$type}{$module}{source},
-                            name   => $name
-                        );
+                    if ( $map->{$module} && $map->{$module} =~ /^cpan-/ ) {
+                        $name = $map->{$module};
                     }
                     else {
-                        $s = Shipwright::Source->new(
-                            %$self,
-                            source => $module,
-                            name   => $name,
-                        );
+
+                        # assuming it's a CPAN module
+                        $name =~ s/::/-/g;
+                        $name = 'cpan-' . $name unless $name =~ /^cpan-/;
+                    }
+
+                    unless ( grep { $name eq $_ } @sources ) {
+                        my $s;
+                        my $cwd = getcwd;
+                        chdir $self->directory;
+                        if (   $require->{$type}{$module}{source}
+                            && $require->{$type}{$module}{source} ne 'CPAN' )
+                        {
+                            $s = Shipwright::Source->new(
+                                %$self,
+                                source => $require->{$type}{$module}{source},
+                                name   => $name,
+                            );
+                        }
+                        else {
+                            $s = Shipwright::Source->new(
+                                %$self,
+                                source => $module,
+                                name   => '', # cpan name is automaticaly fixed.
+                            );
+                        }
+                        $s->run();
+                        chdir $cwd;
                     }
-                    $s->run();
-                    chdir $cwd;
-                }
 
-                # reload map
-                if ( -e $self->map_path ) {
-                    $map = Shipwright::Util::LoadFile( $self->map_path );
+                    # reload map
+                    if ( -e $self->map_path ) {
+                        $map = Shipwright::Util::LoadFile( $self->map_path );
+                    }
                 }
 
-                $require->{$type}{ $map->{$module} || $name } =
-                  delete $require->{$type}{$module};
+                if ( $map->{$module} && $map->{$module} =~ /^cpan-/ ) {
+                    $require->{$type}{ $map->{$module} } =
+                      delete $require->{$type}{$module};
+                }
+                else {
+                    $require->{$type}{$name} =
+                      delete $require->{$type}{$module};
+                }
             }
         }
 
@@ -247,6 +261,7 @@
 
     $map->{$module} = $dist;
     Shipwright::Util::DumpFile( $self->map_path, $map );
+    warn $self->map_path;
 
 }
 
@@ -290,8 +305,9 @@
 sub just_name {
     my $self = shift;
     my $name = shift;
+    $name .= '.tar.gz' unless $name =~ /(tar\.gz|tgz|tar\.bz2)$/;
     require CPAN::DistnameInfo;
-    return CPAN::DistnameInfo->new("$name.tar.gz")->dist;
+    return CPAN::DistnameInfo->new($name)->dist;
 }
 
 1;

Modified: Shipwright/lib/Shipwright/Source/CPAN.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/CPAN.pm	(original)
+++ Shipwright/lib/Shipwright/Source/CPAN.pm	Sun Feb 10 06:21:19 2008
@@ -55,7 +55,8 @@
     my $self = shift;
     $self->log->info( "prepare to run source: " . $self->source );
     if ( $self->_run ) {
-        my $compressed = Shipwright::Source::Compressed->new(%$self);
+        my $compressed =
+          Shipwright::Source::Compressed->new( %$self, _no_map => 1 );
         $compressed->run(@_);
     }
 }
@@ -76,7 +77,7 @@
     $module->distribution->get;
 
     my $dist = CPAN::DistnameInfo->new( $module->cpan_file )->dist;
-    $self->name('cpan-' . $dist);
+    $self->name( 'cpan-' . $dist );
     $self->_make_maps( $self->source, 'cpan-' . $dist );
 
     $self->source(

Modified: Shipwright/lib/Shipwright/Source/Compressed.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/Compressed.pm	(original)
+++ Shipwright/lib/Shipwright/Source/Compressed.pm	Sun Feb 10 06:21:19 2008
@@ -13,16 +13,16 @@
 
 sub run {
     my $self = shift;
-    $self->log->info(
-        'run source ' . ( $self->name || $self->path ) . ': ' . $self->source );
+
+    $self->name( $self->just_name( $self->path ) ) unless $self->name;
+    $self->log->info( 'run source ' . $self->name . ': ' . $self->source );
+
+    $self->_make_maps( $self->name, $self->source ) unless $self->{_no_map};
+
     my $ret = $self->SUPER::run(@_);
-    $self->_follow(
-        File::Spec->catfile(
-            $self->directory, $self->name || $self->just_name( $self->path )
-        )
-    ) if $self->follow;
-    return File::Spec->catfile( $self->directory,
-        $self->name || $self->just_name( $self->path ) );
+    $self->_follow( File::Spec->catfile( $self->directory, $self->name ) )
+      if $self->follow;
+    return File::Spec->catfile( $self->directory, $self->name );
 }
 
 =head2 path

Modified: Shipwright/lib/Shipwright/Source/Directory.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/Directory.pm	(original)
+++ Shipwright/lib/Shipwright/Source/Directory.pm	Sun Feb 10 06:21:19 2008
@@ -28,6 +28,10 @@
     my $self = shift;
     $self->log->info(
         'run source ' . ( $self->name || $self->path ) . ': ' . $self->source );
+
+    $self->_make_maps( $self->name || $self->just_name( $self->path ),
+        $self->source ) unless $self->{_no_map};
+
     $self->SUPER::run(@_);
     $self->_follow(
         File::Spec->catfile(

Modified: Shipwright/lib/Shipwright/Source/FTP.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/FTP.pm	(original)
+++ Shipwright/lib/Shipwright/Source/FTP.pm	Sun Feb 10 06:21:19 2008
@@ -14,27 +14,28 @@
 
 sub run {
     my $self = shift;
-    $self->log->info("prepare to run source: " . $self->source );
+    $self->log->info( "prepare to run source: " . $self->source );
     $self->SUPER::run();
-    my $compressed = Shipwright::Source::Compressed->new( %$self );
+    my $compressed =
+      Shipwright::Source::Compressed->new( %$self, _no_map => 1 );
     $compressed->run();
 }
 
-
 =head2 _cmd
 
 =cut
 
 sub _cmd {
-    my $self = shift;
+    my $self   = shift;
     my $source = $self->source;
     my $file;
     if ( $source =~ m{.*/(.+\.(tar\.gz|tgz|tar\.bz2))$} ) {
         $file = $1;
+        $self->_make_maps( $self->just_name( $file ), $source );
         my $src_dir = $self->download_directory;
         mkdir $src_dir unless -e $src_dir;
         $self->source( File::Spec->catfile( $src_dir, $file ) );
-        return ['wget', $source, '-O', $self->source];
+        return [ 'wget', $source, '-O', $self->source ];
     }
     else {
         croak "invalid source: $source";

Modified: Shipwright/lib/Shipwright/Source/HTTP.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/HTTP.pm	(original)
+++ Shipwright/lib/Shipwright/Source/HTTP.pm	Sun Feb 10 06:21:19 2008
@@ -14,34 +14,37 @@
 
 sub run {
     my $self = shift;
-    $self->log->info("prepare to run source: " . $self->source );
+
+    $self->log->info( "prepare to run source: " . $self->source );
+
     $self->SUPER::run();
-    my $compressed = Shipwright::Source::Compressed->new( %$self );
+    my $compressed =
+      Shipwright::Source::Compressed->new( %$self, _no_map => 1 );
     $compressed->run();
 }
 
-
 =head2 _cmd
 
 =cut
 
 sub _cmd {
-    my $self = shift;
+    my $self   = shift;
     my $source = $self->source;
     my $file;
     if ( $source =~ m{.*/(.+\.(tar\.gz|tgz|tar\.bz2))$} ) {
         $file = $1;
+        $self->_make_maps( $self->just_name( $file ), $source );
+
         my $src_dir = $self->download_directory;
         mkdir $src_dir unless -e $src_dir;
         $self->source( File::Spec->catfile( $src_dir, $file ) );
-        return ['wget', $source, '-O', $self->source];
+        return [ 'wget', $source, '-O', $self->source ];
     }
     else {
         croak "invalid source: $source";
     }
 }
 
-
 1;
 
 __END__

Modified: Shipwright/lib/Shipwright/Source/SVK.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/SVK.pm	(original)
+++ Shipwright/lib/Shipwright/Source/SVK.pm	Sun Feb 10 06:21:19 2008
@@ -14,7 +14,11 @@
 sub new {
     my $class = shift;
     my $self  = $class->SUPER::new(@_);
-    my $s     = $self->source;
+
+    $self->name( $self->just_name( $self->source ) ) unless $self->name;
+    $self->_make_maps( $self->name, $self->source );
+
+    my $s = $self->source;
     $s =~ s!^\s*svk:!!;
     $self->source($s);
     return $self;
@@ -26,16 +30,16 @@
 
 sub run {
     my $self = shift;
-    $self->log->info("prepare to run source: " . $self->source );
+    $self->log->info( "prepare to run source: " . $self->source );
     $self->_run;
     my $s;
     if ( $self->_is_compressed ) {
         require Shipwright::Source::Compressed;
-        $s = Shipwright::Source::Compressed->new(%$self);
+        $s = Shipwright::Source::Compressed->new( %$self, _no_map => 1 );
     }
     else {
         require Shipwright::Source::Directory;
-        $s = Shipwright::Source::Directory->new(%$self);
+        $s = Shipwright::Source::Directory->new( %$self, _no_map => 1 );
     }
     $s->run(@_);
 }
@@ -48,38 +52,20 @@
     my $self   = shift;
     my $source = $self->source;
     my @cmds;
-    push @cmds, ['svk',  'co', $self->source,
-      File::Spec->catfile( $self->download_directory,
-        $self->name || $self->path )];
-    push @cmds, [ 'svk', 'co', '-d',
-      File::Spec->catfile( $self->download_directory,
-        $self->name || $self->path )];
+    push @cmds,
+      [
+        'svk', 'co', $self->source,
+        File::Spec->catfile( $self->download_directory, $self->name )
+      ];
+    push @cmds,
+      [
+        'svk', 'co', '-d',
+        File::Spec->catfile( $self->download_directory, $self->name )
+      ];
 
     $self->source(
-        File::Spec->catfile(
-            $self->download_directory, $self->name || $self->path
-        )
-    );
-    Shipwright::Util->run( $_ ) for @cmds;
-}
-
-=head2 path
-
-return path which will be used in download_directory.
-
-=cut
-
-sub path {
-    my $self = shift;
-    if ( $self->source =~ m{.*/(.+)\.(tar.(gz|bz2)|tgz)$} ) {
-        return $1;
-    }
-    elsif ( $self->source =~ m{.*/(.+)/?$} ) {
-        return $1;
-    }
-    else {
-        croak "invalid source, I can't guess the path";
-    }
+        File::Spec->catfile( $self->download_directory, $self->name ) );
+    Shipwright::Util->run($_) for @cmds;
 }
 
 sub _is_compressed {

Modified: Shipwright/lib/Shipwright/Source/SVN.pm
==============================================================================
--- Shipwright/lib/Shipwright/Source/SVN.pm	(original)
+++ Shipwright/lib/Shipwright/Source/SVN.pm	Sun Feb 10 06:21:19 2008
@@ -14,9 +14,14 @@
 sub new {
     my $class = shift;
     my $self  = $class->SUPER::new(@_);
-    my $s     = $self->source;
+
+    $self->name( $self->just_name( $self->source ) ) unless $self->name;
+    $self->_make_maps( $self->name, $self->source );
+
+    my $s = $self->source;
     $s =~ s!^\s*svn:!!;
     $self->source($s);
+    $self->name( $self->just_name( $self->source ) );
     return $self;
 }
 
@@ -26,16 +31,16 @@
 
 sub run {
     my $self = shift;
-    $self->log->info("prepare to run source: " . $self->source );
+    $self->log->info( "prepare to run source: " . $self->source );
     $self->_run;
     my $s;
     if ( $self->_is_compressed ) {
         require Shipwright::Source::Compressed;
-        $s = Shipwright::Source::Compressed->new(%$self);
+        $s = Shipwright::Source::Compressed->new( %$self, _no_map => 1 );
     }
     else {
         require Shipwright::Source::Directory;
-        $s = Shipwright::Source::Directory->new(%$self);
+        $s = Shipwright::Source::Directory->new( %$self, _no_map => 1 );
     }
     $s->run(@_);
 }
@@ -48,37 +53,12 @@
     my $self   = shift;
     my $source = $self->source;
     my $cmd    = [
-        'svn', 'export',
-        $self->source,
-        File::Spec->catfile(
-            $self->download_directory, $self->name || $self->path
-        )
+        'svn', 'export', $self->source,
+        File::Spec->catfile( $self->download_directory, $self->name )
     ];
     $self->source(
-        File::Spec->catfile(
-            $self->download_directory, $self->name || $self->path
-        )
-    );
-    Shipwright::Util->run( $cmd );
-}
-
-=head2 path
-
-return path which will be used in download_directory.
-
-=cut
-
-sub path {
-    my $self = shift;
-    if ( $self->source =~ m{.*/(.+)\.(tar.(gz|bz2)|tgz)$} ) {
-        return $1;
-    }
-    elsif ( $self->source =~ m{.*/(.+)/?$} ) {
-        return $1;
-    }
-    else {
-        croak "invalid source, I can't guess the path";
-    }
+        File::Spec->catfile( $self->download_directory, $self->name ) );
+    Shipwright::Util->run($cmd);
 }
 
 sub _is_compressed {



More information about the Bps-public-commit mailing list