[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