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