1package Graph::AdjacencyMap::Vertex; 2 3# THIS IS INTERNAL IMPLEMENTATION ONLY, NOT TO BE USED DIRECTLY. 4# THE INTERFACE IS HARD TO USE AND GOING TO STAY THAT WAY AND 5# ALMOST GUARANTEED TO CHANGE OR GO AWAY IN FUTURE RELEASES. 6 7use strict; 8 9# $SIG{__DIE__ } = sub { use Carp; confess }; 10# $SIG{__WARN__} = sub { use Carp; confess }; 11 12use Graph::AdjacencyMap qw(:flags :fields); 13use base 'Graph::AdjacencyMap'; 14 15sub _new { 16 my ($class, $flags, $arity) = @_; 17 bless [ 0, $flags, $arity ], $class; 18} 19 20require overload; # for de-overloading 21 22sub __set_path { 23 my $m = shift; 24 my $f = $m->[ _f ]; 25 my $id = pop if ($f & _MULTI); 26 if (@_ != 1) { 27 require Carp; 28 Carp::confess(sprintf "Graph::AdjacencyMap::Vertex: arguments %d expected 1", scalar @_); 29 } 30 my $p; 31 $p = $m->[ _s ] ||= { }; 32 my @p = $p; 33 my @k; 34 my $k = shift; 35 my $q = ref $k && ($f & _REF) && overload::Method($k, '""') ? overload::StrVal($k) : $k; 36 push @k, $q; 37 return (\@p, \@k); 38} 39 40sub __set_path_node { 41 my ($m, $p, $l) = splice @_, 0, 3; 42 my $f = $m->[ _f ]; 43 my $id = pop if ($f & _MULTI); 44 unless (exists $p->[-1]->{ $l }) { 45 my $i = $m->_new_node( \$p->[-1]->{ $l }, $id ); 46 $m->[ _i ]->{ defined $i ? $i : "" } = $_[0]; 47 } else { 48 $m->_inc_node( \$p->[-1]->{ $l }, $id ); 49 } 50} 51 52sub set_path { 53 my $m = shift; 54 my $f = $m->[ _f ]; 55 my ($p, $k) = $m->__set_path( @_ ); 56 return unless defined $p && defined $k; 57 my $l = defined $k->[-1] ? $k->[-1] : ""; 58 my $set = $m->__set_path_node( $p, $l, @_ ); 59 return $set; 60} 61 62sub __has_path { 63 my $m = shift; 64 my $f = $m->[ _f ]; 65 if (@_ != 1) { 66 require Carp; 67 Carp::confess(sprintf 68 "Graph::AdjacencyMap: arguments %d expected 1\n", 69 scalar @_); 70 } 71 my $p = $m->[ _s ]; 72 return unless defined $p; 73 my @p = $p; 74 my @k; 75 my $k = shift; 76 my $q = ref $k && ($f & _REF) && overload::Method($k, '""') ? overload::StrVal($k) : $k; 77 push @k, $q; 78 return (\@p, \@k); 79} 80 81sub has_path { 82 my $m = shift; 83 my ($p, $k) = $m->__has_path( @_ ); 84 return unless defined $p && defined $k; 85 return exists $p->[-1]->{ defined $k->[-1] ? $k->[-1] : "" }; 86} 87 88sub has_path_by_multi_id { 89 my $m = shift; 90 my $id = pop; 91 my ($e, $n) = $m->__get_path_node( @_ ); 92 return undef unless $e; 93 return exists $n->[ _nm ]->{ $id }; 94} 95 96sub _get_path_id { 97 my $m = shift; 98 my $f = $m->[ _f ]; 99 my ($e, $n) = $m->__get_path_node( @_ ); 100 return undef unless $e; 101 return ref $n ? $n->[ _ni ] : $n; 102} 103 104sub _get_path_count { 105 my $m = shift; 106 my $f = $m->[ _f ]; 107 my ($e, $n) = $m->__get_path_node( @_ ); 108 return 0 unless $e && defined $n; 109 return 110 ($f & _COUNT) ? $n->[ _nc ] : 111 ($f & _MULTI) ? scalar keys %{ $n->[ _nm ] } : 1; 112} 113 114sub __attr { 115 my $m = shift; 116 if (@_ && ref $_[0] && @{ $_[0] } != $m->[ _a ]) { 117 require Carp; 118 Carp::confess(sprintf "Graph::AdjacencyMap::Vertex: arguments %d expected %d", 119 scalar @{ $_[0] }, $m->[ _a ]); 120 } 121} 122 123sub _get_id_path { 124 my ($m, $i) = @_; 125 return defined $m->[ _i ] ? $m->[ _i ]->{ $i } : undef; 126} 127 128sub del_path { 129 my $m = shift; 130 my $f = $m->[ _f ]; 131 my ($e, $n, $p, $k, $l) = $m->__get_path_node( @_ ); 132 return unless $e; 133 my $c = ($f & _COUNT) ? --$n->[ _nc ] : 0; 134 if ($c == 0) { 135 delete $m->[ _i ]->{ ref $n ? $n->[ _ni ] : $n }; 136 delete $p->[ -1 ]->{ $l }; 137 } 138 return 1; 139} 140 141sub del_path_by_multi_id { 142 my $m = shift; 143 my $f = $m->[ _f ]; 144 my $id = pop; 145 my ($e, $n, $p, $k, $l) = $m->__get_path_node( @_ ); 146 return unless $e; 147 delete $n->[ _nm ]->{ $id }; 148 unless (keys %{ $n->[ _nm ] }) { 149 delete $m->[ _i ]->{ $n->[ _ni ] }; 150 delete $p->[-1]->{ $l }; 151 } 152 return 1; 153} 154 155sub paths { 156 my $m = shift; 157 return map { [ $_ ] } values %{ $m->[ _i ] } if defined $m->[ _i ]; 158 wantarray ? ( ) : 0; 159} 160 1611; 162=pod 163 164=head1 NAME 165 166Graph::AdjacencyMap - create and a map of graph vertices or edges 167 168=head1 SYNOPSIS 169 170 Internal. 171 172=head1 DESCRIPTION 173 174B<This module is meant for internal use by the Graph module.> 175 176=head2 Object Methods 177 178=over 4 179 180=item del_path(@id) 181 182Delete a Map path by ids. 183 184=item del_path_by_multi_id($id) 185 186Delete a Map path by a multi(vertex) id. 187 188=item has_path(@id) 189 190Return true if the Map has the path by ids, false if not. 191 192=item has_path_by_multi_id($id) 193 194Return true ifd the a Map has the path by a multi(vertex) id, false if not. 195 196=item paths 197 198Return all the paths of the Map. 199 200=item set_path(@id) 201 202Set the path by @ids. 203 204=back 205 206=head1 AUTHOR AND COPYRIGHT 207 208Jarkko Hietaniemi F<jhi@iki.fi> 209 210=head1 LICENSE 211 212This module is licensed under the same terms as Perl itself. 213 214=cut 215