view release on metacpan or  search on metacpan

lib/Algorithm/TSort.pm  view on Meta::CPAN

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
        my $array = $_[0]->( $_[1] );
        return $array ? @$array : ();
    }
    package Algorithm::TSort::Guard;
    sub new{
        return bless $_[1], $_[0];
    }
    sub DESTROY { $_[0]->() };
}
 
sub Graph($$) {
    my $what = shift;
    my $data = shift;
    die "Graph: undefined input" unless defined $what;
    if ( $what eq 'IO' || $what eq 'SCALAR' ) {
        my %c;
        my $line;
        my $fh;
        if ( $what eq 'SCALAR' ) {
            open $fh, "<", \$data;
        }

lib/Algorithm/TSort.pm  view on Meta::CPAN

89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
        return bless \%c, 'Algorithm::TSort::ADJ';
    }
    else {
        require Carp;
        Carp::croak("Graph: don't know about \$what='$what'");
    }
}
 
 
# Preloaded methods go here.
sub tsort($;@) {
    my $object = shift;
    my @nodes  = @_;
    my @sorted;
    my %seen;
    my $req_sub;
    my $guard;
    unless (@nodes) {
        if ( UNIVERSAL::can( $object, 'nodes') ) {
            @nodes = $object->nodes();
        }

t/01-tsort.t  view on Meta::CPAN

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
for ( 1, 2, 3, 4, 5, 6, 7 ) {
    $adj->{$_} = [ $g01->adj_nodes($_) ];
    is_deeply( $adj->{$_}, $adj_true[ $_ - 1 ], "adj_nodes $_" );
}
( $g03 = Graph( ADJSUB => sub { my $x = $adj->{ $_[0] }; $x ? @$x : () } ) );
( $g04 = Graph( ADJ => $adj ) );
( $g05 = Graph( ADJSUB_ARRAYREF => sub { $adj->{ $_[0] } } ) );
 
my @true_result = ( [ '1 2 3 4', '1 3 2 4' ], '2 4', '3 4', '4', 'circle', 'circle', );
 
sub result_str($) {
    my @sorted = eval { $_[0]->(); };
    return 'circle' if $@;
    return join " ", @sorted;
}
 
sub test_str {
    my $graph  = shift;
    my $node   = shift;
    my $true   = $true_result[ $node - 1 ];
    my @true   = ref $true ? @$true : $true;