[Bps-public-commit] r9753 - in bpsbuilder/BPB: examples lib/BPB lib/BPB/Source

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Wed Nov 28 10:09:16 2007
New Revision: 9753

Added:
   bpsbuilder/BPB/lib/BPB/Source/
   bpsbuilder/BPB/lib/BPB/Source.pm
   bpsbuilder/BPB/lib/BPB/Source/Compressed.pm
Modified:
   bpsbuilder/BPB/examples/config.yml
   bpsbuilder/BPB/lib/BPB.pm

Log:
initial Compressed Source support

Modified: bpsbuilder/BPB/examples/config.yml
==============================================================================
--- bpsbuilder/BPB/examples/config.yml	(original)
+++ bpsbuilder/BPB/examples/config.yml	Wed Nov 28 10:09:16 2007
@@ -3,3 +3,7 @@
     backend:
         module: SVK
         command: '/usr/bin/svk'
+    source:
+        command:
+            tar: '/usr/bin/tar'
+        directory: '/tmp'

Modified: bpsbuilder/BPB/lib/BPB.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB.pm	(original)
+++ bpsbuilder/BPB/lib/BPB.pm	Wed Nov 28 10:09:16 2007
@@ -8,10 +8,11 @@
 
 use base qw/Class::Accessor::Fast/;
 
-__PACKAGE__->mk_accessors(qw/config backend/);
+__PACKAGE__->mk_accessors(qw/config backend source/);
 
 use BPB::Config;
 use BPB::Backend;
+use BPB::Source;
 
 =head2 new
 
@@ -34,10 +35,12 @@
     bless $self, $class;
 
     $self->config(
-        BPB::Config->new( config => $args{config}, moniker => $args{moniker} )
+        BPB::Config->new( config => delete $args{config}, moniker => delete $args{moniker} )
     );
     $self->backend(
         BPB::Backend->new( %{ $self->config->moniker->{backend} }, ) );
+    $self->source( BPB::Source->new( %{ $self->config->moniker->{source}},
+                %args ) );
 
     return $self;
 }

Added: bpsbuilder/BPB/lib/BPB/Source.pm
==============================================================================
--- (empty file)
+++ bpsbuilder/BPB/lib/BPB/Source.pm	Wed Nov 28 10:09:16 2007
@@ -0,0 +1,101 @@
+package BPB::Source;
+
+use warnings;
+use strict;
+use Carp;
+use UNIVERSAL::require;
+
+our %DEFAULT = ( directory => '/tmp', command => { tar => 'tar' } );
+
+=head2 new
+
+=cut
+
+sub new {
+    my $class = shift;
+    my %args = ( %DEFAULT, @_ );
+
+    my $type = delete $args{type} || type( $args{source} );
+
+    croak "need source option" unless $args{source};
+
+    my $module = 'BPB::Source::' . $type;
+
+    $module->require or die $@;
+
+    return $module->new(%args);
+
+}
+
+sub type {
+    my $source = shift;
+
+    if ( -e $source ) {
+        if ( -d $source ) {
+            return 'Directory';
+        }
+        elsif ( -f $source && $source =~ /tar\.(gz|bz2)$/ ) {
+            return 'Compressed';
+        }
+        else {
+            croak "only support directory and compressed file which can be decompressed to a directory";
+        }
+    }
+    elsif ( $source =~ m{http://} ) {
+        return 'HTTP';
+    }
+    elsif ( $source =~ m{ftp://} ) {
+        return 'FTP';
+    }
+    else {
+        return 'CPAN';
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+BPB::Source - 
+
+
+=head1 SYNOPSIS
+
+    use BPB::Source;
+
+=head1 DESCRIPTION
+
+
+=head1 INTERFACE
+
+
+
+=head1 DEPENDENCIES
+
+
+None.
+
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported.
+
+=head1 AUTHOR
+
+sunnavy  C<< <sunnavy at bestpractical.com> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright 2007 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+

Added: bpsbuilder/BPB/lib/BPB/Source/Compressed.pm
==============================================================================
--- (empty file)
+++ bpsbuilder/BPB/lib/BPB/Source/Compressed.pm	Wed Nov 28 10:09:16 2007
@@ -0,0 +1,96 @@
+package BPB::Source::Compressed;
+
+use warnings;
+use strict;
+use Carp;
+
+use base qw/Class::Accessor::Fast BPB::Source/;
+__PACKAGE__->mk_accessors(qw/source directory command/);
+
+=head2 new
+
+=cut
+
+sub new {
+    my $class = shift;
+    bless {@_}, $class;
+}
+
+=head2 run
+
+=cut
+
+sub run {
+    my $self = shift;
+    my $cmd  = $self->_cmd;
+    $self->_run($cmd);
+}
+
+sub _cmd {
+    my $self = shift;
+    my $arg;
+
+    if ( $self->source =~ /tar\.gz$/ ) {
+        $arg = 'xfz';
+    }
+    elsif ( $self->source =~ /tar\.bz2$/ ) {
+        $arg = 'xfj';
+    }
+    else {
+        croak "I've no idea what the cmd is";
+    }
+    return join ' ', $self->command->{tar}, 'xfz', $self->source, '-C',
+      $self->directory;
+}
+
+sub _run {
+    my $self = shift;
+    my $cmd  = shift;
+    system($cmd);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+BPB::Source::Compressed - 
+
+
+=head1 SYNOPSIS
+
+    use BPB::Source::Compressed;
+
+  
+=head1 DESCRIPTION
+
+
+=head1 INTERFACE 
+
+
+=head1 DEPENDENCIES
+
+None.
+
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported.
+
+=head1 AUTHOR
+
+sunnavy  C<< <sunnavy at bestpractical.com> >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright 2007 Best Practical Solutions.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.