[Bps-public-commit] r9800 - in bpsbuilder/BPB/lib/BPB: . Backend

sunnavy at bestpractical.com sunnavy at bestpractical.com
Mon Dec 3 10:05:54 EST 2007


Author: sunnavy
Date: Mon Dec  3 10:05:49 2007
New Revision: 9800

Added:
   bpsbuilder/BPB/lib/BPB/Script/Initialize.pm
Modified:
   bpsbuilder/BPB/lib/BPB/Backend.pm
   bpsbuilder/BPB/lib/BPB/Backend/SVK.pm

Log:
added initialize cli, and order.yml stuff

Modified: bpsbuilder/BPB/lib/BPB/Backend.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend.pm	(original)
+++ bpsbuilder/BPB/lib/BPB/Backend.pm	Mon Dec  3 10:05:49 2007
@@ -35,21 +35,12 @@
 
 =head1 NAME
 
-BPB::Backend - 
-
-
-=head1 VERSION
-
-This document describes BPB::Backend version 0.0.1
-
-
-=head1 SYNOPSIS
-
-    use BPB::Backend;
+BPB::Backend - BPB's backend part
 
 =head1 DESCRIPTION
 
 
+
 =head1 INTERFACE
 
 

Modified: bpsbuilder/BPB/lib/BPB/Backend/SVK.pm
==============================================================================
--- bpsbuilder/BPB/lib/BPB/Backend/SVK.pm	(original)
+++ bpsbuilder/BPB/lib/BPB/Backend/SVK.pm	Mon Dec  3 10:05:49 2007
@@ -5,6 +5,8 @@
 use Carp;
 use File::Spec;
 use CPAN::DistnameInfo;
+use BPB::Config;
+use File::Temp qw/tempdir/;
 
 # command option is svk's path info, e.g. '/usr/bin/svk'
 # path is under repository/project/, e.g.
@@ -23,10 +25,7 @@
     }
 );
 
-our %REQUIRE_OPTIONS = (
-    checkout => [qw/target/],
-    import   => [qw/source category/],
-);
+our %REQUIRE_OPTIONS = ( import => [qw/source/], );
 
 use base qw/Class::Accessor::Fast/;
 __PACKAGE__->mk_accessors(qw/command repository project path/);
@@ -42,14 +41,30 @@
     bless { %DEFAULT, %args }, $class;
 }
 
+sub initialize {
+    my $self = shift;
+    my $dir = tempdir( CLEANUP => 1 );
+    for (qw/bpb main deps/) {
+        mkdir File::Spec->catfile( $dir, $_ );
+    }
+    open my $order, '>', File::Spec->catfile( $dir, 'bpb', 'order.yml' );
+    print $order '';
+    close $order;
+
+    $self->import( source => $dir, _initialize => 1 );
+}
+
 =head2 import
 
 =cut
 
 sub import {
     my $self = shift;
-    my $cmd = $self->_cmd( import => @_ );
+    my %args = @_;
+    my $cmd  = $self->_cmd( import => %args );
     $self->_run($cmd);
+    $self->add_to_order( source => $args{source} )
+      if $args{category} && $args{category} eq 'dependance';
 }
 
 =head2 export
@@ -72,6 +87,12 @@
     $self->_run($cmd);
 }
 
+sub commit {
+    my $self = shift;
+    my $cmd = $self->_cmd( commit => @_ );
+    $self->_run($cmd);
+}
+
 sub _cmd {
     my $self = shift;
     my $type = shift;
@@ -90,16 +111,38 @@
 
         # if category is null, will checkout the whole project
         # if path is null, will check the whole category part
-        my $path = $self->_absolute_path( $args{category}, $args{path} );
-        $cmd = join ' ', $self->command, 'checkout', $path, $args{target};
+        if ( $args{detach} ) {
+            $cmd = join ' ', $self->command, 'checkout', '--detach',
+              $args{path};
+        }
+        else {
+            my $path = $self->_absolute_path( $args{category}, $args{path} );
+            $cmd = join ' ', $self->command, 'checkout', $path, $args{target};
+        }
     }
     elsif ( $type eq 'import' ) {
-        push @{ $args{extra} }, '-m', q{'} . ( $args{comment} || 'import' ) .  q{'};
+        push @{ $args{extra} }, '-m',
+          q{'} . ( $args{comment} || 'import' ) . q{'};
+
         my $path = $self->_absolute_path( $args{category} );
-        my $name = $args{source};
-        $name =~ s!^.*/(.+)/?$!$1.tar.gz!;
-        $name = CPAN::DistnameInfo->new($name)->dist;
-        $cmd = join ' ', $self->command, 'import', $args{source}, "$path/$name";
+        if ( $args{_initialize} ) {
+            $cmd = join ' ', $self->command, 'import', $args{source}, $path;
+        }
+        else {
+            my $name = $args{source};
+            $name =~ s!^.*/(.+)/?$!$1.tar.gz!;
+            $name = CPAN::DistnameInfo->new($name)->dist;
+            $cmd = join ' ', $self->command, 'import', $args{source},
+              "$path/$name";
+        }
+    }
+    elsif ( $type eq 'cat' ) {
+        my $path = $self->_absolute_path( $args{category}, $args{path} );
+        $cmd = join ' ', $self->command, 'cat', $path;
+    }
+    elsif ( $type eq 'commit' ) {
+        $cmd = join ' ', $self->command, 'commit', '-m',
+          q{'} . $args{comment} . q{'}, $args{path};
     }
     else {
         croak "invalid command";
@@ -108,6 +151,43 @@
     return join ' ', $cmd, @{ $args{extra} };
 }
 
+sub add_to_order {
+    my $self = shift;
+    my %args = @_;
+    my $name = $args{source};
+    my $dir  = tempdir( CLEANUP => 0 );
+    my $file = File::Spec->catfile( $dir, 'order.yml' );
+
+    $self->checkout(
+        category => 'bpb',
+        path     => 'order.yml',
+        target   => $file,
+    );
+
+    my $order = BPB::Config::LoadFile($file) || [];
+
+    $name =~ s!^.*/(.+)/?$!$1.tar.gz!;
+    $name = CPAN::DistnameInfo->new($name)->dist;
+
+    unless ( grep { /^$name$/ } @$order ) {
+        push @$order, $name;
+        BPB::Config::DumpFile( $file, $order );
+        $self->commit( path => $file, comment => "added $name to order" );
+    }
+
+    $self->checkout( detach => 1, path => $file );
+}
+
+sub cat {
+    my $self = shift;
+    my %args = @_;
+    $args{category} ||= 'main';
+
+    my $cmd = $self->_cmd( category => $args{category}, path => $args{path} );
+    my $content = `$cmd`;
+    return $content;
+}
+
 sub _absolute_path {
     my $self     = shift;
     my $category = $self->path->{ shift @_ };

Added: bpsbuilder/BPB/lib/BPB/Script/Initialize.pm
==============================================================================
--- (empty file)
+++ bpsbuilder/BPB/lib/BPB/Script/Initialize.pm	Mon Dec  3 10:05:49 2007
@@ -0,0 +1,43 @@
+package BPB::Script::Initialize;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw/App::CLI::Command Class::Accessor::Fast/;
+__PACKAGE__->mk_accessors(qw/config moniker/);
+
+use BPB;
+use File::Spec;
+use BPB::Config;
+
+sub options {
+    (
+        'c|config=s'   => 'config',
+        'k|moniker=s'  => 'moniker',
+    );
+}
+
+sub run {
+    my $self = shift;
+    my $bpb = BPB->new( config => $self->config, moniker => $self->moniker );
+    $bpb->backend->initialize();
+}
+
+
+1;
+
+__END__
+
+=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.
+



More information about the Bps-public-commit mailing list