# 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}
it under the same terms as Perl itself.
=cut
+
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;