line break
Brandon L Black [Wed, 8 Nov 2006 06:08:40 +0000 (06:08 +0000)]
lib/Algorithm/C3.pm
t/009_dbic_merge.t

index be88dc5..3c75335 100644 (file)
@@ -54,30 +54,37 @@ sub merge {
             # http://www.python.org/2.3/mro.html :)
 
             # Initial set (make sure everything is copied - it will be modded)
-            my @seqs = map { [@$_] } (@$recurse_mergeout, $current_parents);
-
-            # Construct the tail-checking hash
-            my %tails;
-            foreach my $seq (@seqs) {
-                $tails{$_}++ for (@$seq[1..$#$seq]);
+            my (@seqs, %tails);
+            for my $d (@$recurse_mergeout, $current_parents){
+              if(@$d){
+                push @seqs, [@$d];
+                # Construct the tail-checking hash
+                $tails{$_}++ for (@$d[1..$#$d]);
+              }
             }
 
             my @res = ( $current_root );
             while (1) {
-                my $cand;
-                my $winner;
+                my ($cand, $winner);
+                my $j = 0;
                 foreach (@seqs) {
-                    next if !@$_;
-                    if(!$winner) {              # looking for a winner
-                        $cand = $_->[0];        # seq head is candidate
-                        next if $tails{$cand};  # he loses if in %tails
-                        push @res => $winner = $cand;
+                    $j++;
+                    if(!@$_){
+                      splice @seqs, $j, 1;
+                      next;
+                    }
+                    
+                    if(!$winner){
+                      next if $tails{ $cand = $_->[0] };
+                      push(@res, $winner = $cand); 
                     }
+                    
                     if($_->[0] eq $winner) {
                         shift @$_;                # strip off our winner
-                        $tails{$_->[0]}-- if @$_; # keep %tails sane
+                        $tails{ $_->[0] }-- if @$_; # keep %tails sane
                     }
                 }
+                
                 last if !$cand;
                 die q{Inconsistent hierarchy found while merging '}
                     . $current_root . qq{':\n\t}
@@ -310,3 +317,4 @@ This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
 =cut
+
index 10354e9..65637c8 100644 (file)
@@ -57,7 +57,8 @@ The xx:: prefixes are just to be sure these bogus declarations never stomp on re
     our @ISA = qw/
       xx::DBIx::Class::Relationship::HasMany
       xx::DBIx::Class::Relationship::HasOne
-      xx::DBIx::Class::Relationship::BelongsTo xx::DBIx::Class::Relationship::ManyToMany
+      xx::DBIx::Class::Relationship::BelongsTo
+      xx::DBIx::Class::Relationship::ManyToMany
     /;
 
     package xx::DBIx::Class::Relationship::ProxyMethods;