[Bps-public-commit] r17228 - in Prophet/branches/actions: . lib/Prophet/CLI lib/Prophet/CLI/Command t

jesse at bestpractical.com jesse at bestpractical.com
Mon Dec 15 02:49:21 EST 2008


Author: jesse
Date: Mon Dec 15 02:49:21 2008
New Revision: 17228

Added:
   Prophet/branches/actions/t/aliases.t
Modified:
   Prophet/branches/actions/   (props changed)
   Prophet/branches/actions/lib/Prophet/CLI/Command/Aliases.pm
   Prophet/branches/actions/lib/Prophet/CLI/Dispatcher.pm
   Prophet/branches/actions/lib/Prophet/Replica/prophet.pm

Log:
 r53548 at 173-114-191-196 (orig r17053):  jesse | 2008-11-29 13:35:22 -0800
 * perltidy prophet.pm
 r53549 at 173-114-191-196 (orig r17054):  jesse | 2008-11-29 13:55:40 -0800
 * don't slurp entire record history to get the latest version
 r53551 at 173-114-191-196 (orig r17055):  spang | 2008-11-29 15:35:49 -0800
  r52818 at loki:  spang | 2008-11-29 18:30:39 -0500
  dispatcher rule to make:
      sd publish foo at bar.com:www/baz (for example)
  run with foo at bar.com:www/baz as the --to arg
 
 r53552 at 173-114-191-196 (orig r17056):  sunnavy | 2008-12-01 03:00:47 -0800
  r17940 at sunnavys-mb:  sunnavy | 2008-12-01 18:59:28 +0800
  add --set, --add and --delete args for aliases cmd
 
 r53580 at 173-114-191-196 (orig r17060):  sunnavy | 2008-12-01 08:25:14 -0800
  r17973 at sunnavys-mb:  sunnavy | 2008-12-02 00:24:49 +0800
  add first aliases tests
 
 r53581 at 173-114-191-196 (orig r17061):  sunnavy | 2008-12-02 03:46:57 -0800
  r17978 at sunnavys-mb:  sunnavy | 2008-12-02 19:34:52 +0800
  tiny change
 
 r53582 at 173-114-191-196 (orig r17062):  sunnavy | 2008-12-02 03:47:15 -0800
  r17979 at sunnavys-mb:  sunnavy | 2008-12-02 19:35:44 +0800
  more aliases tests
 
 r53583 at 173-114-191-196 (orig r17063):  sunnavy | 2008-12-02 03:47:38 -0800
  r17980 at sunnavys-mb:  sunnavy | 2008-12-02 19:39:34 +0800
  clean tmpfile
 
 r53584 at 173-114-191-196 (orig r17064):  sunnavy | 2008-12-02 03:48:14 -0800
  r17981 at sunnavys-mb:  sunnavy | 2008-12-02 19:46:27 +0800
  tiny string change
 
 r53585 at 173-114-191-196 (orig r17065):  sunnavy | 2008-12-02 03:48:40 -0800
  r17982 at sunnavys-mb:  sunnavy | 2008-12-02 19:46:41 +0800
  add another test for aliases
 


Modified: Prophet/branches/actions/lib/Prophet/CLI/Command/Aliases.pm
==============================================================================
--- Prophet/branches/actions/lib/Prophet/CLI/Command/Aliases.pm	(original)
+++ Prophet/branches/actions/lib/Prophet/CLI/Command/Aliases.pm	Mon Dec 15 02:49:21 2008
@@ -14,12 +14,63 @@
         return;
     }
 
-    my $done = 0;
+    # --add is the same as --set
+    if ( $self->context->has_arg('add') ) {
+        $self->context->set_arg('set', $self->arg('add') )
+    }
+
+    if ( $self->has_arg('set') || $self->has_arg('delete') ) {
+        my $aliases = $self->app_handle->config->aliases;
+        my $need_to_save;
+
+        if ( $self->has_arg('set') ) {
+            my $value = $self->arg('set');
+            if ( $value =~ /^\s*(.+?)\s*=\s*(.+?)\s*$/ ) {
+                if ( exists $aliases->{$1} ) {
+                    if ( $aliases->{$1} ne $2 ) {
+                        my $old = $aliases->{$1};
+                        $aliases->{$1} = $2;
+                        $need_to_save = 1;
+                        print
+                          "changed alias '$1' from '$old' to '$2'\n";
+                    }
+                    else {
+                        print "alias '$1 = $2' isn't changed, won't update\n";
+                    }
+                }
+                else {
+                    $need_to_save = 1;
+                    $aliases->{$1} = $2;
+                    print "added alias '$1 = $2'\n";
+                }
+            }
+        }
+        elsif ( $self->has_arg('delete') ) {
+            my $key = $self->arg('delete');
+            if ( exists $aliases->{$key} ) {
+                $need_to_save = 1;
+                print "deleted alias '$key = $aliases->{$key}'\n";
+                delete $aliases->{$key};
+            }
+            else {
+                print "didn't find alias '$key'\n";
+            }
+        }
+
+        if ($need_to_save) {
+            $self->app_handle->config->save;
+        }
+    }
+    else {
+
+        my $done = 0;
 
-    while ( !$done ) {
-        $done = $self->try_to_edit( template => \$template );
+        while ( !$done ) {
+            $done = $self->try_to_edit( template => \$template );
+        }
     }
 
+
 }
 
 sub make_template {

Modified: Prophet/branches/actions/lib/Prophet/CLI/Dispatcher.pm
==============================================================================
--- Prophet/branches/actions/lib/Prophet/CLI/Dispatcher.pm	(original)
+++ Prophet/branches/actions/lib/Prophet/CLI/Dispatcher.pm	Mon Dec 15 02:49:21 2008
@@ -30,6 +30,13 @@
     else { next_rule }
 };
 
+# publish foo at bar.com:www/baz => publish --to foo at bar.com:www/baz
+on qr{^publish (\S+)$} => sub {
+    my $self = shift;
+    $self->context->set_arg(to => $1) if $1;
+    run('publish', $self);
+};
+
 on [ ['create', 'new'] ]         => run_command("Create");
 on [ ['show', 'display'] ]       => run_command("Show");
 on [ ['update', 'edit'] ]        => run_command("Update");
@@ -49,8 +56,6 @@
 on shell    => run_command("Shell");
 on aliases  => run_command("Aliases");
 
-
-
 on export => sub {
     my $self = shift;
     $self->cli->handle->export_to(path => $self->context->arg('path'));

Modified: Prophet/branches/actions/lib/Prophet/Replica/prophet.pm
==============================================================================
--- Prophet/branches/actions/lib/Prophet/Replica/prophet.pm	(original)
+++ Prophet/branches/actions/lib/Prophet/Replica/prophet.pm	Mon Dec 15 02:49:21 2008
@@ -3,9 +3,9 @@
 extends 'Prophet::Replica';
 use Params::Validate qw(:all);
 use LWP::Simple ();
-use File::Spec ();
+use File::Spec  ();
 use File::Path;
-use Cwd (); 
+use Cwd ();
 use Digest::SHA1 qw(sha1_hex);
 use File::Find::Rule;
 use Data::UUID;
@@ -13,16 +13,12 @@
 use JSON;
 use POSIX qw();
 
-
 has '+db_uuid' => (
     lazy    => 1,
     default => sub { shift->_read_file('database-uuid') },
 );
 
-has _uuid => (
-    is => 'rw',
-);
-
+has _uuid => ( is => 'rw', );
 
 has replica_version => (
     is      => 'ro',
@@ -50,9 +46,7 @@
     },
 );
 
-has current_edit => (
-    is => 'rw',
-);
+has current_edit => ( is => 'rw', );
 
 has current_edit_records => (
     metaclass => 'Collection::Array',
@@ -61,28 +55,30 @@
     default   => sub { [] },
 );
 
-
 has '+resolution_db_handle' => (
     isa     => 'Prophet::Replica | Undef',
     lazy    => 1,
     default => sub {
         my $self = shift;
         return if $self->is_resdb || $self->is_state_handle;
-        return Prophet::Replica->new({
-            url      => "prophet:" . $self->url . '/resolutions',
-            app_handle => $self->app_handle,
-            is_resdb => 1,
-        })
+        return Prophet::Replica->new(
+            {   url        => "prophet:" . $self->url . '/resolutions',
+                app_handle => $self->app_handle,
+                is_resdb   => 1,
+            }
+        );
     },
 );
 
-use constant scheme            => 'prophet';
-use constant cas_root          => 'cas';
-use constant record_cas_dir    => File::Spec->catdir( __PACKAGE__->cas_root => 'records' );
-use constant changeset_cas_dir => File::Spec->catdir( __PACKAGE__->cas_root => 'changesets' );
-use constant record_dir        => 'records';
-use constant userdata_dir      => 'userdata';
-use constant changeset_index   => 'changesets.idx';
+use constant scheme   => 'prophet';
+use constant cas_root => 'cas';
+use constant record_cas_dir =>
+    File::Spec->catdir( __PACKAGE__->cas_root => 'records' );
+use constant changeset_cas_dir =>
+    File::Spec->catdir( __PACKAGE__->cas_root => 'changesets' );
+use constant record_dir      => 'records';
+use constant userdata_dir    => 'userdata';
+use constant changeset_index => 'changesets.idx';
 
 =head1 Replica Format
 
@@ -212,9 +208,9 @@
 sub BUILD {
     my $self = shift;
     my $args = shift;
-    Carp::cluck() unless ($args->{app_handle});
-    for ($self->{url} ) {
-        s/^prophet://;  # url-based constructor in ::replica should do better
+    Carp::cluck() unless ( $args->{app_handle} );
+    for ( $self->{url} ) {
+        s/^prophet://;    # url-based constructor in ::replica should do better
         s{/$}{};
     }
 
@@ -231,7 +227,7 @@
 
 sub replica_exists {
     my $self = shift;
-    return $self->replica_version ? 1 :0;
+    return $self->replica_version ? 1 : 0;
 }
 
 =head2 set_replica_version
@@ -255,15 +251,14 @@
 }
 
 sub can_initialize {
-    my $self = shift; 
-    if ( $self->fs_root_parent  && -w $self->fs_root_parent ) {
+    my $self = shift;
+    if ( $self->fs_root_parent && -w $self->fs_root_parent ) {
         return 1;
 
     }
     return 0;
 }
 
-
 use constant can_read_records    => 1;
 use constant can_read_changesets => 1;
 sub can_write_changesets { return ( shift->fs_root ? 1 : 0 ) }
@@ -271,10 +266,12 @@
 
 sub initialize {
     my $self = shift;
-    my %args = validate(@_, {
-        db_uuid    => 0,
-        resdb_uuid => 0,
-    });
+    my %args = validate(
+        @_,
+        {   db_uuid    => 0,
+            resdb_uuid => 0,
+        }
+    );
 
     if ( !$self->fs_root_parent ) {
 
@@ -293,17 +290,14 @@
 
     return if $self->replica_exists;
 
-        for (
+    for (
         $self->record_dir,     $self->cas_root,
         $self->record_cas_dir, $self->changeset_cas_dir,
         $self->userdata_dir
-        ) { 
-            mkpath([File::Spec->catdir($self->fs_root => $_)]);
-        }
-
-
-
-;
+        )
+    {
+        mkpath( [ File::Spec->catdir( $self->fs_root => $_ ) ] );
+    }
 
     $self->set_db_uuid( $args{'db_uuid'} || Data::UUID->new->create_str );
     $self->set_latest_sequence_no("0");
@@ -311,7 +305,7 @@
 
     $self->set_replica_version(1);
 
-    $self->resolution_db_handle->initialize(db_uuid => $args{resdb_uuid})
+    $self->resolution_db_handle->initialize( db_uuid => $args{resdb_uuid} )
         if !$self->is_resdb;
 
     $self->after_initialize->($self);
@@ -374,8 +368,8 @@
 =cut
 
 sub _write_record {
-    my $self = shift;
-    my %args = validate( @_, { record => { isa => 'Prophet::Record' }, } );
+    my $self   = shift;
+    my %args   = validate( @_, { record => { isa => 'Prophet::Record' }, } );
     my $record = $args{'record'};
 
     $self->_write_serialized_record(
@@ -398,17 +392,19 @@
         cas_dir => $self->record_cas_dir
     );
 
-       my $record =   {uuid    => $args{uuid},
+    my $record = {
+        uuid    => $args{uuid},
         type    => $args{type},
-        cas_key => $cas_key};
+        cas_key => $cas_key
+    };
 
     $self->_prepare_record_index_update(
-           uuid    => $args{uuid},
+        uuid    => $args{uuid},
         type    => $args{type},
-        cas_key => $cas_key);
+        cas_key => $cas_key
+    );
 }
 
-
 sub _prepare_record_index_update {
     my $self   = shift;
     my %record = (@_);
@@ -418,6 +414,7 @@
         push @{ $self->current_edit_records }, \%record;
 
     } else {
+
         # If we're not inside an edit, we're likely exporting the replica
         # TODO: the replica exporter code should probably be retooled
         $self->_write_record_index_entry(%record);
@@ -428,23 +425,25 @@
 use constant RECORD_INDEX_SIZE => ( 4 + 20 );
 
 sub _write_record_index_entry {
-    my $self         = shift;
-    my %args         = validate( @_, { type => 1, uuid => 1, cas_key => 1, changeset_id => 0 } );
+    my $self = shift;
+    my %args = validate( @_,
+        { type => 1, uuid => 1, cas_key => 1, changeset_id => 0 } );
     my $idx_filename = $self->_record_index_filename(
         uuid => $args{uuid},
         type => $args{type}
     );
 
     my $index_path = File::Spec->catfile( $self->fs_root, $idx_filename );
-    my (undef,$parent, $filename) = File::Spec->splitpath($index_path);
-    mkpath([$parent]);
+    my ( undef, $parent, $filename ) = File::Spec->splitpath($index_path);
+    mkpath( [$parent] );
 
-    open( my $record_index, ">>" . $index_path);
+    open( my $record_index, ">>" . $index_path );
 
     # XXX TODO: skip if the index already has this version of the record;
     # XXX TODO FETCH THAT
     my $record_last_changed_changeset = $args{'changeset_id'} || 0;
-    my $index_row = pack( 'NH40', $record_last_changed_changeset, $args{cas_key} );
+    my $index_row
+        = pack( 'NH40', $record_last_changed_changeset, $args{cas_key} );
     print $record_index $index_row || die $!;
     close $record_index;
 }
@@ -453,16 +452,23 @@
     my $self = shift;
     my %args = validate( @_, { type => 1, uuid => 1 } );
 
-    # XXX TODO - we shouldn't compute all entries just to get the last
-    my @entries = $self->_read_record_index(
-        type => $args{type},
-        uuid => $args{uuid}
+    my $idx_filename = File::Spec->catfile(
+        $self->fs_root => $self->_record_index_filename( uuid => $args{uuid}, type => $args{type})
     );
-    return @{$entries[-1] || []};
+
+    open( my $index, "<:bytes", $idx_filename) || return undef;
+    seek($index, (0 - RECORD_INDEX_SIZE), 2) || return undef;
+    my $record;
+    read( $index, $record, RECORD_INDEX_SIZE) || return undef;
+    my ( $seq, $key ) = unpack( "NH40", $record ) ;
+    return ( $seq, $key );
 
 }
 
 
+
+
+
 sub _read_record_index {
     my $self = shift;
     my %args = validate( @_, { type => 1, uuid => 1 } );
@@ -479,12 +485,8 @@
     my $count = length($index) / RECORD_INDEX_SIZE;
     my @entries;
     for my $offset ( 0 .. ( $count - 1 ) ) {
-        my ( $seq, $key ) = unpack(
-            'NH40',
-            substr(
-                $index, ( $offset ) * RECORD_INDEX_SIZE,
-                RECORD_INDEX_SIZE
-            )
+        my ( $seq, $key ) = unpack( 'NH40',
+            substr( $index, ($offset) * RECORD_INDEX_SIZE, RECORD_INDEX_SIZE )
         );
         push @entries, [ $seq => $key ];
     }
@@ -520,31 +522,31 @@
     my %args = validate( @_, { uuid => 1, type => 1 } );
     return File::Spec->catfile(
         $self->_record_type_root( $args{'type'} ),
-        $self->_hashed_dir_name($args{uuid})
+        $self->_hashed_dir_name( $args{uuid} )
     );
 }
 
-
 sub _hashed_dir_name {
     my $self = shift;
     my $hash = shift;
 
-    return (substr( $hash, 0, 1 ), substr( $hash, 1, 1 ), $hash);
+    return ( substr( $hash, 0, 1 ), substr( $hash, 1, 1 ), $hash );
 }
 
-
 sub _record_cas_filename {
-    my $self         = shift;
-    my %args         = validate( @_, { type => 1, uuid => 1 } );
+    my $self = shift;
+    my %args = validate( @_, { type => 1, uuid => 1 } );
+
+    my ( $seq, $key ) = $self->_read_record_index_entry(
+        type => $args{'type'},
+        uuid => $args{'uuid'}
+    );
 
-    my ($seq,$key) = $self->_read_record_index_entry( type => $args{'type'}, uuid => $args{'uuid'});
+    return undef unless ( $key and ( $key ne '0' x 40 ) );
 
-    return undef unless ($key and ($key ne '0'x40));
     # XXX: deserialize the changeset content from the cas with $key
-    my $casfile = File::Spec->catfile(
-        $self->record_cas_dir,
-        $self->_hashed_dir_name($key)
-    );
+    my $casfile = File::Spec->catfile( $self->record_cas_dir,
+        $self->_hashed_dir_name($key) );
 
     return $casfile;
 }
@@ -568,7 +570,7 @@
 # XXX TODO: we should not be calculating the changeset's sha1 with the 'replica_uuid' and 'sequence_no' inside it. that makes every replica have a different hash for what should be the samechangeset.
 
     # These ttwo things should never actually get stored
-   my $seqno = delete $hash_changeset->{'sequence_no'};
+    my $seqno = delete $hash_changeset->{'sequence_no'};
     my $uuid  = delete $hash_changeset->{'replica_uuid'};
 
     my $cas_key = $self->_write_to_cas(
@@ -599,39 +601,36 @@
 
 use constant CHG_RECORD_SIZE => ( 4 + 16 + 4 + 20 );
 
-
 sub _get_changeset_index_entry {
     my $self = shift;
-    my %args = validate(@_, { sequence_no => 1, index_file => 1});
+    my %args = validate( @_, { sequence_no => 1, index_file => 1 } );
 
     my $chgidx = $args{index_file};
-    my $rev = $args{'sequence_no'};
-        my $index_record = substr( $$chgidx, ( $rev - 1 ) * CHG_RECORD_SIZE,
-            CHG_RECORD_SIZE );
-        my ( $seq, $orig_uuid, $orig_seq, $key )
-            = unpack( 'Na16NH40', $index_record );
-
-        $self->log(join(",", ( $seq, $orig_uuid, $orig_seq, $key )));
-        $orig_uuid = Data::UUID->new->to_string($orig_uuid);
-        $self->log( "REV: $rev - seq $seq - originally $orig_seq from "
-                . substr( $orig_uuid, 0, 6 )
-                . " data key $key" );
-
-        # XXX: deserialize the changeset content from the cas with $key
-        my $casfile = File::Spec->catfile( $self->changeset_cas_dir =>
-            $self->_hashed_dir_name($key)
-        );
+    my $rev    = $args{'sequence_no'};
+    my $index_record
+        = substr( $$chgidx, ( $rev - 1 ) * CHG_RECORD_SIZE, CHG_RECORD_SIZE );
+    my ( $seq, $orig_uuid, $orig_seq, $key )
+        = unpack( 'Na16NH40', $index_record );
+
+    $self->log( join( ",", ( $seq, $orig_uuid, $orig_seq, $key ) ) );
+    $orig_uuid = Data::UUID->new->to_string($orig_uuid);
+    $self->log( "REV: $rev - seq $seq - originally $orig_seq from "
+            . substr( $orig_uuid, 0, 6 )
+            . " data key $key" );
 
-        my $changeset = $self->_deserialize_changeset(
-            content              => $self->_read_file($casfile),
-            original_source_uuid => $orig_uuid,
-            original_sequence_no => $orig_seq,
-            sequence_no          => $seq
-        );
+    # XXX: deserialize the changeset content from the cas with $key
+    my $casfile = File::Spec->catfile(
+        $self->changeset_cas_dir => $self->_hashed_dir_name($key) );
 
-        return $changeset;
-}
+    my $changeset = $self->_deserialize_changeset(
+        content              => $self->_read_file($casfile),
+        original_source_uuid => $orig_uuid,
+        original_sequence_no => $orig_seq,
+        sequence_no          => $seq
+    );
 
+    return $changeset;
+}
 
 sub traverse_changesets {
     my $self = shift;
@@ -659,9 +658,9 @@
 }
 
 sub _read_changeset_index {
-    my $self =shift;
+    my $self = shift;
     $self->log("Reading changeset index file");
-    my $chgidx    = $self->_read_file( $self->changeset_index );
+    my $chgidx = $self->_read_file( $self->changeset_index );
     return \$chgidx;
 }
 
@@ -678,21 +677,27 @@
     my $self = shift;
     my %args = validate( @_, { uuid => 1, type => 1 } );
 
-    my @record_index = $self->_read_record_index( type => $args{'type'}, uuid => $args{'uuid'});
+    my @record_index = $self->_read_record_index(
+        type => $args{'type'},
+        uuid => $args{'uuid'}
+    );
 
     my $changeset_index = $self->_read_changeset_index();
 
     my @changesets;
     for my $item (@record_index) {
         my $sequence = $item->[0];
-        push @changesets, $self->_get_changeset_index_entry( sequence_no => $sequence, index_file => $changeset_index);
+        push @changesets,
+            $self->_get_changeset_index_entry(
+            sequence_no => $sequence,
+            index_file  => $changeset_index
+            );
     }
 
     return @changesets;
 
 }
 
-
 sub _deserialize_changeset {
     my $self = shift;
     my %args = validate(
@@ -705,8 +710,8 @@
     );
 
     require Prophet::ChangeSet;
-    my $content_struct = from_json( $args{content} , { utf8 => 1 });
-    my $changeset      = Prophet::ChangeSet->new_from_hashref($content_struct);
+    my $content_struct = from_json( $args{content}, { utf8 => 1 } );
+    my $changeset = Prophet::ChangeSet->new_from_hashref($content_struct);
 
     $changeset->source_uuid( $self->uuid );
     $changeset->sequence_no( $args{'sequence_no'} );
@@ -718,23 +723,26 @@
 sub _get_changeset_index_handle {
     my $self = shift;
 
-    open( my $cs_file, ">>" . File::Spec->catfile( $self->fs_root => $self->changeset_index ) )
-        || die $!;
+    open(
+        my $cs_file,
+        ">>" . File::Spec->catfile( $self->fs_root => $self->changeset_index )
+    ) || die $!;
     return $cs_file;
 }
 
 sub _write_to_cas {
     my $self = shift;
-    my %args = validate( @_,
-        { content_ref => 0, cas_dir => 1, data => 0  } );
+    my %args = validate( @_, { content_ref => 0, cas_dir => 1, data => 0 } );
     my $content;
     if ( $args{'content_ref'} ) {
         $content = ${ $args{'content_ref'} };
     } elsif ( $args{'data'} ) {
-        $content = to_json($args{'data'}, { canonical => 1, pretty=> 0, utf8=>1}  );
+        $content = to_json( $args{'data'},
+            { canonical => 1, pretty => 0, utf8 => 1 } );
     }
-    my $fingerprint = sha1_hex($content);
-    my $content_filename = File::Spec->catfile( $args{'cas_dir'} => $self->_hashed_dir_name($fingerprint));
+    my $fingerprint      = sha1_hex($content);
+    my $content_filename = File::Spec->catfile(
+        $args{'cas_dir'} => $self->_hashed_dir_name($fingerprint) );
 
     $self->_write_file( path => $content_filename, content => $content );
     return $fingerprint;
@@ -745,13 +753,15 @@
     my %args = validate( @_, { path => 1, content => 1 } );
 
     my $file = File::Spec->catfile( $self->fs_root => $args{'path'} );
-    my (undef, $parent, $filename)  = File::Spec->splitpath($file);
+    my ( undef, $parent, $filename ) = File::Spec->splitpath($file);
     unless ( -d $parent ) {
-       eval { mkpath([$parent])} ;
-       if (my $msg = $@) {  die "Failed to create directory " . $parent." - $msg";}
+        eval { mkpath( [$parent] ) };
+        if ( my $msg = $@ ) {
+            die "Failed to create directory " . $parent . " - $msg";
+        }
     }
 
-    open(my $fh, ">$file") || die $!;
+    open( my $fh, ">$file" ) || die $!;
     print $fh scalar( $args{'content'} )
         ; # can't do "||" as we die if we print 0" || die "Could not write to " . $args{'path'} . " " . $!;
     close $fh || die $!;
@@ -767,24 +777,29 @@
     my $self = shift;
     my ($file) = validate_pos( @_, 1 );
 
-    if (! $self->fs_root ) {
+    if ( !$self->fs_root ) {
+
         # HTTP Replica
         return $self->_read_file($file) ? 1 : 0;
     }
 
     my $path = File::Spec->catfile( $self->fs_root, $file );
-   if    ( -f $path ) { return 1 }
-   elsif ( -d $path ) { return 2 }
-   else               { return 0 }
+    if    ( -f $path ) { return 1 }
+    elsif ( -d $path ) { return 2 }
+    else               { return 0 }
 }
 
 sub read_file {
     my $self = shift;
     my ($file) = validate_pos( @_, 1 );
-    if ($self->fs_root) {
+    if ( $self->fs_root ) {
+
         # make sure we don't try to read files outside the replica
-        my $qualified_file = Cwd::fast_abs_path(File::Spec->catfile( $self->fs_root => $file ));
-        return undef if substr($qualified_file,0,length($self->fs_root)) ne $self->fs_root;
+        my $qualified_file = Cwd::fast_abs_path(
+            File::Spec->catfile( $self->fs_root => $file ) );
+        return undef
+            if substr( $qualified_file, 0, length( $self->fs_root ) ) ne
+                $self->fs_root;
     }
     return $self->_read_file($file);
 }
@@ -795,21 +810,22 @@
     if ( $self->fs_root ) {
         return eval {
             local $SIG{__DIE__} = 'DEFAULT';
-            Prophet::Util->slurp (File::Spec->catfile( $self->fs_root => $file ))
+            Prophet::Util->slurp(
+                File::Spec->catfile( $self->fs_root => $file ) );
         };
     } else {    # http replica
         return LWP::Simple::get( $self->url . "/" . $file );
     }
 
-
 }
 
-
 sub begin_edit {
     my $self = shift;
-    my %args = validate(@_, {
-        source => 0, # the changeset that we're replaying, if applicable
-    });
+    my %args = validate(
+        @_,
+        {   source => 0,    # the changeset that we're replaying, if applicable
+        }
+    );
 
     my $source = $args{source};
 
@@ -817,13 +833,14 @@
     my $created = $source && $source->created;
 
     require Prophet::ChangeSet;
-    my $changeset = Prophet::ChangeSet->new({
-        source_uuid => $self->uuid,
-        creator     => $creator,
-        $created ? (created => $created) : (),
-    });
+    my $changeset = Prophet::ChangeSet->new(
+        {   source_uuid => $self->uuid,
+            creator     => $creator,
+            $created ? ( created => $created ) : (),
+        }
+    );
     $self->current_edit($changeset);
-    $self->current_edit_records([]);
+    $self->current_edit_records( [] );
 
 }
 
@@ -845,8 +862,8 @@
     $self->current_edit->original_source_uuid( $self->uuid )
         unless ( $self->current_edit->original_source_uuid );
     $self->current_edit->sequence_no($sequence);
-    for my $record (@{$self->current_edit_records}) {
-         $self->_write_record_index_entry(changeset_id => $sequence, %$record);
+    for my $record ( @{ $self->current_edit_records } ) {
+        $self->_write_record_index_entry( changeset_id => $sequence, %$record );
     }
     $self->_write_changeset_to_index( $self->current_edit );
 }
@@ -908,7 +925,6 @@
     my $inside_edit = $self->current_edit ? 1 : 0;
     $self->begin_edit() unless ($inside_edit);
 
-
     my $change = Prophet::Change->new(
         {   record_type => $args{'type'},
             record_uuid => $args{'uuid'},
@@ -916,8 +932,12 @@
         }
     );
     $self->current_edit->add_change( change => $change );
-    
-    $self->_prepare_record_index_update( uuid    => $args{uuid}, type    => $args{type}, cas_key => '0'x40);
+
+    $self->_prepare_record_index_update(
+        uuid    => $args{uuid},
+        type    => $args{type},
+        cas_key => '0' x 40
+    );
 
     $self->commit_edit() unless ($inside_edit);
     return 1;
@@ -982,8 +1002,8 @@
     my %args = validate( @_, { uuid => 1, type => 1 } );
     return undef unless $args{'uuid'};
     return $self->_record_cas_filename(
-            type => $args{'type'},
-            uuid => $args{'uuid'}
+        type => $args{'type'},
+        uuid => $args{'uuid'}
     ) ? 1 : 0;
 
 }
@@ -993,14 +1013,18 @@
     my %args = validate( @_ => { type => 1 } );
 
     #return just the filenames, which, File::Find::Rule doesn't seem capable of
-        my @record_uuids = map { my @path = split( qr'/', $_ ); pop @path }
-            File::Find::Rule->file->maxdepth(3)->in(
-            File::Spec->catdir( $self->fs_root => $self->_record_type_root( $args{'type'} ) )
-            );
-
-    
+    my @record_uuids
+        = map { my @path = split( qr'/', $_ ); pop @path }
+        File::Find::Rule->file->maxdepth(3)->in(
+        File::Spec->catdir(
+            $self->fs_root => $self->_record_type_root( $args{'type'} )
+        )
+        );
 
-    return [grep {$self->_record_cas_filename(type => $args{'type'}, uuid => $_ ) }@record_uuids
+    return [
+        grep {
+            $self->_record_cas_filename( type => $args{'type'}, uuid => $_ )
+            } @record_uuids
     ];
 }
 
@@ -1030,7 +1054,8 @@
     my $self = shift;
     my %args = validate( @_, { path => 1 } );
 
-    $self->_read_file(File::Spec->catfile($self->userdata_dir, $args{path}));
+    $self->_read_file(
+        File::Spec->catfile( $self->userdata_dir, $args{path} ) );
 }
 
 =head2 write_userdata_file
@@ -1044,7 +1069,7 @@
     my %args = validate( @_, { path => 1, content => 1 } );
 
     $self->_write_file(
-        path    => File::Spec->catfile($self->userdata_dir, $args{path}),
+        path    => File::Spec->catfile( $self->userdata_dir, $args{path} ),
         content => $args{content},
     );
 }

Added: Prophet/branches/actions/t/aliases.t
==============================================================================
--- (empty file)
+++ Prophet/branches/actions/t/aliases.t	Mon Dec 15 02:49:21 2008
@@ -0,0 +1,86 @@
+#!/usr/bin/perl 
+#
+use warnings;
+use strict;
+use Prophet::Test 'no_plan';
+use File::Temp qw/tempfile/;
+
+$ENV{'PROPHET_APP_CONFIG'} = (tempfile(UNLINK => 1))[1];
+
+use_ok('Prophet::CLI');
+use_ok('Prophet::Config');
+my $aliases = Prophet::Config->new(app_handle =>
+        Prophet::CLI->new->app_handle)->aliases;
+
+is_deeply( $aliases, {}, 'initial alias is empty' );
+
+my @cmds = (
+    {
+        cmd => [ '--add', 'pull -a=pull --all' ],
+        output  => qr/added alias 'pull -a = pull --all/,
+        comment => 'add a new alias',
+    },
+    {
+        cmd => [ '--add', 'pull -a=pull --all' ],
+        output  => qr/alias 'pull -a = pull --all' isn't changed, won't update/,
+        comment => 'add the same alias will not change anything',
+    },
+    {
+
+        # this alias is bad, please don't use it in real life
+        cmd => [ '--set', 'pull -a=pull --local' ],
+        output =>
+          qr/changed alias 'pull -a' from 'pull --all' to 'pull --local'/,
+        comment =>
+          q{changed alias 'pull -a' from 'pull --all' to 'pull --local'},
+    },
+    {
+        cmd     => [ '--delete', 'pull -a' ],
+        output  => qr/deleted alias 'pull -a = pull --local'/,
+        comment => q{deleted alias 'pull -a = pull --local'},
+    },
+    {
+        cmd     => [ '--delete', 'pull -a' ],
+        output  => qr/didn't find alias 'pull -a'/,
+        comment => q{delete an alias that doesn't exist any more},
+    },
+    {
+        cmd => [ '--add', 'pull -a=pull --all' ],
+        output  => qr/added alias 'pull -a = pull --all/,
+        comment => 'readd a new alias',
+    },
+    {
+        cmd => [ '--add', 'pull -l=pull --local' ],
+        output  => qr/added alias 'pull -l = pull --local/,
+        comment => 'add a new alias',
+    },
+);
+
+for my $item ( @cmds ) {
+    my $out = run_command( 'aliases', @{$item->{cmd}} );
+    like( $out, $item->{output}, $item->{comment} );
+}
+
+
+# check aliases in config
+$aliases = Prophet::Config->new(app_handle =>
+        Prophet::CLI->new->app_handle)->aliases;
+is_deeply(
+    $aliases,
+    {
+        'pull -l' => 'pull --local',
+        'pull -a' => 'pull --all',
+    },
+    'non empty aliases',
+);
+
+# check content in config
+my $content;
+open my $fh, '<', $ENV{'PROPHET_APP_CONFIG'}
+  or die "failed to open $ENV{'PROPHET_APP_CONFIG'}: $!";
+{ local $/; $content = <$fh>; }
+is( $content, <<EOF, 'content in config' );
+alias pull -l = pull --local
+alias pull -a = pull --all
+EOF
+



More information about the Bps-public-commit mailing list