#!/usr/bin/perl
use constant LAST => -1;
use constant PATH => 0;
use constant SEEN => 1;
use strict;
use warnings;

my %graph = (
    F => [qw/B C E/],
    A => [qw/B C/],
    D => [qw/B/],
    C => [qw/A E F/],
    E => [qw/C F/],
    B => [qw/A E F/]
);

my $routes = find_paths('B', 'E', \%graph);
print "@$_\n" for @$routes;

sub find_paths {
    my ($beg, $end, $graph) = @_;
    my @solution;
    my @work;
    for (@{$graph->{$beg}}) {
        push @solution, [$beg, $end] if $_ eq $end;
        push @work, [[$beg, $_], {$beg => undef, $_ => undef}];
    }
    while (@work) {
        my $item = pop @work;
        my ($path, $seen) = @{$item}[PATH, SEEN];
        for my $node (@{$graph->{$path->[LAST]}}) {
            next if exists $seen->{$node};
            my @new_path = (@$path, $node);
            if ($node eq $end) {
                push @solution, \@new_path;
                next;
            }
            my %new_seen = (%$seen, $node => undef);
            push @work, [\@new_path, \%new_seen];
        }
    }
    return \@solution;
}

##</code><code>##

#!/usr/bin/perl
use strict;
use warnings;

my %graph = (
    F => [qw/B C E/],
    A => [qw/B C/],
    D => [qw/B/],
    C => [qw/A E F/],
    E => [qw/C F/],
    B => [qw/A E F/]
);

my $routes = find_paths('B', 'E', \%graph);
print "$_\n" for @$routes;

sub find_paths {
    my ($beg, $end, $graph) = @_;
    my (@work, @solution);
    for (@{$graph->{$beg}}) {
        if ($_ eq $end) {
            push @solution, "$beg->$end";
            next;
        }
        my $seen = '';
        vec($seen, node_to_int($_), 1) = 1;
        vec($seen, node_to_int($beg), 1) = 1;
        push @work, ["$beg->$_", $_, $seen];
    }
    while (@work) {
        my $item = pop @work;
        my ($path, $curr, $seen) = @$item;
        for my $node (@{$graph->{$curr}}) {
            my $bit = node_to_int($node);
            next if vec($seen, $bit, 1);
            if ($node eq $end) {
                push @solution, "$path->$end";
                next;
            }
            my $new_seen = $seen;
            vec($new_seen, $bit, 1) = 1;
            push @work, ["$path->$node", $node, $new_seen];
        }
    }
    return \@solution;
}

sub node_to_int {
    my ($node) = @_;
    return ord($node) - 65;
}

##</code><code>##

#!/usr/bin/perl
use strict;
use warnings;

my %graph = (
    R => [qw/L J Z/],
    L => [qw/R J X/],
    J => [qw/R L X Z/],
    Z => [qw/R J X/],
    X => [qw/L J Z F D/],
    F => [qw/X D/],
    D => [qw/Q F X/],
    Q => [qw/B U D/],
    B => [qw/Q P M/],
    P => [qw/B U/],
    U => [qw/Q P S/],
    M => [qw/B S/],
    S => [qw/U M/],
);

my $routes = find_paths('D', 'M', \%graph);
print "$_\n" for @$routes;

sub find_paths {
    my ($beg, $end, $graph) = @_;
    my (@work, @solution, %done);
    for (@{$graph->{$beg}}) {
        if ($_ eq $end) {
            push @solution, "$beg->$end";
            next;
        }
        my $seen = '';
        vec($seen, node_to_int($_), 1) = 1;
        vec($seen, node_to_int($beg), 1) = 1;
        push @work, ["$beg->$_", $_, $seen];
    }
    while (@work) {
        my $item = pop @work;
        my ($path, $curr, $seen) = @$item;
        my $ok;
        for my $node (@{$graph->{$curr}}) {
            my $bit = node_to_int($node);
            next if vec($seen, $bit, 1) || ($done{$node} && path_completed($seen, $done{$node}));
            $ok = 1;
            if ($node eq $end) {
                push @solution, "$path->$end";
                next;
            }
            my $new_seen = $seen;
            vec($new_seen, $bit, 1) = 1;
            push @work, ["$path->$node", $node, $new_seen];
        }
        update_completed_paths($path, $seen, \%done) if ! $ok;
    }
    return \@solution;
}

sub node_to_int {
    my ($node) = @_;
    return ord($node) - 65;
}

sub update_completed_paths {
    my ($path, $seen, $done) = @_;
    my @order = split /->/, $path;
    for my $idx (reverse 0 .. $#order - 1) {
        local $_ = $order[$idx];
        vec($seen, node_to_int($_), 1) = 0;
        push @{$done->{$_}}, $seen;
    }
}

sub path_completed {
    my ($path, $completed) = @_;
    for (@$completed) {
        my $and = $_ & $path;
        return 1 if $and eq $_;
    }
    return;
}