package A2B::Path; use strict; use POSIX; # for mkfifo my $WC = "*"; # wild card symbol sub new { my $package = shift; return bless { goodness => 1.0, steps => [], }, $package; } sub goodness { my $self = shift; return $self->{goodness}; } sub steps { my $self = shift; return $self->{steps}; } sub new_step { my $self = shift; my $step = shift; return bless { goodness => $self->{goodness} * $step->goodness, steps => [@{$self->{steps}}, $step], }, ref $self; } sub as_string { my $self = shift; my $details = shift; my $str; for my $step (@{$self->{steps}}) { my $tool = $step->tool; $str .= $step->from->extension . " (".$step->as_string($details).") "; } if (@{$self->{steps}}) { $str .= $self->{steps}[-1]->to->extension; } return $str; } sub convert { my ($self, @alpha) = @_; my $steps = $self->{steps}; my @files = @alpha; for my $step (@$steps) { my @new_files = $step->convert(@files); @files = @new_files; } return \@files; } =pod not used at the moment sub _file_wildcarded { my $file = shift; if ($file =~ /^fd:/) { return $WC; } if ($file =~ s/^(fs|fr)://) { $file =~ s/\$\d+/$WC/g; return $file; } die "unrecognised type of `file': $file"; } # this would be a good job for prolog... # in this game, the wildcard matches 1 or more chars # this function is a bit ugly # it used to be recursive, but I decided to try a breadth first search (silly) # Now it is depth first again. # It's far from perfect, but good enough for this. sub _merge_wildcarded_strings { my ($a, $b) = @_; my @queue = (["", $a, $b]); while (@queue) { my ($merged, $a, $b) = @{pop @queue}; print "$merged $a $b\n"; if ($a eq "" and $b eq "") { return $merged; } next if $a eq "" or $b eq ""; my $A = substr $a, 0, 1, ''; my $B = substr $b, 0, 1, ''; if ($A eq $B and $A ne $WC) { push @queue, [$merged.$A, $a, $b]; } elsif ($A eq $WC and $B eq $WC) { push @queue, reverse [$merged.$WC, $a, $b], [$merged.$WC, "$WC$a", $b], [$merged.$WC, $a, "$WC$b"]; } elsif ($A eq $WC) { push @queue, reverse [$merged.$B, $a, $b], [$merged.$B, "$WC$a", $b]; } elsif ($B eq $WC) { push @queue, reverse [$merged.$A, $a, $b], [$merged.$A, $a, "$WC$b"]; } } return; } =cut 1