diff options
Diffstat (limited to 'perllib/Graph/AdjacencyMap/Vertex.pm')
| -rw-r--r-- | perllib/Graph/AdjacencyMap/Vertex.pm | 216 |
1 files changed, 216 insertions, 0 deletions
diff --git a/perllib/Graph/AdjacencyMap/Vertex.pm b/perllib/Graph/AdjacencyMap/Vertex.pm new file mode 100644 index 00000000..72d81427 --- /dev/null +++ b/perllib/Graph/AdjacencyMap/Vertex.pm @@ -0,0 +1,216 @@ +package Graph::AdjacencyMap::Vertex; + +# THIS IS INTERNAL IMPLEMENTATION ONLY, NOT TO BE USED DIRECTLY. +# THE INTERFACE IS HARD TO USE AND GOING TO STAY THAT WAY AND +# ALMOST GUARANTEED TO CHANGE OR GO AWAY IN FUTURE RELEASES. + +use strict; + +# $SIG{__DIE__ } = sub { use Carp; confess }; +# $SIG{__WARN__} = sub { use Carp; confess }; + +use Graph::AdjacencyMap qw(:flags :fields); +use base 'Graph::AdjacencyMap'; + +use Scalar::Util qw(weaken); + +sub _new { + my ($class, $flags, $arity) = @_; + bless [ 0, $flags, $arity ], $class; +} + +require overload; # for de-overloading + +sub __set_path { + my $m = shift; + my $f = $m->[ _f ]; + my $id = pop if ($f & _MULTI); + if (@_ != 1) { + require Carp; + Carp::confess(sprintf "Graph::AdjacencyMap::Vertex: arguments %d expected 1", scalar @_); + } + my $p; + $p = $m->[ _s ] ||= { }; + my @p = $p; + my @k; + my $k = shift; + my $q = ref $k && ($f & _REF) && overload::Method($k, '""') ? overload::StrVal($k) : $k; + push @k, $q; + return (\@p, \@k); +} + +sub __set_path_node { + my ($m, $p, $l) = splice @_, 0, 3; + my $f = $m->[ _f ]; + my $id = pop if ($f & _MULTI); + unless (exists $p->[-1]->{ $l }) { + my $i = $m->_new_node( \$p->[-1]->{ $l }, $id ); + $m->[ _i ]->{ defined $i ? $i : "" } = $_[0]; + } else { + $m->_inc_node( \$p->[-1]->{ $l }, $id ); + } +} + +sub set_path { + my $m = shift; + my $f = $m->[ _f ]; + my ($p, $k) = $m->__set_path( @_ ); + return unless defined $p && defined $k; + my $l = defined $k->[-1] ? $k->[-1] : ""; + my $set = $m->__set_path_node( $p, $l, @_ ); + return $set; +} + +sub __has_path { + my $m = shift; + my $f = $m->[ _f ]; + if (@_ != 1) { + require Carp; + Carp::confess(sprintf + "Graph::AdjacencyMap: arguments %d expected 1\n", + scalar @_); + } + my $p = $m->[ _s ]; + return unless defined $p; + my @p = $p; + my @k; + my $k = shift; + my $q = ref $k && ($f & _REF) && overload::Method($k, '""') ? overload::StrVal($k) : $k; + push @k, $q; + return (\@p, \@k); +} + +sub has_path { + my $m = shift; + my ($p, $k) = $m->__has_path( @_ ); + return unless defined $p && defined $k; + return exists $p->[-1]->{ defined $k->[-1] ? $k->[-1] : "" }; +} + +sub has_path_by_multi_id { + my $m = shift; + my $id = pop; + my ($e, $n) = $m->__get_path_node( @_ ); + return undef unless $e; + return exists $n->[ _nm ]->{ $id }; +} + +sub _get_path_id { + my $m = shift; + my $f = $m->[ _f ]; + my ($e, $n) = $m->__get_path_node( @_ ); + return undef unless $e; + return ref $n ? $n->[ _ni ] : $n; +} + +sub _get_path_count { + my $m = shift; + my $f = $m->[ _f ]; + my ($e, $n) = $m->__get_path_node( @_ ); + return 0 unless $e && defined $n; + return + ($f & _COUNT) ? $n->[ _nc ] : + ($f & _MULTI) ? scalar keys %{ $n->[ _nm ] } : 1; +} + +sub __attr { + my $m = shift; + if (@_ && ref $_[0] && @{ $_[0] } != $m->[ _a ]) { + require Carp; + Carp::confess(sprintf "Graph::AdjacencyMap::Vertex: arguments %d expected %d", + scalar @{ $_[0] }, $m->[ _a ]); + } +} + +sub _get_id_path { + my ($m, $i) = @_; + return defined $m->[ _i ] ? $m->[ _i ]->{ $i } : undef; +} + +sub del_path { + my $m = shift; + my $f = $m->[ _f ]; + my ($e, $n, $p, $k, $l) = $m->__get_path_node( @_ ); + return unless $e; + my $c = ($f & _COUNT) ? --$n->[ _nc ] : 0; + if ($c == 0) { + delete $m->[ _i ]->{ ref $n ? $n->[ _ni ] : $n }; + delete $p->[ -1 ]->{ $l }; + } + return 1; +} + +sub del_path_by_multi_id { + my $m = shift; + my $f = $m->[ _f ]; + my $id = pop; + my ($e, $n, $p, $k, $l) = $m->__get_path_node( @_ ); + return unless $e; + delete $n->[ _nm ]->{ $id }; + unless (keys %{ $n->[ _nm ] }) { + delete $m->[ _i ]->{ $n->[ _ni ] }; + delete $p->[-1]->{ $l }; + } + return 1; +} + +sub paths { + my $m = shift; + return map { [ $_ ] } values %{ $m->[ _i ] } if defined $m->[ _i ]; + wantarray ? ( ) : 0; +} + +1; +=pod + +=head1 NAME + +Graph::AdjacencyMap - create and a map of graph vertices or edges + +=head1 SYNOPSIS + + Internal. + +=head1 DESCRIPTION + +B<This module is meant for internal use by the Graph module.> + +=head2 Object Methods + +=over 4 + +=item del_path(@id) + +Delete a Map path by ids. + +=item del_path_by_multi_id($id) + +Delete a Map path by a multi(vertex) id. + +=item has_path(@id) + +Return true if the Map has the path by ids, false if not. + +=item has_path_by_multi_id($id) + +Return true ifd the a Map has the path by a multi(vertex) id, false if not. + +=item paths + +Return all the paths of the Map. + +=item set_path(@id) + +Set the path by @ids. + +=back + +=head1 AUTHOR AND COPYRIGHT + +Jarkko Hietaniemi F<jhi@iki.fi> + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. + +=cut |