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