[svk-commit] r2110 - in trunk: lib/SVK lib/SVK/Command

glasser at bestpractical.com glasser at bestpractical.com
Sat Nov 4 18:25:14 EST 2006


Author: glasser
Date: Sat Nov  4 18:25:14 2006
New Revision: 2110

Modified:
   trunk/Makefile.PL
   trunk/lib/SVK/Command/Checkout.pm
   trunk/lib/SVK/Command/Pull.pm
   trunk/lib/SVK/XD.pm

Log:
Update SVK to use Data::Hierarchy 0.40.  SVK now no longer relies on
the internal implementation of the hierarchy object, which makes it
possible to use a more efficient internal representation.

SVK now calls ->save and ->load on the XD's D::H "checkout" before and
after serializing it.  If it is reading in a D::H saved with pre-0.40
D::H, it won't call the (nonexistent) load on it, but D::H's
"_autoupgrade" will rebless it as a Data::Hierarchy::Savable and then
load it implicitly.

* Makefile.PL
  Require Data::Hierarchy 0.40.

* lib/SVK/Command/Checkout.pm
  (_find_copath): Use the ->defines and ->find methods on the checkout.
  (list::run): Use ->find on the checkout.
  (relocate::run): Use ->defines and ->move on the checkout.
  (purge::run): Use ->find and ->get on the checkout.

* lib/SVK/Command/Pull.pm
  (run): Use ->find on the checkout.

* lib/SVK/XD.pm
  (_savify_checkout, _loadify_checkout): New methods to deal with
   converting a Data::Hierarchy to and from either a 
   Data::Hierarchy::Relative or a Data::Hierarchy::Savable.
  (load, store): Call _loadify_checkout.
  (_store_config): Call _savify_checkout.

Modified: trunk/Makefile.PL
==============================================================================
--- trunk/Makefile.PL	(original)
+++ trunk/Makefile.PL	Sat Nov  4 18:25:14 2006
@@ -17,7 +17,7 @@
     'Algorithm::Annotate'      => '0',
     'Algorithm::Diff'          => '1.1901',
     'YAML::Syck'               => '0.60',
-    'Data::Hierarchy'          => '0.30',
+    'Data::Hierarchy'          => '0.40',
     'PerlIO::via::dynamic'     => '0.11',
     'PerlIO::via::symlink'     => '0.02',
     'IO::Digest'               => '0',

Modified: trunk/lib/SVK/Command/Checkout.pm
==============================================================================
--- trunk/lib/SVK/Command/Checkout.pm	(original)
+++ trunk/lib/SVK/Command/Checkout.pm	Sat Nov  4 18:25:14 2006
@@ -135,16 +135,15 @@
 sub _find_copath {
     my ($self, $path) = @_;
     my $abs_path = abs_path_noexist($path);
-    my $map = $self->{xd}{checkout}{hash};
+    my $hierarchy = $self->{xd}{checkout};
 
     # Check if this is a checkout path
-    return $abs_path if defined $abs_path and $map->{$abs_path};
+    return $abs_path if defined $abs_path
+      and $hierarchy->defines($abs_path, 'depotpath');
 
     # Find all copaths that matches this depotpath
-    return sort grep {
-        defined $map->{$_}{depotpath}
-            and $map->{$_}{depotpath} eq $path
-    } keys %$map;
+    return sort $hierarchy->find('/',
+                                 { depotpath => qr/^\Q$path\E$/ });
 }
 
 sub _not_if_floating {
@@ -165,11 +164,12 @@
 
 sub run {
     my ($self) = @_;
-    my $map = $self->{xd}{checkout}{hash};
+    my $hierarchy = $self->{xd}{checkout};
+    my @checkouts = $hierarchy->find('/', { depotpath => qr/.*/ });
     my $fmt = "%1s %-30s\t%-s\n";
     printf $fmt, ' ', loc('Depot Path'), loc('Path');
     print '=' x 72, "\n";
-    print sort(map sprintf($fmt, -e $_ ? ' ' : '?', $map->{$_}{depotpath}, $_), grep $map->{$_}{depotpath}, keys %$map);
+    print sort(map sprintf($fmt, -e $_ ? ' ' : '?', $hierarchy->get($_)->{depotpath}, $_), @checkouts);
     return;
 }
 
@@ -205,19 +205,15 @@
     }
 
     # Manually relocate all paths
-    my $map = $self->{xd}{checkout}{hash};
+    my $hierarchy = $self->{xd}{checkout};
 
     my $abs_path = abs_path($path);
-    if ($map->{$abs_path} and -d $abs_path) {
+    if ($hierarchy->defines($abs_path, 'depotpath') and -d $abs_path) {
         move_path($path => $report);
         $target = abs_path ($report);
     }
 
-    my $prefix = $copath[0].$SEP;
-    my $length = length($copath[0]);
-    foreach my $key (sort grep { index("$_$SEP", $prefix) == 0 } keys %$map) {
-        $map->{$target . substr($key, $length)} = delete $map->{$key};
-    }
+    $hierarchy->move($copath[0] => $target);
 
     print loc("Checkout '%1' relocated to '%2'.\n", $path, $target);
 
@@ -269,16 +265,17 @@
 
 sub run {
     my ($self) = @_;
-    my $map = $self->{xd}{checkout}{hash};
 
     $self->_not_if_floating('--purge');
 
+    my $hierarchy = $self->{xd}{checkout};
+    my @checkouts = $hierarchy->find('/', { depotpath => qr/.*/ });
     $self->rebless('checkout::detach');
 
-    for my $path (sort grep $map->{$_}{depotpath}, keys %$map) {
+    for my $path (@checkouts) {
 	next if -e $path;
 
-	my $depotpath = $map->{$path}{depotpath};
+	my $depotpath = $hierarchy->get($path)->{depotpath};
 
 	get_prompt(loc(
 	    "Purge checkout of %1 to non-existing directory %2? (y/n) ",

Modified: trunk/lib/SVK/Command/Pull.pm
==============================================================================
--- trunk/lib/SVK/Command/Pull.pm	(original)
+++ trunk/lib/SVK/Command/Pull.pm	Sat Nov  4 18:25:14 2006
@@ -23,8 +23,7 @@
     $self->{incremental} = !$self->{lump};
 
     if ($self->{all}) {
-        my $checkout = $self->{xd}{checkout}{hash};
-        @arg = sort grep $checkout->{$_}{depotpath}, keys %$checkout;
+        @arg = $self->{xd}{checkout}->find('/', { depotpath => qr/.*/ });
     } 
     elsif ( @arg == 1 and !$self->arg_co_maybe($arg[0])->isa('SVK::Path::Checkout')) {
         # If the last argument is a depot path, rather than a copath

Modified: trunk/lib/SVK/XD.pm
==============================================================================
--- trunk/lib/SVK/XD.pm	(original)
+++ trunk/lib/SVK/XD.pm	Sat Nov  4 18:25:14 2006
@@ -162,8 +162,7 @@
 	}
         elsif ($info) {
             $info->{checkout}{sep} = $SEP;
-            $info->{checkout} = $info->{checkout}->to_absolute($self->{floating})
-                if $self->{floating};
+            $self->_loadify_checkout($info);
         }
     }
 
@@ -226,8 +225,8 @@
     my $ancient_backup = $file.".bak.".$$;
 
     my $tmphash = { map { $_ => $hash->{$_}} qw/checkout depotmap/ };
-    $tmphash->{checkout} = $tmphash->{checkout}->to_relative($self->{floating})
-        if $self->{floating};
+    $self->_savify_checkout($tmphash);
+
     DumpFile ($tmpfile, $tmphash);
 
     if (not -f $tmpfile ) {
@@ -252,6 +251,30 @@
     }
 }
 
+sub _savify_checkout {
+    my ($self, $hash) = @_;
+    if ($self->{floating}) {
+        $hash->{checkout} = $hash->{checkout}->to_relative($self->{floating});
+    } else {
+        $hash->{checkout} = $hash->{checkout}->save;
+    }
+}
+
+sub _loadify_checkout {
+    my ($self, $hash) = @_;
+    if ($self->{floating}) {
+        $hash->{checkout} = $hash->{checkout}->to_absolute($self->{floating});
+    } else {
+        # This should be a Data::Hierarchy::Savable, but in case
+        # somebody was using an older svk with DH 0.3 and upgraded
+        # both svk and DH and still has a serialized Data::Hierarchy
+        # in their config file, don't call ->load unless the method is
+        # there (and let DH _autoupgrade do its trick).
+        $hash->{checkout} = $hash->{checkout}->load
+          if $hash->{checkout}->can('load');
+    }
+}
+
 sub store {
     my ($self) = @_;
     $self->{updated} = 1;
@@ -268,8 +291,7 @@
         # the changes from the paths we locked, and write it out.
 	$self->giant_lock ();
 	my $info = LoadFile ($self->{statefile});
-	$info->{checkout} = $info->{checkout}->to_absolute($self->{floating})
-	    if $self->{floating};
+        $self->_loadify_checkout($info);
 	my @paths = $info->{checkout}->find ('', {lock => $$});
 	$info->{checkout}->merge ($self->{checkout}, $_)
 	    for @paths;


More information about the svk-commit mailing list