[Bps-public-commit] r10791 - Shipwright/lib/Shipwright/Script

[sunnavy at bestpractical.com]

Author: sunnavy
Date: Sun Feb 10 09:12:26 2008
New Revision: 10791

Added:
   Shipwright/lib/Shipwright/Script/Update.pm

Log:
added update cmd

Added: Shipwright/lib/Shipwright/Script/Update.pm
==============================================================================
--- (empty file)
+++ Shipwright/lib/Shipwright/Script/Update.pm	Sun Feb 10 09:12:26 2008
@@ -0,0 +1,148 @@
+package Shipwright::Script::Update;
+
+use strict;
+use warnings;
+use Carp;
+
+use base qw/App::CLI::Command Class::Accessor::Fast Shipwright::Script/;
+__PACKAGE__->mk_accessors(qw/repository log_level name all/);
+
+use Shipwright;
+use File::Spec;
+use Shipwright::Util;
+use File::Copy qw/copy move/;
+use File::Temp qw/tempdir/;
+use Config;
+use Hash::Merge;
+
+Hash::Merge::set_behavior('RIGHT_PRECEDENT');
+
+=head2 options
+=cut
+
+sub options {
+    (
+        'r|repository=s' => 'repository',
+        'l|log-level=s'  => 'log_level',
+        'name=s'         => 'name',
+        'a|all'          => 'all',
+    );
+}
+
+my ( $shipwright, $map, $source );
+
+=head2 run
+=cut
+
+sub run {
+    my $self = shift;
+    my $name = shift;
+
+    $self->name($name) if $name;
+
+    for (qw/repository/) {
+        die "need $_ arg" unless $self->$_();
+    }
+
+    die 'need name arg' unless $self->name || $self->all;
+
+    $shipwright = Shipwright->new(
+        repository => $self->repository,
+        log_level  => $self->log_level,
+    );
+
+    $map    = $shipwright->backend->map    || {};
+    $source = $shipwright->backend->source || {};
+
+    my $dists = $shipwright->backend->order || [];
+
+    if ( $self->all ) {
+
+        for (@$dists) {
+            $self->update($_);
+        }
+    }
+    else {
+
+        $self->update( $self->name );
+    }
+}
+
+sub update {
+    my $self = shift;
+    my $name = shift;
+
+    if ( $source->{$name} ) {
+        $shipwright->source(
+            Shipwright::Source->new(
+                name   => $self->name,
+                source => $source->{$name},
+                follow => 0,
+            )
+        );
+    }
+    else {
+
+        # it's a cpan dist
+        my $s;
+
+        if ( $name =~ /^cpan-/ ) {
+            $s = { reverse %$map }->{$name};
+        }
+        elsif ( $map->{$name} ) {
+            $s    = $name;
+            $name = $map->{$name};
+        }
+        else {
+            $self->log->error( 'invalid name: ' . $self->name );
+            die 'invalid name ' . $self->name;
+        }
+
+        $shipwright->source(
+            Shipwright::Source->new(
+                source => $s,
+                follow => 0,
+            )
+        );
+    }
+
+    $shipwright->source->run;
+
+    $shipwright->backend->import(
+        source  => File::Spec->catfile( $shipwright->source->directory, $name ),
+        comment => "update $name",
+        overwrite => 1,
+    );
+
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Shipwright::Script::Update - update dist(s)
+
+=head1 SYNOPSIS
+
+  shipwright update          update dist(s)
+
+ Options:
+   --repository(-r)   specify the repository of our project
+   --log-level(-l)    specify the log level
+   --name             specify the source name( only alphanumeric characters and - )
+   --all              update all the dists
+
+=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.
+