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