[Bps-public-commit] r13623 - in Shipwright/trunk: lib/Shipwright/Script
sunnavy at bestpractical.com
sunnavy at bestpractical.com
Thu Jun 26 18:21:48 EDT 2008
Author: sunnavy
Date: Thu Jun 26 18:21:47 2008
New Revision: 13623
Modified:
Shipwright/trunk/ (props changed)
Shipwright/trunk/lib/Shipwright/Script/Delete.pm
Shipwright/trunk/lib/Shipwright/Script/Flags.pm
Shipwright/trunk/lib/Shipwright/Script/Import.pm
Shipwright/trunk/lib/Shipwright/Script/Ktf.pm
Shipwright/trunk/lib/Shipwright/Script/List.pm
Shipwright/trunk/lib/Shipwright/Script/Rename.pm
Shipwright/trunk/lib/Shipwright/Script/Update.pm
Log:
r13850 at sunnavys-mb: sunnavy | 2008-06-27 06:08:37 +0800
cleaned cli args to reduce redancy
Modified: Shipwright/trunk/lib/Shipwright/Script/Delete.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Delete.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Delete.pm Thu Jun 26 18:21:47 2008
@@ -4,41 +4,28 @@
use warnings;
use Carp;
-use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
-__PACKAGE__->mk_accessors(qw/name/);
+use base qw/App::CLI::Command Shipwright::Script/;
use Shipwright;
use File::Spec;
use Shipwright::Util;
-sub options {
- (
- 'name=s' => 'name',
- );
-}
-
sub run {
my $self = shift;
my $name = shift;
- $self->name($name) if $name && !$self->name;
-
- die "need name arg" unless $self->name();
+ die "need name arg" unless $name;
- my $shipwright = Shipwright->new(
- repository => $self->repository,
- );
+ my $shipwright = Shipwright->new( repository => $self->repository, );
my $map = $shipwright->backend->map || {};
- if ( $map->{ $self->name } ) {
+ if ( $map->{$name} ) {
# it's a cpan module
- $self->name( $map->{ $self->name } );
+ $name = $map->{$name};
}
- $name = $self->name;
-
my $order = $shipwright->backend->order;
die "no such dist: $name" unless grep { $_ eq $name } @$order;
@@ -60,7 +47,14 @@
my $source = $shipwright->backend->source || {};
my $flags = $shipwright->backend->flags || {};
- $self->_clean_hash( $source, $flags, $version );
+ for my $hashref ( $source, $flags, $version ) {
+ for ( keys %$hashref ) {
+ if ( $_ eq $name ) {
+ delete $hashref->{$_};
+ last;
+ }
+ }
+ }
$shipwright->backend->version($version);
$shipwright->backend->map($map);
@@ -70,21 +64,6 @@
print "deleted $name with success\n";
}
-sub _clean_hash {
- my $self = shift;
- my @hashrefs = @_;
- my $name = $self->name;
-
- for my $hashref (@hashrefs) {
- for ( keys %$hashref ) {
- if ( $_ eq $name ) {
- delete $hashref->{$_} if $_ eq $name;
- last;
- }
- }
- }
-}
-
1;
__END__
@@ -95,11 +74,10 @@
=head1 SYNOPSIS
- delete -r [repository] --name [dist name]
+ delete NAME
=head1 OPTIONS
-r [--repository] REPOSITORY : specify the repository of our project
-l [--log-level] LOGLEVEL : specify the log level
(info, debug, warn, error, or fatal)
--log-file FILENAME : specify the log file
- --name NAME : specify the dist name
Modified: Shipwright/trunk/lib/Shipwright/Script/Flags.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Flags.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Flags.pm Thu Jun 26 18:21:47 2008
@@ -5,19 +5,17 @@
use Carp;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
-__PACKAGE__->mk_accessors(
- qw/name add delete set mandatary/);
+__PACKAGE__->mk_accessors(qw/add delete set mandatary/);
use Shipwright;
use List::MoreUtils qw/uniq/;
sub options {
(
- 'a|add=s' => 'add',
- 'd|delete=s' => 'delete',
- 's|set=s' => 'set',
- 'name=s' => 'name',
- 'mandatary' => 'mandatary',
+ 'a|add=s' => 'add',
+ 'd|delete=s' => 'delete',
+ 's|set=s' => 'set',
+ 'mandatary' => 'mandatary',
);
}
@@ -25,27 +23,22 @@
my $self = shift;
my $name = shift;
- $self->name($name) if $name && !$self->name;
-
- die "need name arg" unless $self->name();
-
- $name = $self->name;
+ die "need name arg" unless $name;
if ( $name =~ /^__/ ) {
print "$name can't start as __\n";
return;
}
- my $shipwright = Shipwright->new(
- repository => $self->repository,
- );
+ my $shipwright = Shipwright->new( repository => $self->repository, );
my $flags = $shipwright->backend->flags;
unless ( defined $self->add || defined $self->delete || defined $self->set )
{
+
# show without change
- $self->_show_flags( $flags );
+ $self->_show_flags($flags);
return;
}
@@ -79,14 +72,13 @@
}
$shipwright->backend->flags($flags);
- $self->_show_flags( $flags );
+ $self->_show_flags( $flags, $name );
}
-
sub _show_flags {
- my $self = shift;
+ my $self = shift;
my $flags = shift;
- my $name = $self->name;
+ my $name = shift;
my $changed;
$changed = 1 if $self->add || $self->delete || $self->set;
@@ -94,7 +86,7 @@
if ( $self->mandatary ) {
print "set mandatary flags with success\n" if $changed;
print "mandatary flags of $name is ";
- if ( @{$flags->{__mandatary}{$name} || [] } ) {
+ if ( @{ $flags->{__mandatary}{$name} || [] } ) {
print join( ', ', @{ $flags->{__mandatary}{$name} } ) . "\n";
}
else {
@@ -104,7 +96,7 @@
else {
print "set flags with success\n" if $changed;
print "flags of $name is ";
- if ( @{$flags->{$name} || [] } ) {
+ if ( @{ $flags->{$name} || [] } ) {
print join( ', ', @{ $flags->{$name} } ) . "\n";
}
else {
@@ -112,7 +104,6 @@
}
}
-
}
1;
@@ -125,7 +116,7 @@
=head1 SYNOPSIS
- flags --name [dist name] --add [flag name]
+ flags NAME --add [flag name]
=head1 OPTIONS
@@ -133,5 +124,4 @@
-l [--log-level] : specify the log level
(info, debug, warn, error, or fatal)
--log-file FILENAME : specify the log file
- --name NAME : specify the dist name
--add, --delete, --set FLAGS : specify the flags, split by commas
Modified: Shipwright/trunk/lib/Shipwright/Script/Import.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Import.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Import.pm Thu Jun 26 18:21:47 2008
@@ -6,7 +6,7 @@
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(
- qw/comment source no_follow build_script require_yml
+ qw/comment no_follow build_script require_yml
name test_script extra_tests overwrite min_perl_version skip version/
);
@@ -24,7 +24,6 @@
sub options {
(
'm|comment=s' => 'comment',
- 's|source=s' => 'source',
'name=s' => 'name',
'no-follow' => 'no_follow',
'build-script=s' => 'build_script',
@@ -44,30 +43,29 @@
my $self = shift;
my $source = shift;
- $self->source($source) if $source && !$self->source;
-
- if ( $self->name && !$self->source ) {
+ if ( $self->name && !$source ) {
# don't have source specified, use the one in repo
my $shipwright = Shipwright->new(
repository => $self->repository,
);
my $map = $shipwright->backend->map || {};
- my $source = $shipwright->backend->source || {};
+ my $source_yml = $shipwright->backend->source || {};
my $r_map = { reverse %$map };
if ( $r_map->{ $self->name } ) {
- $self->source( 'cpan:' . $r_map->{ $self->name } );
+ $source = 'cpan:' . $r_map->{ $self->name };
}
- elsif ( $source->{ $self->name } ) {
- $self->source( $source->{ $self->name } );
+ elsif ( $source_yml->{ $self->name } ) {
+ $source = $source_yml->{$self->name};
}
}
+ die "we need source arg\n" unless $source;
+
$self->skip( { map { $_ => 1 } split /\s*,\s*/, $self->skip || '' } );
- die "need source arg" unless $self->source();
if ( $self->name ) {
if ( $self->name =~ /::/ ) {
@@ -77,7 +75,7 @@
$self->name($name);
}
if ( $self->name !~ /^[-.\w]+$/ ) {
- die 'name can only have alphanumeric characters, "." and "-"';
+ die qq{name can only have alphanumeric characters, "." and "-"\n};
}
}
@@ -85,7 +83,7 @@
repository => $self->repository,
log_level => $self->log_level,
log_file => $self->log_file,
- source => $self->source,
+ source => $source,
name => $self->name,
follow => !$self->no_follow,
min_perl_version => $self->min_perl_version,
@@ -93,7 +91,7 @@
version => $self->version,
);
- if ( $self->source ) {
+ if ( $source ) {
unless ( $self->overwrite ) {
@@ -110,16 +108,15 @@
$shipwright->backend->map || {},
);
- $self->source(
+ $source =
$shipwright->source->run(
copy => { '__require.yml' => $self->require_yml },
- )
- );
+ );
$version =
Shipwright::Util::LoadFile( $shipwright->source->version_path );
- my ($name) = $self->source =~ m{.*/(.*)$};
+ my ($name) = $source =~ m{.*/(.*)$};
$imported{$name}++;
my $script_dir = tempdir( CLEANUP => 1 );
@@ -129,27 +126,27 @@
File::Spec->catfile( $script_dir, 'build' ) );
}
else {
- $self->_generate_build( $self->source, $script_dir, $shipwright );
+ $self->_generate_build( $source, $script_dir, $shipwright );
}
unless ( $self->no_follow ) {
- $self->_import_req( $self->source, $shipwright );
+ $self->_import_req( $source, $shipwright );
move(
- File::Spec->catfile( $self->source, '__require.yml' ),
+ File::Spec->catfile( $source, '__require.yml' ),
File::Spec->catfile( $script_dir, 'require.yml' )
- ) or die "move __require.yml failed: $!";
+ ) or die "move __require.yml failed: $!\n";
}
$shipwright->backend->import(
- source => $self->source,
- comment => $self->comment || 'import ' . $self->source,
+ source => $source,
+ comment => $self->comment || 'import ' . $source,
overwrite => 1, # import anyway for the main dist
version => $version->{$name},
);
$shipwright->backend->import(
- source => $self->source,
- comment => 'import scripts for' . $self->source,
+ source => $source,
+ comment => 'import scripts for' . $source,
build_script => $script_dir,
overwrite => 1,
);
@@ -224,7 +221,7 @@
unless ($s) {
$self->log->warn(
"we don't have $dist in source which is for "
- . $self->source );
+ . $source );
next;
}
@@ -236,7 +233,7 @@
move(
File::Spec->catfile( $s, '__require.yml' ),
File::Spec->catfile( $script_dir, 'require.yml' )
- ) or die "move $s/__require.yml failed: $!";
+ ) or die "move $s/__require.yml failed: $!\n";
$self->_generate_build( $s, $script_dir, $shipwright );
@@ -392,7 +389,7 @@
=head1 SYNOPSIS
- import [source]
+ import SOURCE
=head1 OPTIONS
@@ -400,7 +397,6 @@
-l [--log-level] LOGLEVEL : specify the log level
--log-file FILENAME : specify the log file
-m [--comment] COMMENT : specify the comment
- -s [--source] PATH : specify the source path
--name NAME : specify the source name (only alphanumeric
characters, . and -)
--build-script FILENAME : specify the build script
Modified: Shipwright/trunk/lib/Shipwright/Script/Ktf.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Ktf.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Ktf.pm Thu Jun 26 18:21:47 2008
@@ -5,7 +5,7 @@
use Carp;
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
-__PACKAGE__->mk_accessors(qw/name set delete/);
+__PACKAGE__->mk_accessors(qw/set delete/);
use Shipwright;
use List::MoreUtils qw/uniq/;
@@ -14,7 +14,6 @@
(
'd|delete' => 'delete',
's|set=s' => 'set',
- 'name=s' => 'name',
);
}
@@ -22,11 +21,7 @@
my $self = shift;
my $name = shift;
- $self->name($name) if $name && !$self->name;
-
- die "need name arg" unless $self->name();
-
- $name = $self->name;
+ die "need name arg" unless $name();
my $shipwright = Shipwright->new( repository => $self->repository, );
@@ -42,13 +37,13 @@
$shipwright->backend->ktf($ktf);
}
- $self->_show_ktf($ktf);
+ $self->_show_ktf($ktf, $name);
}
sub _show_ktf {
my $self = shift;
my $ktf = shift;
- my $name = $self->name;
+ my $name = shift;
if ( $self->delete ) {
print "deleted known test failure for $name\n";
@@ -72,7 +67,7 @@
=head1 SYNOPSIS
- ktf --name [dist name] --set '$^O eq "darwin"'
+ ktf NAME --set '$^O eq "darwin"'
=head1 OPTIONS
@@ -80,6 +75,5 @@
-l [--log-level] : specify the log level
(info, debug, warn, error, or fatal)
--log-file FILENAME : specify the log file
- --name NAME : specify the dist name
--delete conditions : delete conditions
--set conditions : set conditions
Modified: Shipwright/trunk/lib/Shipwright/Script/List.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/List.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/List.pm Thu Jun 26 18:21:47 2008
@@ -12,7 +12,6 @@
sub options {
(
- 'name=s' => 'name',
'with-latest-version' => 'with_latest_version',
'only-update' => 'only_update',
);
@@ -22,8 +21,6 @@
my $self = shift;
my $name = shift;
- $self->name($name) if $name && !$self->name;
-
my $shipwright = Shipwright->new(
repository => $self->repository,
);
@@ -39,16 +36,16 @@
if ( $self->with_latest_version ) {
my $map = $shipwright->backend->map;
- if ( $self->name ) {
- if ( $self->name =~ /^cpan-/ ) {
+ if ( $name ) {
+ if ( $name =~ /^cpan-/ ) {
my %reversed = reverse %$map;
- my $module = $reversed{ $self->name };
- $latest_version->{ $self->name } =
+ my $module = $reversed{ $name };
+ $latest_version->{ $name } =
$self->_latest_version( name => $module );
}
else {
- $latest_version->{ $self->name } =
- $self->_latest_version( url => $source->{ $self->name } );
+ $latest_version->{ $name } =
+ $self->_latest_version( url => $source->{ $name } );
}
}
else {
@@ -69,10 +66,10 @@
}
}
- if ( $self->name ) {
+ if ( $name ) {
my $new_versions = {};
- $new_versions->{ $self->name } = $versions->{ $self->name }
- if exists $versions->{ $self->name };
+ $new_versions->{ $name } = $versions->{ $name }
+ if exists $versions->{ $name };
$versions = $new_versions;
}
for my $name ( sort keys %$versions ) {
@@ -101,8 +98,8 @@
}
}
- if ( $self->name && keys %$versions == 0 ) {
- print $self->name, " doesn't exist\n";
+ if ( $name && keys %$versions == 0 ) {
+ print $name, " doesn't exist\n";
}
}
@@ -158,13 +155,12 @@
=head1 SYNOPSIS
- list
+ list NAME
=head1 OPTIONS
-r [--repository] REPOSITORY : specify the repository of our project
-l [--log-level] LOGLEVEL : specify the log level
--log-file FILENAME : specify the log file
(info, debug, warn, error, or fatal)
- --name NAME : sepecify the dist name
--with-latest-version : show the latest version if possible
--only-update : only show the dists that can be updated
Modified: Shipwright/trunk/lib/Shipwright/Script/Rename.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Rename.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Rename.pm Thu Jun 26 18:21:47 2008
@@ -4,30 +4,16 @@
use warnings;
use Carp;
-use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
-__PACKAGE__->mk_accessors(qw/name new_name/);
+use base qw/App::CLI::Command Shipwright::Script/;
use Shipwright;
use File::Spec;
use Shipwright::Util;
-sub options {
- (
- 'name=s' => 'name',
- 'new-name=s' => 'new_name',
- );
-}
-
sub run {
my $self = shift;
- my ( $name, $new_name ) = ( $self->name, $self->new_name );
-
- $name = shift unless $name;
- $new_name = shift unless $new_name;
-
- $self->name( $name );
- $self->new_name( $new_name );
+ my ( $name, $new_name ) = @_;
die 'need name arg' unless $name;
die 'need new-name arg' unless $new_name;
@@ -68,22 +54,7 @@
my $source = $shipwright->backend->source || {};
my $flags = $shipwright->backend->flags || {};
- $self->_update_hash( $source, $flags, $version );
-
- $shipwright->backend->version($version);
- $shipwright->backend->source($source);
- $shipwright->backend->flags($flags);
-
- print "renamed $name to $new_name with success\n";
-}
-
-sub _update_hash {
- my $self = shift;
- my @hashrefs = @_;
- my $name = $self->name;
- my $new_name = $self->new_name;
-
- for my $hashref (@hashrefs) {
+ for my $hashref ( $source, $flags, $version ) {
for ( keys %$hashref ) {
if ( $_ eq $name ) {
$hashref->{$new_name} = delete $hashref->{$_};
@@ -91,6 +62,12 @@
}
}
}
+
+ $shipwright->backend->version($version);
+ $shipwright->backend->source($source);
+ $shipwright->backend->flags($flags);
+
+ print "renamed $name to $new_name with success\n";
}
1;
@@ -103,7 +80,7 @@
=head1 SYNOPSIS
- shipwright rename rename a source
+ shipwright rename NAME NEWNAME rename a dist
=head1 OPTIONS
@@ -111,5 +88,3 @@
-l [--log-level] LOGLEVEL : specify the log level
(info, debug, warn, error, or fatal)
--log-file FILENAME : specify the log file
- --name NAME : specify the dist to be renamed
- --new-name NAME : specify the new dist name
Modified: Shipwright/trunk/lib/Shipwright/Script/Update.pm
==============================================================================
--- Shipwright/trunk/lib/Shipwright/Script/Update.pm (original)
+++ Shipwright/trunk/lib/Shipwright/Script/Update.pm Thu Jun 26 18:21:47 2008
@@ -6,7 +6,7 @@
use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
__PACKAGE__->mk_accessors(
- qw/name all follow builder utility version/);
+ qw/all follow builder utility version/);
use Shipwright;
use File::Spec;
@@ -20,7 +20,6 @@
sub options {
(
- 'name=s' => 'name',
'a|all' => 'all',
'follow' => 'follow',
'builder' => 'builder',
@@ -48,9 +47,7 @@
}
else {
- $self->name($name) if $name && !$self->name;
-
- die 'need name arg' unless $self->name || $self->all;
+ die 'need name arg' unless $name || $self->all;
$map = $shipwright->backend->map || {};
$source = $shipwright->backend->source || {};
@@ -62,12 +59,6 @@
}
}
else {
- if ( !$source->{ $self->name } && $map->{ $self->name } ) {
-
- # in case the name is module name
- $self->name( $map->{ $self->name } );
- }
-
my @dists;
if ( $self->follow ) {
my (%checked);
@@ -86,11 +77,11 @@
}
};
- $find_deps->( $self->name );
+ $find_deps->( $name );
@dists = keys %checked;
}
$self->_update($_) for @dists;
- $self->_update( $self->name, $self->version );
+ $self->_update( $name, $self->version );
}
}
More information about the Bps-public-commit
mailing list