our
$AUTHORITY
=
'cpan:MATY'
;
$PMLTQ::Relation::TransitiveIterator::VERSION
=
'3.0.2'
;
use
5.006;
our
$DEBUG
;
sub
new {
my
(
$class
,
$iterator
,
$min
,
$max
)=
@_
;
confess
"usage: $class->new(\$iterator,\$min,\$max)"
unless
UNIVERSAL::DOES::does(
$iterator
,
'PMLTQ::Relation::Iterator'
);
$min
||=1;
my
$conditions
=
$iterator
->conditions;
$iterator
->set_conditions(
sub
{1});
warn
"blessed $iterator,$min,$max,0.\n"
if
$DEBUG
;
return
bless
[
$conditions
,
$iterator
,
$min
,
$max
,0],
$class
;
}
sub
clone {
my
(
$self
)=
@_
;
return
bless
[
$self
->[CONDITIONS],
$self
->[ITERATOR],
$self
->[MIN],
$self
->[MAX]],
ref
(
$self
);
}
sub
start {
my
(
$self
,
$parent
,
$fsfile
)=
@_
;
$self
->[FILE]=
$fsfile
;
my
$conditions
=
$self
->[CONDITIONS];
my
$seen
=
$self
->[SEEN]={};
my
$iter
=
$self
->[ITERATOR]->clone();
my
$iterators
=
$self
->[ITER_STACK]=[
$iter
];
my
$n
=
$iter
->start(
$parent
,
$fsfile
);
$seen
->{
$n
}=1;
$self
->[DEPTH] = 1;
my
$found
=
$self
->[FOUND]={};
warn
"START $parent->{id},"
.(
$n
?
$n
->{id}:
q//
).
".\n"
if
$DEBUG
;
$found
->{
$n
}=1
if
$conditions
->(
$n
,
$iter
->file);
return
$self
->[MIN]<=1 &&
scalar
(
keys
%$found
) > 0 ?
$n
:
$self
->
next
;
}
sub
next
{
my
(
$self
)=
@_
;
my
$depth
=
$self
->[DEPTH];
my
$found
=
$self
->[FOUND];
return
if
$depth
<1;
my
$seen
=
$self
->[SEEN];
my
$conditions
=
$self
->[CONDITIONS];
my
$iterators
=
$self
->[ITER_STACK];
my
$iter
=
$iterators
->[-1];
my
$min
=
$self
->[MIN];
my
$max
=
$self
->[MAX];
my
$n
=
$iter
->node;
warn
"NEXT: $min,$max: $n->{id} (depth $depth)\n"
if
$DEBUG
;
while
(
$n
) {
if
(!
$max
or
$depth
<
$max
) {
my
$new_it
=
$self
->[ITERATOR]->clone();
my
$new_n
=
$new_it
->start(
$n
,
$self
->[FILE]);
$new_n
=
$new_it
->
next
while
(
$new_n
and
$seen
->{
$new_n
});
warn
"NEWN $n->{id}"
if
$DEBUG
;
if
(
$new_n
) {
push
@$iterators
,
$new_it
;
$n
=
$new_n
;
$seen
->{
$n
}=1;
$iter
=
$new_it
;
$depth
++;
$found
->{
$n
}=1
if
$conditions
->(
$new_n
,
$new_it
->file);
next
if
scalar
(
keys
%$found
)<
$min
;
last
;
}
}
delete
$seen
->{
$n
};
$n
=
$iter
->
next
;
$n
=
$n
->
next
while
(
$n
and
$seen
->{
$n
});
while
(!
$n
and
$depth
>1) {
pop
@$iterators
;
$depth
--;
$iter
=
$iterators
->[-1];
delete
$seen
->{
$iter
->node };
delete
$found
->{
$iter
->node };
$n
=
$iter
->
next
;
$n
=
$n
->
next
while
(
$n
and
$seen
->{
$n
});
}
$seen
->{
$n
}=1
if
$n
;
last
unless
(
scalar
(
keys
%$found
)<
$min
and
scalar
(
keys
%$found
)>=1);
}
$self
->[DEPTH]=
$depth
;
warn
'NEXT RETURN '
,
$n
?
$n
->{id}:
'empty'
,
".\n"
if
$DEBUG
;
return
$n
;
}
sub
node {
my
(
$self
)=
@_
;
if
(
$self
->[DEPTH]>0) {
return
$self
->[ITER_STACK][-1]->node;
}
else
{
return
undef
;
}
}
sub
file {
my
(
$self
)=
@_
;
if
(
$self
->[DEPTH]>0) {
return
$self
->[ITER_STACK][-1]->file;
}
else
{
return
undef
;
}
}
sub
reset
{
my
(
$self
)=
@_
;
$self
->[FILE]=
undef
;
$self
->[ITER_STACK]=
undef
;
$self
->[DEPTH]=
undef
;
$self
->[SEEN]=
undef
;
}
1;