diff options
| -rw-r--r--[-rwxr-xr-x] | igor.packed.pl | 1193 |
1 files changed, 741 insertions, 452 deletions
diff --git a/igor.packed.pl b/igor.packed.pl index 98f0051..e5b1ce7 100755..100644 --- a/igor.packed.pl +++ b/igor.packed.pl @@ -13,268 +13,8 @@ $fatpacked{"Algorithm/DiffOld.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n". package Algorithm::DiffOld;use strict;use vars qw($VERSION @EXPORT_OK @ISA @EXPORT);use integer;require Exporter;@ISA=qw(Exporter);@EXPORT=qw();@EXPORT_OK=qw(LCS diff traverse_sequences);$VERSION=1.10;sub _replaceNextLargerWith {my ($array,$aValue,$high)=@_;$high ||= $#$array;if ($high==-1 || $aValue > $array->[-1 ]){push(@$array,$aValue);return$high + 1}my$low=0;my$index;my$found;while ($low <= $high){$index=($high + $low)/ 2;$found=$array->[$index ];if ($aValue==$found){return undef}elsif ($aValue > $found){$low=$index + 1}else {$high=$index - 1}}$array->[$low ]=$aValue;return$low}sub _longestCommonSubsequence {my$a=shift;my$b=shift;my$compare=shift || sub {my$a=shift;my$b=shift;$a eq $b};my$aStart=0;my$aFinish=$#$a;my$bStart=0;my$bFinish=$#$b;my$matchVector=[];while ($aStart <= $aFinish and $bStart <= $bFinish and &$compare($a->[$aStart ],$b->[$bStart ],@_)){$matchVector->[$aStart++ ]=$bStart++}while ($aStart <= $aFinish and $bStart <= $bFinish and &$compare($a->[$aFinish ],$b->[$bFinish ],@_)){$matchVector->[$aFinish-- ]=$bFinish--}my$thresh=[];my$links=[];my ($i,$ai,$j,$k);for ($i=$aStart;$i <= $aFinish;$i++ ){$k=0;for ($j=$bFinish;$j >= $bStart;$j--){next if!&$compare($a->[$i],$b->[$j],@_);if ($k and $thresh->[$k ]> $j and $thresh->[$k - 1 ]< $j){$thresh->[$k ]=$j}else {$k=_replaceNextLargerWith($thresh,$j,$k)}if (defined($k)){$links->[$k ]=[($k ? $links->[$k - 1 ]: undef),$i,$j ]}}}if (@$thresh){for (my$link=$links->[$#$thresh ];$link;$link=$link->[0 ]){$matchVector->[$link->[1 ]]=$link->[2 ]}}return wantarray ? @$matchVector : $matchVector}sub traverse_sequences {my$a=shift;my$b=shift;my$callbacks=shift || {};my$compare=shift;my$matchCallback=$callbacks->{'MATCH'}|| sub {};my$discardACallback=$callbacks->{'DISCARD_A'}|| sub {};my$finishedACallback=$callbacks->{'A_FINISHED'};my$discardBCallback=$callbacks->{'DISCARD_B'}|| sub {};my$finishedBCallback=$callbacks->{'B_FINISHED'};my$matchVector=_longestCommonSubsequence($a,$b,$compare,@_);my$lastA=$#$a;my$lastB=$#$b;my$bi=0;my$ai;for ($ai=0;$ai <= $#$matchVector;$ai++ ){my$bLine=$matchVector->[$ai ];if (defined($bLine)){&$discardBCallback($ai,$bi++,@_)while$bi < $bLine;&$matchCallback($ai,$bi++,@_)}else {&$discardACallback($ai,$bi,@_)}}if (defined($finishedBCallback)&& $ai <= $lastA){&$finishedBCallback($bi,@_)}else {&$discardACallback($ai++,$bi,@_)while ($ai <= $lastA)}if (defined($finishedACallback)&& $bi <= $lastB){&$finishedACallback($ai,@_)}else {&$discardBCallback($ai,$bi++,@_)while ($bi <= $lastB)}return 1}sub LCS {my$a=shift;my$matchVector=_longestCommonSubsequence($a,@_);my@retval;my$i;for ($i=0;$i <= $#$matchVector;$i++ ){if (defined($matchVector->[$i ])){push(@retval,$a->[$i ])}}return wantarray ? @retval : \@retval}sub diff {my$a=shift;my$b=shift;my$retval=[];my$hunk=[];my$discard=sub {push(@$hunk,['-',$_[0 ],$a->[$_[0 ]]])};my$add=sub {push(@$hunk,['+',$_[1 ],$b->[$_[1 ]]])};my$match=sub {push(@$retval,$hunk)if scalar(@$hunk);$hunk=[]};traverse_sequences($a,$b,{MATCH=>$match,DISCARD_A=>$discard,DISCARD_B=>$add },@_);&$match();return wantarray ? @$retval : $retval}1; ALGORITHM_DIFFOLD -$fatpacked{"Class/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_TINY'; - use 5.006;use strict;no strict 'refs';use warnings;package Class::Tiny;our$VERSION='1.006';use Carp ();require($] >= 5.010 ? "mro.pm" : "MRO/Compat.pm");my%CLASS_ATTRIBUTES;sub import {my$class=shift;my$pkg=caller;$class->prepare_class($pkg);$class->create_attributes($pkg,@_)if @_}sub prepare_class {my ($class,$pkg)=@_;@{"${pkg}::ISA"}="Class::Tiny::Object" unless @{"${pkg}::ISA"}}sub create_attributes {my ($class,$pkg,@spec)=@_;my%defaults=map {ref $_ eq 'HASH' ? %$_ : ($_=>undef)}@spec;my@attr=grep {defined and!ref and /^[^\W\d]\w*$/s or Carp::croak "Invalid accessor name '$_'"}keys%defaults;$CLASS_ATTRIBUTES{$pkg}{$_}=$defaults{$_}for@attr;$class->_gen_accessor($pkg,$_)for grep {!*{"$pkg\::$_"}{CODE}}@attr;Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub _gen_accessor {my ($class,$pkg,$name)=@_;my$outer_default=$CLASS_ATTRIBUTES{$pkg}{$name};my$sub=$class->__gen_sub_body($name,defined($outer_default),ref($outer_default));eval "package $pkg; my \$default=\$outer_default; $sub";Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub __gen_sub_body {my ($self,$name,$has_default,$default_type)=@_;if ($has_default && $default_type eq 'CODE'){return << "HERE"}elsif ($has_default){return << "HERE"}else {return << "HERE"}}sub get_all_attributes_for {my ($class,$pkg)=@_;my%attr=map {$_=>undef}map {keys %{$CLASS_ATTRIBUTES{$_}|| {}}}@{mro::get_linear_isa($pkg)};return keys%attr}sub get_all_attribute_defaults_for {my ($class,$pkg)=@_;my$defaults={};for my$p (reverse @{mro::get_linear_isa($pkg)}){while (my ($k,$v)=each %{$CLASS_ATTRIBUTES{$p}|| {}}){$defaults->{$k}=$v}}return$defaults}package Class::Tiny::Object;our$VERSION='1.006';my (%HAS_BUILDARGS,%BUILD_CACHE,%DEMOLISH_CACHE,%ATTR_CACHE);my$_PRECACHE=sub {no warnings 'once';my ($class)=@_;my$linear_isa=@{"$class\::ISA"}==1 && ${"$class\::ISA"}[0]eq "Class::Tiny::Object" ? [$class]: mro::get_linear_isa($class);$DEMOLISH_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::DEMOLISH"}@$linear_isa ];$BUILD_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::BUILD"}reverse @$linear_isa ];$HAS_BUILDARGS{$class}=$class->can("BUILDARGS");return$ATTR_CACHE{$class}={map {$_=>1}Class::Tiny->get_all_attributes_for($class)}};sub new {my$class=shift;my$valid_attrs=$ATTR_CACHE{$class}|| $_PRECACHE->($class);my$args;if ($HAS_BUILDARGS{$class}){$args=$class->BUILDARGS(@_)}else {if (@_==1 && ref $_[0]){my%copy=eval {%{$_[0]}};Carp::croak("Argument to $class->new() could not be dereferenced as a hash")if $@;$args=\%copy}elsif (@_ % 2==0){$args={@_}}else {Carp::croak("$class->new() got an odd number of elements")}}my$self=bless {map {$_=>$args->{$_}}grep {exists$valid_attrs->{$_}}keys %$args },$class;$self->BUILDALL($args)if!delete$args->{__no_BUILD__}&& @{$BUILD_CACHE{$class}};return$self}sub BUILDALL {$_->(@_)for @{$BUILD_CACHE{ref $_[0]}}}require Devel::GlobalDestruction unless defined ${^GLOBAL_PHASE};sub DESTROY {my$self=shift;my$class=ref$self;my$in_global_destruction=defined ${^GLOBAL_PHASE} ? ${^GLOBAL_PHASE} eq 'DESTRUCT' : Devel::GlobalDestruction::in_global_destruction();for my$demolisher (@{$DEMOLISH_CACHE{$class}}){my$e=do {local ($?,$@);eval {$demolisher->($self,$in_global_destruction)};$@};no warnings 'misc';die$e if$e}}1; - sub $name { - return ( - ( \@_ == 1 && exists \$_[0]{$name} ) - ? ( \$_[0]{$name} ) - : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default->( \$_[0] ) ) - ); - } - HERE - sub $name { - return ( - ( \@_ == 1 && exists \$_[0]{$name} ) - ? ( \$_[0]{$name} ) - : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default ) - ); - } - HERE - sub $name { - return \@_ == 1 ? \$_[0]{$name} : ( \$_[0]{$name} = \$_[1] ); - } - HERE -CLASS_TINY - -$fatpacked{"Const/Fast.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CONST_FAST'; - package Const::Fast;{$Const::Fast::VERSION='0.014'}use 5.008;use strict;use warnings FATAL=>'all';use Scalar::Util qw/reftype blessed/;use Carp qw/croak/;use Sub::Exporter::Progressive 0.001007 -setup=>{exports=>[qw/const/],groups=>{default=>[qw/const/]}};sub _dclone($) {require Storable;no warnings 'redefine';*_dclone=\&Storable::dclone;goto&Storable::dclone}my%skip=map {$_=>1}qw/CODE GLOB/;sub _make_readonly {my (undef,$dont_clone)=@_;if (my$reftype=reftype $_[0]and not blessed($_[0])and not &Internals::SvREADONLY($_[0])){$_[0]=_dclone($_[0])if!$dont_clone && &Internals::SvREFCNT($_[0])> 1 &&!$skip{$reftype};&Internals::SvREADONLY($_[0],1);if ($reftype eq 'SCALAR' || $reftype eq 'REF'){_make_readonly(${$_[0]},1)}elsif ($reftype eq 'ARRAY'){_make_readonly($_)for @{$_[0]}}elsif ($reftype eq 'HASH'){&Internals::hv_clear_placeholders($_[0]);_make_readonly($_)for values %{$_[0]}}}Internals::SvREADONLY($_[0],1);return}sub const(\[$@%]@) {my (undef,@args)=@_;croak 'Invalid first argument, need an reference' if not defined reftype($_[0]);croak 'Attempt to reassign a readonly variable' if&Internals::SvREADONLY($_[0]);if (reftype $_[0]eq 'SCALAR' or reftype $_[0]eq 'REF'){croak 'No value for readonly variable' if@args==0;croak 'Too many arguments in readonly assignment' if@args > 1;${$_[0]}=$args[0]}elsif (reftype $_[0]eq 'ARRAY'){@{$_[0]}=@args}elsif (reftype $_[0]eq 'HASH'){croak 'Odd number of elements in hash assignment' if@args % 2;%{$_[0]}=@args}else {croak 'Can\'t make variable readonly'}_make_readonly($_[0],1);return}1; -CONST_FAST - -$fatpacked{"Data/Diver.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DIVER'; - package Data::Diver;use strict;require Exporter;use vars qw($VERSION @EXPORT_OK);BEGIN {$VERSION=1.01_01;@EXPORT_OK=qw(Dive DiveRef DiveVal DiveError DiveDie DiveClear);*import=\&Exporter::import;*isa=\&UNIVERSAL::isa}my@lastError;sub _Error {@lastError=@_[2,0,1];return}sub DiveError {return@lastError}sub DiveClear {@lastError=()}sub DiveDie {@_=Dive(@_)if 1 < @_;return wantarray ? @_ : pop @_ if @_ ||!@lastError;my($errDesc,$ref,$svKey)=@lastError;die "$errDesc using $$svKey on $ref (from Data::Diver).\n"}sub Dive {return if!@_;my$ref=shift @_;return$ref if!$ref;while(@_){my$key=shift @_;if(!defined$key){return _Error($ref,\$key,"undef() on non-scalar-ref")if!eval {my$x=$$ref;1};$ref=$$ref}elsif(eval {my$x=$key->[0];1}&& isa($ref,'CODE')){if(@_ &&!defined $_[0]){$ref=\ $ref->(@$key)}else {$ref=[$ref->(@$key)]}}elsif($key =~ /^-?\d+$/ && eval {my$x=$ref->[0];1}){return _Error($ref,\$key,"Index out of range")if$key < -@$ref || $#$ref < $key;$ref=$ref->[$key]}elsif(eval {exists$ref->{$key}}){if(eval {my$x=$$key;1}){$ref=$ref->{$$key}}else {$ref=$ref->{$key}}}elsif(eval {my$x=$ref->{$key};1}){return _Error($ref,\$key,"Key not present in hash")}else {return _Error($ref,\$key,"Not a valid type of reference")}}return$ref}sub DiveVal :lvalue {${DiveRef(@_)}}sub DiveRef {return if!@_;my$sv=\shift @_;return $$sv if!$$sv;while(@_){my$key=shift @_;if(!defined$key){$sv=\$$$sv}elsif(eval {my$x=$key->[0];1}&& isa($$sv,'CODE')){if(@_ &&!defined $_[0]){$sv=\ $$sv->(@$key)}else {$sv=\[$$sv->(@$key)]}}elsif(eval {my$x=$$key;1}and!defined($$sv)|| eval {my$x=$$sv->{0};1}){$sv=\$$sv->{$$key}}elsif($key =~ /^-?\d+$/ and!defined($$sv)|| eval {my$x=$$sv->[0];1}){$sv=\$$sv->[$key]}else {$sv=\$$sv->{$key}}}return$sv}'Data::Diver'; -DATA_DIVER - -$fatpacked{"Data/Dmp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DMP'; - package Data::Dmp;our$DATE='2017-01-30';our$VERSION='0.23';use 5.010001;use strict;use warnings;use Scalar::Util qw(looks_like_number blessed reftype refaddr);require Exporter;our@ISA=qw(Exporter);our@EXPORT=qw(dd dmp);our%_seen_refaddrs;our%_subscripts;our@_fixups;our$OPT_PERL_VERSION="5.010";our$OPT_REMOVE_PRAGMAS=0;our$OPT_DEPARSE=1;our$OPT_STRINGIFY_NUMBERS=0;my%esc=("\a"=>"\\a","\b"=>"\\b","\t"=>"\\t","\n"=>"\\n","\f"=>"\\f","\r"=>"\\r","\e"=>"\\e",);sub _double_quote {local($_)=$_[0];s/([\\\"\@\$])/\\$1/g;return qq("$_") unless /[^\040-\176]/;s/([\a\b\t\n\f\r\e])/$esc{$1}/g;s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;return qq("$_")}sub _dump_code {my$code=shift;state$deparse=do {require B::Deparse;B::Deparse->new("-l")};my$res=$deparse->coderef2text($code);my ($res_before_first_line,$res_after_first_line)=$res =~ /(.+?)^(#line .+)/ms;if ($OPT_REMOVE_PRAGMAS){$res_before_first_line="{"}elsif ($OPT_PERL_VERSION < 5.016){$res_before_first_line =~ s/no feature ':all';/no feature;/m}$res_after_first_line =~ s/^#line .+//gm;$res="sub" .$res_before_first_line .$res_after_first_line;$res =~ s/^\s+//gm;$res =~ s/\n+//g;$res =~ s/;\}\z/}/;$res}sub _quote_key {$_[0]=~ /\A-?[A-Za-z_][A-Za-z0-9_]*\z/ || $_[0]=~ /\A-?[1-9][0-9]{0,8}\z/ ? $_[0]: _double_quote($_[0])}sub _dump {my ($val,$subscript)=@_;my$ref=ref($val);if ($ref eq ''){if (!defined($val)){return "undef"}elsif (looks_like_number($val)&&!$OPT_STRINGIFY_NUMBERS && $val eq $val+0 && $val !~ /\A-?(?:inf(?:inity)?|nan)\z/i){return$val}else {return _double_quote($val)}}my$refaddr=refaddr($val);$_subscripts{$refaddr}//= $subscript;if ($_seen_refaddrs{$refaddr}++){push@_fixups,"\$a->$subscript=\$a",($_subscripts{$refaddr}? "->$_subscripts{$refaddr}" : ""),";";return "'fix'"}my$class;if ($ref eq 'Regexp' || $ref eq 'REGEXP'){require Regexp::Stringify;return Regexp::Stringify::stringify_regexp(regexp=>$val,with_qr=>1,plver=>$OPT_PERL_VERSION)}if (blessed$val){$class=$ref;$ref=reftype($val)}my$res;if ($ref eq 'ARRAY'){$res="[";my$i=0;for (@$val){$res .= "," if$i;$res .= _dump($_,"$subscript\[$i]");$i++}$res .= "]"}elsif ($ref eq 'HASH'){$res="{";my$i=0;for (sort keys %$val){$res .= "," if$i++;my$k=_quote_key($_);my$v=_dump($val->{$_},"$subscript\{$k}");$res .= "$k=>$v"}$res .= "}"}elsif ($ref eq 'SCALAR'){$res="\\"._dump($$val,$subscript)}elsif ($ref eq 'REF'){$res="\\"._dump($$val,$subscript)}elsif ($ref eq 'CODE'){$res=$OPT_DEPARSE ? _dump_code($val): 'sub{"DUMMY"}'}else {die "Sorry, I can't dump $val (ref=$ref) yet"}$res="bless($res,"._double_quote($class).")" if defined($class);$res}our$_is_dd;sub _dd_or_dmp {local%_seen_refaddrs;local%_subscripts;local@_fixups;my$res;if (@_ > 1){$res="(" .join(",",map {_dump($_,'')}@_).")"}else {$res=_dump($_[0],'')}if (@_fixups){$res="do{my\$a=$res;" .join("",@_fixups)."\$a}"}if ($_is_dd){say$res;return wantarray()|| @_ > 1 ? @_ : $_[0]}else {return$res}}sub dd {local$_is_dd=1;_dd_or_dmp(@_)}sub dmp {goto&_dd_or_dmp}1; -DATA_DMP - -$fatpacked{"Devel/TypeTiny/Perl56Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_TYPETINY_PERL56COMPAT'; - package Devel::TypeTiny::Perl56Compat;use 5.006;use strict;use warnings;our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.002001';use B ();unless (exists&B::perlstring){my$d;*B::perlstring=sub {no warnings 'uninitialized';require Data::Dumper;$d ||= 'Data::Dumper'->new([])->Indent(0)->Purity(0)->Pad('')->Useqq(1)->Terse(1)->Freezer('')->Toaster('');my$perlstring=$d->Values([''.shift])->Dump;($perlstring =~ /^"/)? $perlstring : qq["$perlstring"]}}unless (exists&B::cstring){*B::cstring=\&B::perlstring}push@B::EXPORT_OK,qw(perlstring cstring);5.6; -DEVEL_TYPETINY_PERL56COMPAT - -$fatpacked{"Devel/TypeTiny/Perl58Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_TYPETINY_PERL58COMPAT'; - package Devel::TypeTiny::Perl58Compat;use 5.006;use strict;use warnings;our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.002001';eval 'require re';unless (exists&re::is_regexp){require B;*re::is_regexp=sub {eval {B::svref_2object($_[0])->MAGIC->TYPE eq 'r'}}}5.6; -DEVEL_TYPETINY_PERL58COMPAT - -$fatpacked{"Error/TypeTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ERROR_TYPETINY'; - package Error::TypeTiny;use 5.006001;use strict;use warnings;BEGIN {$Error::TypeTiny::AUTHORITY='cpan:TOBYINK';$Error::TypeTiny::VERSION='1.002001'}use overload q[""]=>sub {$_[0]->to_string},q[bool]=>sub {1},fallback=>1,;our%CarpInternal;$CarpInternal{$_}++ for qw(Eval::TypeTiny Eval::TypeTiny::Sandbox Exporter::Tiny Test::TypeTiny Type::Coercion Type::Coercion::Union Error::TypeTiny Type::Library Type::Params Type::Registry Types::Standard Types::Standard::_Stringable Types::TypeTiny Type::Tiny Type::Tiny::Class Type::Tiny::Duck Type::Tiny::Enum Type::Tiny::Intersection Type::Tiny::Role Type::Tiny::Union Type::Utils);sub new {my$class=shift;my%params=(@_==1)? %{$_[0]}: @_;return bless \%params,$class}sub throw {my$class=shift;my ($level,@caller,%ctxt)=0;while (defined scalar caller($level)and $CarpInternal{scalar caller($level)}){$level++};if (((caller($level - 1))[1]||"")=~ /^parameter validation for '(.+?)'$/){my ($pkg,$func)=($1 =~ m{^(.+)::(\w+)$});$level++ if caller($level)eq ($pkg||"")}$level++ if ((caller($level))[1]=~ /^\(eval \d+\)$/ and (caller($level))[3]eq '(eval)');@ctxt{qw/package file line/}=caller($level);my$stack=undef;if (our$StackTrace){require Devel::StackTrace;$stack="Devel::StackTrace"->new(ignore_package=>[keys%CarpInternal ],)}die(our$LastError=$class->new(context=>\%ctxt,stack_trace=>$stack,@_,))}sub message {$_[0]{message}||= $_[0]->_build_message};sub context {$_[0]{context}};sub stack_trace {$_[0]{stack_trace}};sub to_string {my$e=shift;my$c=$e->context;my$m=$e->message;$m =~ /\n\z/s ? $m : $c ? sprintf("%s at %s line %s.\n",$m,$c->{file}||'file?',$c->{line}||'NaN'): sprintf("%s\n",$m)}sub _build_message {return 'An exception has occurred'}sub croak {my ($fmt,@args)=@_;@_=(__PACKAGE__,message=>sprintf($fmt,@args),);goto \&throw}1; -ERROR_TYPETINY - -$fatpacked{"Error/TypeTiny/Assertion.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ERROR_TYPETINY_ASSERTION'; - package Error::TypeTiny::Assertion;use 5.006001;use strict;use warnings;BEGIN {if ($] < 5.008){require Devel::TypeTiny::Perl56Compat}}BEGIN {$Error::TypeTiny::Assertion::AUTHORITY='cpan:TOBYINK';$Error::TypeTiny::Assertion::VERSION='1.002001'}require Error::TypeTiny;our@ISA='Error::TypeTiny';sub type {$_[0]{type}};sub value {$_[0]{value}};sub varname {$_[0]{varname}||= '$_'};sub attribute_step {$_[0]{attribute_step}};sub attribute_name {$_[0]{attribute_name}};sub has_type {defined $_[0]{type}};sub has_attribute_step {exists $_[0]{attribute_step}};sub has_attribute_name {exists $_[0]{attribute_name}};sub new {my$class=shift;my$self=$class->SUPER::new(@_);if (ref$Method::Generate::Accessor::CurrentAttribute){require B;my%d=%{$Method::Generate::Accessor::CurrentAttribute};$self->{attribute_name}=$d{name}if defined$d{name};$self->{attribute_step}=$d{step}if defined$d{step};if (defined$d{init_arg}){$self->{varname}=sprintf('$args->{%s}',B::perlstring($d{init_arg}))}elsif (defined$d{name}){$self->{varname}=sprintf('$self->{%s}',B::perlstring($d{name}))}}return$self}sub message {my$e=shift;$e->varname eq '$_' ? $e->SUPER::message : sprintf('%s (in %s)',$e->SUPER::message,$e->varname)}sub _build_message {my$e=shift;$e->has_type ? sprintf('%s did not pass type constraint "%s"',Type::Tiny::_dd($e->value),$e->type): sprintf('%s did not pass type constraint',Type::Tiny::_dd($e->value))}*to_string=sub {my$e=shift;my$msg=$e->message;my$c=$e->context;$msg .= sprintf(" at %s line %s",$c->{file}||'file?',$c->{line}||'NaN')if$c;my$explain=$e->explain;return "$msg\n" unless @{$explain || []};$msg .= "\n";for my$line (@$explain){$msg .= " $line\n"}return$msg}if $] >= 5.008;sub explain {my$e=shift;return undef unless$e->has_type;$e->type->validate_explain($e->value,$e->varname)}1; -ERROR_TYPETINY_ASSERTION - -$fatpacked{"Error/TypeTiny/Compilation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ERROR_TYPETINY_COMPILATION'; - package Error::TypeTiny::Compilation;use 5.006001;use strict;use warnings;BEGIN {$Error::TypeTiny::Compilation::AUTHORITY='cpan:TOBYINK';$Error::TypeTiny::Compilation::VERSION='1.002001'}require Error::TypeTiny;our@ISA='Error::TypeTiny';sub code {$_[0]{code}};sub environment {$_[0]{environment}||= {}};sub errstr {$_[0]{errstr}};sub _build_message {my$self=shift;sprintf("Failed to compile source because: %s",$self->errstr)}1; -ERROR_TYPETINY_COMPILATION - -$fatpacked{"Error/TypeTiny/WrongNumberOfParameters.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ERROR_TYPETINY_WRONGNUMBEROFPARAMETERS'; - package Error::TypeTiny::WrongNumberOfParameters;use 5.006001;use strict;use warnings;BEGIN {$Error::TypeTiny::WrongNumberOfParameters::AUTHORITY='cpan:TOBYINK';$Error::TypeTiny::WrongNumberOfParameters::VERSION='1.002001'}require Error::TypeTiny;our@ISA='Error::TypeTiny';sub minimum {$_[0]{minimum}};sub maximum {$_[0]{maximum}};sub got {$_[0]{got}};sub has_minimum {exists $_[0]{minimum}};sub has_maximum {exists $_[0]{maximum}};sub _build_message {my$e=shift;if ($e->has_minimum and $e->has_maximum and $e->minimum==$e->maximum){return sprintf("Wrong number of parameters; got %d; expected %d",$e->got,$e->minimum,)}elsif ($e->has_minimum and $e->has_maximum and $e->minimum < $e->maximum){return sprintf("Wrong number of parameters; got %d; expected %d to %d",$e->got,$e->minimum,$e->maximum,)}elsif ($e->has_minimum){return sprintf("Wrong number of parameters; got %d; expected at least %d",$e->got,$e->minimum,)}else {return sprintf("Wrong number of parameters; got %d",$e->got,)}}1; -ERROR_TYPETINY_WRONGNUMBEROFPARAMETERS - -$fatpacked{"Eval/TypeTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EVAL_TYPETINY'; - package Eval::TypeTiny;use strict;BEGIN {*HAS_LEXICAL_SUBS=($] >= 5.018)? sub(){!!1}: sub(){!!0}};{my$hlv;sub HAS_LEXICAL_VARS () {$hlv=!!eval {require Devel::LexAlias;exists(&Devel::LexAlias::lexalias)}unless defined$hlv;$hlv}}sub _clean_eval {local $@;local$SIG{__DIE__};my$r=eval $_[0];my$e=$@;return ($r,$e)}our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.002001';our@EXPORT=qw(eval_closure);our@EXPORT_OK=qw(HAS_LEXICAL_SUBS HAS_LEXICAL_VARS);sub import {no warnings "redefine";our@ISA=qw(Exporter::Tiny);require Exporter::Tiny;my$next=\&Exporter::Tiny::import;*import=$next;my$class=shift;my$opts={ref($_[0])? %{+shift}: ()};$opts->{into}||= scalar(caller);return$class->$next($opts,@_)}use warnings;sub eval_closure {my (%args)=@_;my$src=ref$args{source}eq "ARRAY" ? join("\n",@{$args{source}}): $args{source};$args{alias}=0 unless defined$args{alias};$args{line}=1 unless defined$args{line};$args{description}=~ s/[^\w .:-\[\]\(\)\{\}\']//g if defined$args{description};$src=qq{#line $args{line} "$args{description}"\n$src} if defined$args{description}&&!($^P & 0x10);$args{environment}||= {};my$sandpkg='Eval::TypeTiny::Sandbox';my$alias=exists($args{alias})? $args{alias}: 0;my@keys=sort keys %{$args{environment}};my$i=0;my$source=join "\n"=>("package $sandpkg;","sub {",map(_make_lexical_assignment($_,$i++,$alias),@keys),$src,"}",);_manufacture_ties()if$alias &&!HAS_LEXICAL_VARS;my ($compiler,$e)=_clean_eval($source);if ($e){chomp$e;require Error::TypeTiny::Compilation;"Error::TypeTiny::Compilation"->throw(code=>(ref$args{source}eq "ARRAY" ? join("\n",@{$args{source}}): $args{source}),errstr=>$e,environment=>$args{environment},)}my$code=$compiler->(@{$args{environment}}{@keys});undef($compiler);if ($alias && HAS_LEXICAL_VARS){Devel::LexAlias::lexalias($code,$_,$args{environment}{$_})for grep!/^\&/,@keys}return$code}my$tmp;sub _make_lexical_assignment {my ($key,$index,$alias)=@_;my$name=substr($key,1);if (HAS_LEXICAL_SUBS and $key =~ /^\&/){$tmp++;my$tmpname='$__LEXICAL_SUB__'.$tmp;return "no warnings 'experimental::lexical_subs';"."use feature 'lexical_subs';"."my $tmpname = \$_[$index];"."my sub $name { goto $tmpname };"}if (!$alias){my$sigil=substr($key,0,1);return "my $key = $sigil\{ \$_[$index] };"}elsif (HAS_LEXICAL_VARS){return "my $key;"}else {my$tieclass={'@'=>'Eval::TypeTiny::_TieArray','%'=>'Eval::TypeTiny::_TieHash','$'=>'Eval::TypeTiny::_TieScalar',}->{substr($key,0,1)};return sprintf('tie(my(%s), "%s", $_[%d]);',$key,$tieclass,$index,)}}{my$tie;sub _manufacture_ties {$tie ||= eval <<'FALLBACK'}}1; - no warnings qw(void once uninitialized numeric); - - { - package # - Eval::TypeTiny::_TieArray; - require Tie::Array; - our @ISA = qw( Tie::StdArray ); - sub TIEARRAY { - my $class = shift; - bless $_[0] => $class; - } - sub AUTOLOAD { - my $self = shift; - my ($method) = (our $AUTOLOAD =~ /(\w+)$/); - defined tied(@$self) and return tied(@$self)->$method(@_); - require Carp; - Carp::croak(qq[Can't call method "$method" on an undefined value]); - } - sub can { - my $self = shift; - my $code = $self->SUPER::can(@_) - || (defined tied(@$self) and tied(@$self)->can(@_)); - return $code; - } - use overload - q[bool] => sub { !! tied @{$_[0]} }, - q[""] => sub { '' . tied @{$_[0]} }, - q[0+] => sub { 0 + tied @{$_[0]} }, - fallback => 1, - ; - } - { - package # - Eval::TypeTiny::_TieHash; - require Tie::Hash; - our @ISA = qw( Tie::StdHash ); - sub TIEHASH { - my $class = shift; - bless $_[0] => $class; - } - sub AUTOLOAD { - my $self = shift; - my ($method) = (our $AUTOLOAD =~ /(\w+)$/); - defined tied(%$self) and return tied(%$self)->$method(@_); - require Carp; - Carp::croak(qq[Can't call method "$method" on an undefined value]); - } - sub can { - my $self = shift; - my $code = $self->SUPER::can(@_) - || (defined tied(%$self) and tied(%$self)->can(@_)); - return $code; - } - use overload - q[bool] => sub { !! tied %{$_[0]} }, - q[""] => sub { '' . tied %{$_[0]} }, - q[0+] => sub { 0 + tied %{$_[0]} }, - fallback => 1, - ; - } - { - package # - Eval::TypeTiny::_TieScalar; - require Tie::Scalar; - our @ISA = qw( Tie::StdScalar ); - sub TIESCALAR { - my $class = shift; - bless $_[0] => $class; - } - sub AUTOLOAD { - my $self = shift; - my ($method) = (our $AUTOLOAD =~ /(\w+)$/); - defined tied($$self) and return tied($$self)->$method(@_); - require Carp; - Carp::croak(qq[Can't call method "$method" on an undefined value]); - } - sub can { - my $self = shift; - my $code = $self->SUPER::can(@_) - || (defined tied($$self) and tied($$self)->can(@_)); - return $code; - } - use overload - q[bool] => sub { !! tied ${$_[0]} }, - q[""] => sub { '' . tied ${$_[0]} }, - q[0+] => sub { 0 + tied ${$_[0]} }, - fallback => 1, - ; - } - - 1; - FALLBACK -EVAL_TYPETINY - -$fatpacked{"Exporter/Shiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_SHINY'; - package Exporter::Shiny;use 5.006001;use strict;use warnings;use Exporter::Tiny ();our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.000000';sub import {my$me=shift;my$caller=caller;(my$nominal_file=$caller)=~ s(::)(/)g;$INC{"$nominal_file\.pm"}||= __FILE__;if (@_==2 and $_[0]eq -setup){my (undef,$opts)=@_;@_=@{delete($opts->{exports})|| []};if (%$opts){Exporter::Tiny::_croak('Unsupported Sub::Exporter-style options: %s',join(q[, ],sort keys %$opts),)}}ref($_)&& Exporter::Tiny::_croak('Expected sub name, got ref %s',$_)for @_;no strict qw(refs);push @{"$caller\::ISA"},'Exporter::Tiny';push @{"$caller\::EXPORT_OK"},@_}1; -EXPORTER_SHINY - -$fatpacked{"Exporter/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_TINY'; - package Exporter::Tiny;use 5.006001;use strict;use warnings;no warnings qw(void once uninitialized numeric redefine);our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.000000';our@EXPORT_OK=qw<mkopt mkopt_hash _croak _carp>;sub _croak ($;@) {require Carp;my$fmt=shift;@_=sprintf($fmt,@_);goto \&Carp::croak}sub _carp ($;@) {require Carp;my$fmt=shift;@_=sprintf($fmt,@_);goto \&Carp::carp}my$_process_optlist=sub {my$class=shift;my ($global_opts,$opts,$want,$not_want)=@_;while (@$opts){my$opt=shift @{$opts};my ($name,$value)=@$opt;($name =~ m{\A\!(/.+/[msixpodual]+)\z})? do {my@not=$class->_exporter_expand_regexp($1,$value,$global_opts);++$not_want->{$_->[0]}for@not}: ($name =~ m{\A\!(.+)\z})? (++$not_want->{$1}): ($name =~ m{\A[:-](.+)\z})? push(@$opts,$class->_exporter_expand_tag($1,$value,$global_opts)): ($name =~ m{\A/.+/[msixpodual]+\z})? push(@$opts,$class->_exporter_expand_regexp($name,$value,$global_opts)): push(@$want,$opt)}};sub import {my$class=shift;my$global_opts=+{@_ && ref($_[0])eq q(HASH) ? %{+shift}: ()};$global_opts->{into}=caller unless exists$global_opts->{into};my@want;my%not_want;$global_opts->{not}=\%not_want;my@args=do {no strict qw(refs);@_ ? @_ : @{"$class\::EXPORT"}};my$opts=mkopt(\@args);$class->$_process_optlist($global_opts,$opts,\@want,\%not_want);my$permitted=$class->_exporter_permitted_regexp($global_opts);$class->_exporter_validate_opts($global_opts);for my$wanted (@want){next if$not_want{$wanted->[0]};my%symbols=$class->_exporter_expand_sub(@$wanted,$global_opts,$permitted);$class->_exporter_install_sub($_,$wanted->[1],$global_opts,$symbols{$_})for keys%symbols}}sub unimport {my$class=shift;my$global_opts=+{@_ && ref($_[0])eq q(HASH) ? %{+shift}: ()};$global_opts->{into}=caller unless exists$global_opts->{into};$global_opts->{is_unimport}=1;my@want;my%not_want;$global_opts->{not}=\%not_want;my@args=do {our%TRACKED;@_ ? @_ : keys(%{$TRACKED{$class}{$global_opts->{into}}})};my$opts=mkopt(\@args);$class->$_process_optlist($global_opts,$opts,\@want,\%not_want);my$permitted=$class->_exporter_permitted_regexp($global_opts);$class->_exporter_validate_unimport_opts($global_opts);my$expando=$class->can('_exporter_expand_sub');$expando=undef if$expando==\&_exporter_expand_sub;for my$wanted (@want){next if$not_want{$wanted->[0]};if ($wanted->[1]){_carp("Passing options to unimport '%s' makes no sense",$wanted->[0])unless (ref($wanted->[1])eq 'HASH' and not keys %{$wanted->[1]})}my%symbols=defined($expando)? $class->$expando(@$wanted,$global_opts,$permitted): ($wanted->[0]=>sub {"dummy"});$class->_exporter_uninstall_sub($_,$wanted->[1],$global_opts)for keys%symbols}}sub _exporter_validate_opts {1}sub _exporter_validate_unimport_opts {1}sub _exporter_merge_opts {my$class=shift;my ($tag_opts,$global_opts,@stuff)=@_;$tag_opts={}unless ref($tag_opts)eq q(HASH);_croak('Cannot provide an -as option for tags')if exists$tag_opts->{-as}&& ref$tag_opts->{-as}ne 'CODE';my$optlist=mkopt(\@stuff);for my$export (@$optlist){next if defined($export->[1])&& ref($export->[1])ne q(HASH);my%sub_opts=(%{$export->[1]or {}},%$tag_opts);$sub_opts{-prefix}=sprintf('%s%s',$tag_opts->{-prefix},$export->[1]{-prefix})if exists($export->[1]{-prefix})&& exists($tag_opts->{-prefix});$sub_opts{-suffix}=sprintf('%s%s',$export->[1]{-suffix},$tag_opts->{-suffix})if exists($export->[1]{-suffix})&& exists($tag_opts->{-suffix});$export->[1]=\%sub_opts}return @$optlist}sub _exporter_expand_tag {no strict qw(refs);my$class=shift;my ($name,$value,$globals)=@_;my$tags=\%{"$class\::EXPORT_TAGS"};return$class->_exporter_merge_opts($value,$globals,$tags->{$name}->($class,@_))if ref($tags->{$name})eq q(CODE);return$class->_exporter_merge_opts($value,$globals,@{$tags->{$name}})if exists$tags->{$name};return$class->_exporter_merge_opts($value,$globals,@{"$class\::EXPORT"},@{"$class\::EXPORT_OK"})if$name eq 'all';return$class->_exporter_merge_opts($value,$globals,@{"$class\::EXPORT"})if$name eq 'default';$globals->{$name}=$value || 1;return}sub _exporter_expand_regexp {no strict qw(refs);our%TRACKED;my$class=shift;my ($name,$value,$globals)=@_;my$compiled=eval("qr$name");my@possible=$globals->{is_unimport}? keys(%{$TRACKED{$class}{$globals->{into}}}): @{"$class\::EXPORT_OK"};$class->_exporter_merge_opts($value,$globals,grep /$compiled/,@possible)}sub _exporter_permitted_regexp {no strict qw(refs);my$class=shift;my$re=join "|",map quotemeta,sort {length($b)<=> length($a)or $a cmp $b}@{"$class\::EXPORT"},@{"$class\::EXPORT_OK"};qr{^(?:$re)$}ms}sub _exporter_expand_sub {my$class=shift;my ($name,$value,$globals,$permitted)=@_;$permitted ||= $class->_exporter_permitted_regexp($globals);no strict qw(refs);if ($name =~ $permitted){my$generator=$class->can("_generate_$name");return$name=>$class->$generator($name,$value,$globals)if$generator;my$sub=$class->can($name);return$name=>$sub if$sub}$class->_exporter_fail(@_)}sub _exporter_fail {my$class=shift;my ($name,$value,$globals)=@_;return if$globals->{is_unimport};_croak("Could not find sub '%s' exported by %s",$name,$class)}sub _exporter_install_sub {my$class=shift;my ($name,$value,$globals,$sym)=@_;my$into=$globals->{into};my$installer=$globals->{installer}|| $globals->{exporter};$name=ref$globals->{as}? $globals->{as}->($name): ref$value->{-as}? $value->{-as}->($name): exists$value->{-as}? $value->{-as}: $name;return unless defined$name;unless (ref($name)){my ($prefix)=grep defined,$value->{-prefix},$globals->{prefix},q();my ($suffix)=grep defined,$value->{-suffix},$globals->{suffix},q();$name="$prefix$name$suffix"}return ($$name=$sym)if ref($name)eq q(SCALAR);return ($into->{$name}=$sym)if ref($into)eq q(HASH);no strict qw(refs);if (exists &{"$into\::$name"}and \&{"$into\::$name"}!=$sym){my ($level)=grep defined,$value->{-replace},$globals->{replace},q(0);my$action={carp=>\&_carp,0=>\&_carp,''=>\&_carp,warn=>\&_carp,nonfatal=>\&_carp,croak=>\&_croak,fatal=>\&_croak,die=>\&_croak,}->{$level}|| sub {};$action->($action==\&_croak ? "Refusing to overwrite existing sub '%s::%s' with sub '%s' exported by %s" : "Overwriting existing sub '%s::%s' with sub '%s' exported by %s",$into,$name,$_[0],$class,)}our%TRACKED;$TRACKED{$class}{$into}{$name}=$sym;no warnings qw(prototype);$installer ? $installer->($globals,[$name,$sym]): (*{"$into\::$name"}=$sym)}sub _exporter_uninstall_sub {our%TRACKED;my$class=shift;my ($name,$value,$globals,$sym)=@_;my$into=$globals->{into};ref$into and return;no strict qw(refs);my$our_coderef=$TRACKED{$class}{$into}{$name};my$cur_coderef=exists(&{"$into\::$name"})? \&{"$into\::$name"}: -1;return unless$our_coderef==$cur_coderef;my$stash=\%{"$into\::"};my$old=delete$stash->{$name};my$full_name=join('::',$into,$name);for my$type (qw(SCALAR HASH ARRAY IO)){next unless defined(*{$old}{$type});*$full_name=*{$old}{$type}}delete$TRACKED{$class}{$into}{$name}}sub mkopt {my$in=shift or return [];my@out;$in=[map(($_=>ref($in->{$_})? $in->{$_}: ()),sort keys %$in)]if ref($in)eq q(HASH);for (my$i=0;$i < @$in;$i++){my$k=$in->[$i];my$v;($i==$#$in)? ($v=undef): !defined($in->[$i+1])? (++$i,($v=undef)): !ref($in->[$i+1])? ($v=undef): ($v=$in->[++$i]);push@out,[$k=>$v ]}\@out}sub mkopt_hash {my$in=shift or return;my%out=map +($_->[0]=>$_->[1]),@{mkopt($in)};\%out}1; -EXPORTER_TINY - -$fatpacked{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH'; - package File::Which;use strict;use warnings;use Exporter ();use File::Spec ();our$VERSION='1.22';our@ISA='Exporter';our@EXPORT='which';our@EXPORT_OK='where';use constant IS_VMS=>($^O eq 'VMS');use constant IS_MAC=>($^O eq 'MacOS');use constant IS_DOS=>($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');use constant IS_CYG=>($^O eq 'cygwin' || $^O eq 'msys');my@PATHEXT=('');if (IS_DOS){if ($ENV{PATHEXT}){push@PATHEXT,split ';',$ENV{PATHEXT}}else {push@PATHEXT,qw{.com .exe .bat}}}elsif (IS_VMS){push@PATHEXT,qw{.exe .com}}elsif (IS_CYG){push@PATHEXT,qw{.exe .com}}sub which {my ($exec)=@_;return undef unless defined$exec;return undef if$exec eq '';my$all=wantarray;my@results=();if (IS_VMS){my$symbol=`SHOW SYMBOL $exec`;chomp($symbol);unless ($?){return$symbol unless$all;push@results,$symbol}}if (IS_MAC){my@aliases=split /\,/,$ENV{Aliases};for my$alias (@aliases){if (lc($alias)eq lc($exec)){chomp(my$file=`Alias $alias`);last unless$file;return$file unless$all;push@results,$file;last}}}return$exec if!IS_VMS and!IS_MAC and!IS_DOS and $exec =~ /\// and -f $exec and -x $exec;my@path=File::Spec->path;if (IS_DOS or IS_VMS or IS_MAC){unshift@path,File::Spec->curdir}for my$base (map {File::Spec->catfile($_,$exec)}@path){for my$ext (@PATHEXT){my$file=$base.$ext;next if -d $file;if (-x _ or (IS_MAC || ((IS_DOS or IS_CYG)and grep {$file =~ /$_\z/i}@PATHEXT[1..$#PATHEXT])and -e _)){return$file unless$all;push@results,$file}}}if ($all){return@results}else {return undef}}sub where {my@res=which($_[0]);return@res}1; -FILE_WHICH - -$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD'; - use strict;use warnings;package File::pushd;our$VERSION='1.014';our@EXPORT=qw(pushd tempd);our@ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub {File::Spec->canonpath($_[0]->{_pushd})},fallback=>1;sub pushd {unless (defined wantarray){warnings::warnif(void=>'Useless use of File::pushd::pushd in void context');return}my ($target_dir,$options)=@_;$options->{untaint_pattern}||= qr{^([-+@\w./]+)$};$target_dir="." unless defined$target_dir;croak "Can't locate directory $target_dir" unless -d $target_dir;my$tainted_orig=getcwd;my$orig;if ($tainted_orig =~ $options->{untaint_pattern}){$orig=$1}else {$orig=$tainted_orig}my$tainted_dest;eval {$tainted_dest=$target_dir ? abs_path($target_dir): $orig};croak "Can't locate absolute path for $target_dir: $@" if $@;my$dest;if ($tainted_dest =~ $options->{untaint_pattern}){$dest=$1}else {$dest=$tainted_dest}if ($dest ne $orig){chdir$dest or croak "Can't chdir to $dest\: $!"}my$self=bless {_pushd=>$dest,_original=>$orig },__PACKAGE__;return$self}sub tempd {unless (defined wantarray){warnings::warnif(void=>'Useless use of File::pushd::tempd in void context');return}my ($options)=@_;my$dir;eval {$dir=pushd(File::Temp::tempdir(CLEANUP=>0),$options)};croak $@ if $@;$dir->{_tempd}=1;return$dir}sub preserve {my$self=shift;return 1 if!$self->{"_tempd"};if (@_==0){return$self->{_preserve}=1}else {return$self->{_preserve}=$_[0]? 1 : 0}}sub DESTROY {my ($self)=@_;my$orig=$self->{_original};chdir$orig if$orig;if ($self->{_tempd}&&!$self->{_preserve}){my$err=do {local $@;eval {rmtree($self->{_pushd})};$@};carp$err if$err}}1; -FILE_PUSHD - -$fatpacked{"Getopt/Long/Subcommand.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG_SUBCOMMAND'; - package Getopt::Long::Subcommand;our$DATE='2017-08-12';our$VERSION='0.102';use 5.010001;use strict;use warnings;require Exporter;our@ISA=qw(Exporter);our@EXPORT=qw(GetOptions);my@known_cmdspec_keys=qw(options subcommands default_subcommand summary description completion configure);sub _cmdspec_opts_to_gl_ospec {my ($cmdspec_opts,$is_completion,$res)=@_;return {map {if ($is_completion){($_=>sub{})}else {my$k=$_;my$v=$cmdspec_opts->{$k};my$handler=ref($v)eq 'HASH' ? $v->{handler}: $v;if (ref($handler)eq 'CODE'){my$orig_handler=$handler;$handler=sub {my ($cb,$val)=@_;$orig_handler->($cb,$val,$res)}}($k=>$handler)}}keys %$cmdspec_opts }}sub _gl_getoptions {require Getopt::Long;my ($ospec,$configure,$pass_through,$res)=@_;my@configure=@{$configure // ['no_ignore_case','no_getopt_compat','gnu_compat','bundling']};if ($pass_through){push@configure,'pass_through' unless grep {$_ eq 'pass_through'}@configure}else {@configure=grep {$_ ne 'pass_through'}@configure}my$old_conf=Getopt::Long::Configure(@configure);local$SIG{__WARN__}=sub {}if$pass_through;local$res->{_non_options_argv}=[];my$gl_res=Getopt::Long::GetOptions(%$ospec,'<>'=>sub {push @{$res->{_non_options_argv}},$_[0]},);@ARGV=@{$res->{_non_options_argv}};Getopt::Long::Configure($old_conf);$gl_res}sub _GetOptions {my ($cmdspec,$is_completion,$res,$stash)=@_;$res //= {success=>undef};$stash //= {path=>'',level=>0,};{for my$k (keys %$cmdspec){(grep {$_ eq $k}@known_cmdspec_keys)or die "Unknown command specification key '$k'" .($stash->{path}? " (under $stash->{path})" : "")."\n"}}my$has_subcommands=$cmdspec->{subcommands}&& keys(%{$cmdspec->{subcommands}});my$pass_through=$has_subcommands || $is_completion;my$ospec=_cmdspec_opts_to_gl_ospec($cmdspec->{options},$is_completion,$res);unless (_gl_getoptions($ospec,$cmdspec->{configure},$pass_through,$res)){$res->{success}=0;return$res}if ($is_completion){$res->{comp_ospec}//= {};for (keys %$ospec){$res->{comp_ospec}{$_}=$ospec->{$_}}}if ($has_subcommands){if ($is_completion){$res->{comp_subcommand_names}[$stash->{level}]=[sort keys %{$cmdspec->{subcommands}}]}$res->{subcommand}//= [];my$push;my$sc_name;if (defined$res->{subcommand}[$stash->{level}]){$sc_name=$res->{subcommand}[$stash->{level}]}elsif (@ARGV){$sc_name=shift@ARGV;$push++}elsif (defined$cmdspec->{default_subcommand}){$sc_name=$cmdspec->{default_subcommand};$push++}else {$res->{success}=1;return$res}if ($is_completion){push @{$res->{comp_subcommand_name}},$sc_name}my$sc_spec=$cmdspec->{subcommands}{$sc_name};unless ($sc_spec){warn "Unknown subcommand '$sc_name'".($stash->{path}? " for $stash->{path}":"")."\n" unless$is_completion;$res->{success}=0;return$res};push @{$res->{subcommand}},$sc_name if$push;local$stash->{path}=($stash->{path}? "/" : "").$sc_name;local$stash->{level}=$stash->{level}+1;_GetOptions($sc_spec,$is_completion,$res,$stash)}$res->{success}//= 1;$res}sub GetOptions {my%cmdspec=@_;my ($is_completion,$shell,$words,$cword);CHECK_COMPLETION: {if ($ENV{COMP_SHELL}){($shell=$ENV{COMP_SHELL})=~ s!.+/!!}elsif ($ENV{COMMAND_LINE}){$shell='tcsh'}else {$shell='bash'}if ($ENV{COMP_LINE}|| $ENV{COMMAND_LINE}){if ($ENV{COMP_LINE}){$is_completion++;require Complete::Bash;($words,$cword)=@{Complete::Bash::parse_cmdline(undef,undef,{truncate_current_word=>1})};($words,$cword)=@{Complete::Bash::join_wordbreak_words($words,$cword)}}elsif ($ENV{COMMAND_LINE}){$is_completion++;require Complete::Tcsh;$shell='tcsh';($words,$cword)=@{Complete::Tcsh::parse_cmdline()}}else {last CHECK_COMPLETION}shift @$words;$cword--;@ARGV=@$words}}my$res=_GetOptions(\%cmdspec,$is_completion);if ($is_completion){my$ospec=$res->{comp_ospec};require Complete::Getopt::Long;my$compres=Complete::Getopt::Long::complete_cli_arg(words=>$words,cword=>$cword,getopt_spec=>$ospec,extras=>{stash=>$res->{stash},},bundling=>do {if (!$cmdspec{configure}){1}elsif (grep {$_ eq 'bundling'}@{$cmdspec{configure}}){1}elsif (grep {$_ eq 'no_bundling'}@{$cmdspec{configure}}){0}else {0}},completion=>sub {my%args=@_;my$word=$args{word}// '';my$type=$args{type};my$stash=$args{stash};if ($type eq 'arg' && $args{argpos}< @{$res->{comp_subcommand_names}//[]}){require Complete::Util;return Complete::Util::complete_array_elem(array=>$res->{comp_subcommand_names}[$args{argpos}],word=>$res->{comp_subcommand_name}[$args{argpos}],)}$args{getopt_res}=$res;$args{subcommand}=$res->{comp_subcommand_name};$cmdspec{completion}->(%args)if$cmdspec{completion}},);if ($shell eq 'bash'){print Complete::Bash::format_completion($compres)}elsif ($shell eq 'tcsh'){print Complete::Tcsh::format_completion($compres)}else {die "Unknown shell '$shell'"}exit 0}$res}1; -GETOPT_LONG_SUBCOMMAND - -$fatpacked{"Graph.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH'; - package Graph;use strict;use warnings;no warnings 'redefine';BEGIN {if (0){$SIG{__DIE__ }=\&__carp_confess;$SIG{__WARN__}=\&__carp_confess}sub __carp_confess {require Carp;Carp::confess(@_)}}use Graph::AdjacencyMap qw(:flags :fields);use vars qw($VERSION);$VERSION='0.9704';require 5.006;my$can_deep_copy_Storable=eval {require Storable;require B::Deparse;Storable->VERSION(2.05);B::Deparse->VERSION(0.61);1};sub _can_deep_copy_Storable () {return$can_deep_copy_Storable}use Graph::AdjacencyMap::Heavy;use Graph::AdjacencyMap::Light;use Graph::AdjacencyMap::Vertex;use Graph::UnionFind;use Graph::TransitiveClosure;use Graph::Traversal::DFS;use Graph::MSTHeapElem;use Graph::SPTHeapElem;use Graph::Undirected;use Heap071::Fibonacci;use List::Util qw(shuffle first);use Scalar::Util qw(weaken);use Safe;sub _F () {0}sub _G () {1}sub _V () {2}sub _E () {3}sub _A () {4}sub _U () {5}sub _S () {6}sub _P () {7}my$Inf;BEGIN {if ($] >= 5.022){$Inf=eval '+"Inf"'}else {local$SIG{FPE};eval {$Inf=exp(999)}|| eval {$Inf=9**9**9}|| eval {$Inf=1e+999}|| {$Inf=1e+99 }}}sub Infinity () {$Inf}use Graph::Attribute array=>_A,map=>'graph';sub _COMPAT02 () {0x00000001}sub stringify {my$g=shift;my$u=$g->is_undirected;my$e=$u ? '=' : '-';my@e=map {my@v=map {ref($_)eq 'ARRAY' ? "[" .join(" ",@$_)."]" : "$_"}@$_;join($e,$u ? sort {"$a" cmp "$b"}@v : @v)}$g->edges05;my@s=sort {"$a" cmp "$b"}@e;push@s,sort {"$a" cmp "$b"}$g->isolated_vertices;join(",",@s)}sub eq {"$_[0]" eq "$_[1]"}sub boolify {1}sub ne {"$_[0]" ne "$_[1]"}use overload '""'=>\&stringify,'bool'=>\&boolify,'eq'=>\&eq,'ne'=>\≠sub _opt {my ($opt,$flags,%flags)=@_;while (my ($flag,$FLAG)=each%flags){if (exists$opt->{$flag}){$$flags |= $FLAG if$opt->{$flag};delete$opt->{$flag}}if (exists$opt->{my$non="non$flag"}){$$flags &= ~$FLAG if$opt->{$non};delete$opt->{$non}}}}sub is_compat02 {my ($g)=@_;$g->[_F ]& _COMPAT02}*compat02=\&is_compat02;sub has_union_find {my ($g)=@_;($g->[_F ]& _UNIONFIND)&& defined$g->[_U ]}sub _get_union_find {my ($g)=@_;$g->[_U ]}sub _opt_get {my ($opt,$key,$var)=@_;if (exists$opt->{$key}){$$var=$opt->{$key};delete$opt->{$key}}}sub _opt_unknown {my ($opt)=@_;if (my@opt=keys %$opt){my$f=(caller(1))[3];require Carp;Carp::confess(sprintf "$f: Unknown option%s: @{[map { qq['$_'] } sort @opt]}",@opt > 1 ? 's' : '')}}sub new {my$class=shift;my$gflags=0;my$vflags;my$eflags;my%opt=_get_options(\@_);if (ref$class && $class->isa('Graph')){no strict 'refs';for my$c (qw(undirected refvertexed compat02 hypervertexed countvertexed multivertexed hyperedged countedged multiedged omniedged __stringified)){if (&{"Graph::$c"}($class)){$opt{$c}++}}if (&{"Graph::has_union_find"}($class)){$opt{unionfind}++}}_opt_get(\%opt,undirected=>\$opt{omniedged});_opt_get(\%opt,omnidirected=>\$opt{omniedged});if (exists$opt{directed}){$opt{omniedged}=!$opt{directed};delete$opt{directed}}my$vnonomni=$opt{nonomnivertexed}|| (exists$opt{omnivertexed}&&!$opt{omnivertexed});my$vnonuniq=$opt{nonuniqvertexed}|| (exists$opt{uniqvertexed}&&!$opt{uniqvertexed});_opt(\%opt,\$vflags,countvertexed=>_COUNT,multivertexed=>_MULTI,hypervertexed=>_HYPER,omnivertexed=>_UNORD,uniqvertexed=>_UNIQ,refvertexed=>_REF,refvertexed_stringified=>_REFSTR,__stringified=>_STR,);_opt(\%opt,\$eflags,countedged=>_COUNT,multiedged=>_MULTI,hyperedged=>_HYPER,omniedged=>_UNORD,uniqedged=>_UNIQ,);_opt(\%opt,\$gflags,compat02=>_COMPAT02,unionfind=>_UNIONFIND,);if (exists$opt{vertices_unsorted}){my$unsorted=$opt{vertices_unsorted};delete$opt{vertices_unsorted};require Carp;Carp::confess("Graph: vertices_unsorted must be true")unless$unsorted}my@V;if ($opt{vertices}){require Carp;Carp::confess("Graph: vertices should be an array ref")unless ref$opt{vertices}eq 'ARRAY';@V=@{$opt{vertices}};delete$opt{vertices}}my@E;if ($opt{edges}){unless (ref$opt{edges}eq 'ARRAY'){require Carp;Carp::confess("Graph: edges should be an array ref of array refs")}@E=@{$opt{edges}};delete$opt{edges}}_opt_unknown(\%opt);my$uflags;if (defined$vflags){$uflags=$vflags;$uflags |= _UNORD unless$vnonomni;$uflags |= _UNIQ unless$vnonuniq}else {$uflags=_UNORDUNIQ;$vflags=0}if (!($vflags & _HYPER)&& ($vflags & _UNORDUNIQ)){my@but;push@but,'unordered' if ($vflags & _UNORD);push@but,'unique' if ($vflags & _UNIQ);require Carp;Carp::confess(sprintf "Graph: not hypervertexed but %s",join(' and ',@but))}unless (defined$eflags){$eflags=($gflags & _COMPAT02)? _COUNT : 0}if (!($vflags & _HYPER)&& ($vflags & _UNIQ)){require Carp;Carp::confess("Graph: not hypervertexed but uniqvertexed")}if (($vflags & _COUNT)&& ($vflags & _MULTI)){require Carp;Carp::confess("Graph: both countvertexed and multivertexed")}if (($eflags & _COUNT)&& ($eflags & _MULTI)){require Carp;Carp::confess("Graph: both countedged and multiedged")}my$g=bless [],ref$class || $class;$g->[_F ]=$gflags;$g->[_G ]=0;$g->[_V ]=($vflags & (_HYPER | _MULTI))? Graph::AdjacencyMap::Heavy->_new($uflags,1): (($vflags & ~_UNORD)? Graph::AdjacencyMap::Vertex->_new($uflags,1): Graph::AdjacencyMap::Light->_new($g,$uflags,1));$g->[_E ]=(($vflags & _HYPER)|| ($eflags & ~_UNORD))? Graph::AdjacencyMap::Heavy->_new($eflags,2): Graph::AdjacencyMap::Light->_new($g,$eflags,2);$g->add_vertices(@V)if@V;if (@E){for my$e (@E){unless (ref$e eq 'ARRAY'){require Carp;Carp::confess("Graph: edges should be array refs")}$g->add_edge(@$e)}}if (($gflags & _UNIONFIND)){$g->[_U ]=Graph::UnionFind->new}return$g}sub countvertexed {$_[0]->[_V ]->_is_COUNT}sub multivertexed {$_[0]->[_V ]->_is_MULTI}sub hypervertexed {$_[0]->[_V ]->_is_HYPER}sub omnivertexed {$_[0]->[_V ]->_is_UNORD}sub uniqvertexed {$_[0]->[_V ]->_is_UNIQ}sub refvertexed {$_[0]->[_V ]->_is_REF}sub refvertexed_stringified {$_[0]->[_V ]->_is_REFSTR}sub __stringified {$_[0]->[_V ]->_is_STR}sub countedged {$_[0]->[_E ]->_is_COUNT}sub multiedged {$_[0]->[_E ]->_is_MULTI}sub hyperedged {$_[0]->[_E ]->_is_HYPER}sub omniedged {$_[0]->[_E ]->_is_UNORD}sub uniqedged {$_[0]->[_E ]->_is_UNIQ}*undirected=\&omniedged;*omnidirected=\&omniedged;sub directed {!$_[0]->[_E ]->_is_UNORD}*is_directed=\&directed;*is_undirected=\&undirected;*is_countvertexed=\&countvertexed;*is_multivertexed=\&multivertexed;*is_hypervertexed=\&hypervertexed;*is_omnidirected=\&omnidirected;*is_uniqvertexed=\&uniqvertexed;*is_refvertexed=\&refvertexed;*is_refvertexed_stringified=\&refvertexed_stringified;*is_countedged=\&countedged;*is_multiedged=\&multiedged;*is_hyperedged=\&hyperedged;*is_omniedged=\&omniedged;*is_uniqedged=\&uniqedged;sub _union_find_add_vertex {my ($g,$v)=@_;my$UF=$g->[_U ];$UF->add($g->[_V ]->_get_path_id($v))}sub add_vertex {my$g=shift;if (@_!=1){$g->expect_hypervertexed}if ($g->is_multivertexed){return$g->add_vertex_by_id(@_,_GEN_ID)}my@r;if (@_ > 1){unless ($g->is_countvertexed || $g->is_hypervertexed){require Carp;Carp::croak("Graph::add_vertex: use add_vertices for more than one vertex or use hypervertexed")}for my$v (@_){if (defined$v){$g->[_V ]->set_path($v)unless$g->has_vertex($v)}else {require Carp;Carp::croak("Graph::add_vertex: undef vertex")}}}for my$v (@_){unless (defined$v){require Carp;Carp::croak("Graph::add_vertex: undef vertex")}}$g->[_V ]->set_path(@_);$g->[_G ]++;$g->_union_find_add_vertex(@_)if$g->has_union_find;return$g}sub has_vertex {my$g=shift;my$V=$g->[_V ];return exists$V->[_s ]->{$_[0]}if ($V->[_f ]& _LIGHT);$V->has_path(@_)}sub vertices05 {my$g=shift;my@v=$g->[_V ]->paths(@_);if (wantarray){return$g->[_V ]->_is_HYPER ? @v : map {ref $_ eq 'ARRAY' ? @$_ : $_}@v}else {return scalar@v}}sub vertices {my$g=shift;my@v=$g->vertices05;if ($g->is_compat02){wantarray ? sort@v : scalar@v}else {if ($g->is_multivertexed || $g->is_countvertexed){if (wantarray){my@V;for my$v (@v){push@V,($v)x $g->get_vertex_count($v)}return@V}else {my$V=0;for my$v (@v){$V += $g->get_vertex_count($v)}return$V}}else {return@v}}}*vertices_unsorted=\&vertices_unsorted;sub unique_vertices {my$g=shift;my@v=$g->vertices05;if ($g->is_compat02){wantarray ? sort@v : scalar@v}else {return@v}}sub has_vertices {my$g=shift;scalar$g->[_V ]->has_paths(@_)}sub _add_edge {my$g=shift;my$V=$g->[_V ];my@e;if (($V->[_f ])& _LIGHT){for my$v (@_){$g->add_vertex($v)unless exists$V->[_s ]->{$v };push@e,$V->[_s ]->{$v }}}else {my$h=$g->[_V ]->_is_HYPER;for my$v (@_){my@v=ref$v eq 'ARRAY' && $h ? @$v : $v;$g->add_vertex(@v)unless$V->has_path(@v);push@e,$V->_get_path_id(@v)}}return@e}sub _union_find_add_edge {my ($g,$u,$v)=@_;$g->[_U ]->union($u,$v)}sub add_edge {my$g=shift;if (@_!=2){$g->expect_hyperedged}if ($g->is_multiedged){unless (@_==2 || $g->is_hyperedged){require Carp;Carp::croak("Graph::add_edge: use add_edges for more than one edge")}return$g->add_edge_by_id(@_,_GEN_ID)}my@e=$g->_add_edge(@_);$g->[_E ]->set_path(@e);$g->[_G ]++;$g->_union_find_add_edge(@e)if$g->has_union_find;return$g}sub _vertex_ids {my$g=shift;my$V=$g->[_V ];my@e;if (($V->[_f ]& _LIGHT)){for my$v (@_){return ()unless exists$V->[_s ]->{$v };push@e,$V->[_s ]->{$v }}}else {my$h=$g->[_V ]->_is_HYPER;for my$v (@_){my@v=ref$v eq 'ARRAY' && $h ? @$v : $v;return ()unless$V->has_path(@v);push@e,$V->_get_path_id(@v)}}return@e}sub has_edge {my$g=shift;my$E=$g->[_E ];my$V=$g->[_V ];my@i;if (($V->[_f ]& _LIGHT)&& @_==2){return 0 unless exists$V->[_s ]->{$_[0]}&& exists$V->[_s ]->{$_[1]};@i=@{$V->[_s ]}{@_[0,1 ]}}else {@i=$g->_vertex_ids(@_);return 0 if@i==0 && @_}my$f=$E->[_f ];if ($E->[_a ]==2 && @i==2 &&!($f & (_HYPER|_REF|_UNIQ))){@i=sort@i if ($f & _UNORD);return exists$E->[_s ]->{$i[0]}&& exists$E->[_s ]->{$i[0]}->{$i[1]}? 1 : 0}else {return defined$E->_get_path_id(@i)? 1 : 0}}sub edges05 {my$g=shift;my$V=$g->[_V ];my@e=$g->[_E ]->paths(@_);wantarray ? map {[map {my@v=$V->_get_id_path($_);@v==1 ? $v[0]: [@v ]}@$_ ]}@e : @e}sub edges02 {my$g=shift;if (@_ && defined $_[0]){unless (defined $_[1]){my@e=$g->edges_at($_[0]);wantarray ? map {@$_}sort {$a->[0]cmp $b->[0]|| $a->[1]cmp $b->[1]}@e : @e}else {die "edges02: unimplemented option"}}else {my@e=map {($_)x $g->get_edge_count(@$_)}$g->edges05(@_);wantarray ? map {@$_}sort {$a->[0]cmp $b->[0]|| $a->[1]cmp $b->[1]}@e : @e}}sub unique_edges {my$g=shift;($g->is_compat02)? $g->edges02(@_): $g->edges05(@_)}sub edges {my$g=shift;if ($g->is_compat02){return$g->edges02(@_)}else {if ($g->is_multiedged || $g->is_countedged){if (wantarray){my@E;for my$e ($g->edges05){push@E,($e)x $g->get_edge_count(@$e)}return@E}else {my$E=0;for my$e ($g->edges05){$E += $g->get_edge_count(@$e)}return$E}}else {return$g->edges05}}}sub has_edges {my$g=shift;scalar$g->[_E ]->has_paths(@_)}sub add_vertex_by_id {my$g=shift;$g->expect_multivertexed;$g->[_V ]->set_path_by_multi_id(@_);$g->[_G ]++;$g->_union_find_add_vertex(@_)if$g->has_union_find;return$g}sub add_vertex_get_id {my$g=shift;$g->expect_multivertexed;my$id=$g->[_V ]->set_path_by_multi_id(@_,_GEN_ID);$g->[_G ]++;$g->_union_find_add_vertex(@_)if$g->has_union_find;return$id}sub has_vertex_by_id {my$g=shift;$g->expect_multivertexed;$g->[_V ]->has_path_by_multi_id(@_)}sub delete_vertex_by_id {my$g=shift;$g->expect_multivertexed;$g->expect_non_unionfind;my$V=$g->[_V ];return unless$V->has_path_by_multi_id(@_);$V->del_path_by_multi_id(@_);$g->[_G ]++;return$g}sub get_multivertex_ids {my$g=shift;$g->expect_multivertexed;$g->[_V ]->get_multi_ids(@_)}sub add_edge_by_id {my$g=shift;$g->expect_multiedged;my$id=pop;my@e=$g->_add_edge(@_);$g->[_E ]->set_path_by_multi_id(@e,$id);$g->[_G ]++;$g->_union_find_add_edge(@e)if$g->has_union_find;return$g}sub add_edge_get_id {my$g=shift;$g->expect_multiedged;my@i=$g->_add_edge(@_);my$id=$g->[_E ]->set_path_by_multi_id(@i,_GEN_ID);$g->_union_find_add_edge(@i)if$g->has_union_find;$g->[_G ]++;return$id}sub has_edge_by_id {my$g=shift;$g->expect_multiedged;my$id=pop;my@i=$g->_vertex_ids(@_);return 0 if@i==0 && @_;$g->[_E ]->has_path_by_multi_id(@i,$id)}sub delete_edge_by_id {my$g=shift;$g->expect_multiedged;$g->expect_non_unionfind;my$V=$g->[_E ];my$id=pop;my@i=$g->_vertex_ids(@_);return unless$V->has_path_by_multi_id(@i,$id);$V->del_path_by_multi_id(@i,$id);$g->[_G ]++;return$g}sub get_multiedge_ids {my$g=shift;$g->expect_multiedged;my@id=$g->_vertex_ids(@_);return unless@id;$g->[_E ]->get_multi_ids(@id)}sub vertices_at {my$g=shift;my$V=$g->[_V ];return @_ unless ($V->[_f ]& _HYPER);my%v;my@i;for my$v (@_){my$i=$V->_get_path_id($v);return unless defined$i;push@i,($v{$v }=$i)}my$Vi=$V->_ids;my@v;while (my ($i,$v)=each %{$Vi}){my%i;my$h=$V->[_f ]& _HYPER;@i{@i }=@i if@i;for my$u (ref$v eq 'ARRAY' && $h ? @$v : $v){my$j=exists$v{$u }? $v{$u }: ($v{$u }=$i);if (defined$j && exists$i{$j }){delete$i{$j };unless (keys%i){push@v,$v;last}}}}return@v}sub _edges_at {my$g=shift;my$V=$g->[_V ];my$E=$g->[_E ];my@e;my$en=0;my%ev;my$h=$V->[_f ]& _HYPER;for my$v ($h ? $g->vertices_at(@_): @_){my$vi=$V->_get_path_id(ref$v eq 'ARRAY' && $h ? @$v : $v);next unless defined$vi;my$Ei=$E->_ids;while (my ($ei,$ev)=each %{$Ei}){if (wantarray){for my$j (@$ev){push@e,[$ei,$ev ]if$j==$vi &&!$ev{$ei}++}}else {for my$j (@$ev){$en++ if$j==$vi}}}}return wantarray ? @e : $en}sub _edges {my$g=shift;my$n=pop;my$i=$n==_S ? 0 : -1;my$V=$g->[_V ];my$E=$g->[_E ];my$N=$g->[$n ];my$h=$V->[_f ]& _HYPER;unless (defined$N && $N->[0 ]==$g->[_G ]){$g->[$n ]->[1 ]={};$N=$g->[$n ];my$u=$E->[_f ]& _UNORD;my$Ei=$E->_ids;while (my ($ei,$ev)=each %{$Ei}){next unless @$ev;my$e=[$ei,$ev ];if ($u){push @{$N->[1 ]->{$ev->[0]}},$e;push @{$N->[1 ]->{$ev->[-1]}},$e}else {my$e=[$ei,$ev ];push @{$N->[1 ]->{$ev->[$i]}},$e}}$N->[0 ]=$g->[_G ]}my@e;my@at=$h ? $g->vertices_at(@_): @_;my%at;@at{@at}=();for my$v (@at){my$vi=$V->_get_path_id(ref$v eq 'ARRAY' && $h ? @$v : $v);next unless defined$vi && exists$N->[1 ]->{$vi };push@e,@{$N->[1 ]->{$vi }}}if (wantarray && $g->is_undirected){my@i=map {$V->_get_path_id($_)}@_;for my$e (@e){unless ($e->[1 ]->[$i ]==$i[$i ]){$e=[$e->[0 ],[reverse @{$e->[1 ]}]]}}}return@e}sub _edges_from {push @_,_S;goto&_edges}sub _edges_to {push @_,_P;goto&_edges}sub _edges_id_path {my$g=shift;my$V=$g->[_V ];[map {my@v=$V->_get_id_path($_);@v==1 ? $v[0]: [@v ]}@{$_[0]->[1]}]}sub edges_at {my$g=shift;map {$g->_edges_id_path($_)}$g->_edges_at(@_)}sub edges_from {my$g=shift;map {$g->_edges_id_path($_)}$g->_edges_from(@_)}sub edges_to {my$g=shift;map {$g->_edges_id_path($_)}$g->_edges_to(@_)}sub successors {my$g=shift;my$E=$g->[_E ];($E->[_f ]& _LIGHT)? $E->_successors($g,@_): Graph::AdjacencyMap::_successors($E,$g,@_)}sub predecessors {my$g=shift;my$E=$g->[_E ];($E->[_f ]& _LIGHT)? $E->_predecessors($g,@_): Graph::AdjacencyMap::_predecessors($E,$g,@_)}sub _all_successors {my$g=shift;my@init=@_;my%todo;@todo{@init}=@init;my%seen;my%init=%todo;my%self;while (keys%todo){my@todo=values%todo;for my$t (@todo){$seen{$t}=delete$todo{$t};for my$s ($g->successors($t)){$self{$s}=$s if exists$init{$s};$todo{$s}=$s unless exists$seen{$s}}}}for my$v (@init){delete$seen{$v}unless$g->has_edge($v,$v)|| $self{$v}}return values%seen}sub all_successors {my$g=shift;$g->expect_directed;return$g->_all_successors(@_)}sub _all_predecessors {my$g=shift;my@init=@_;my%todo;@todo{@init}=@init;my%seen;my%init=%todo;my%self;while (keys%todo){my@todo=values%todo;for my$t (@todo){$seen{$t}=delete$todo{$t};for my$p ($g->predecessors($t)){$self{$p}=$p if exists$init{$p};$todo{$p}=$p unless exists$seen{$p}}}}for my$v (@init){delete$seen{$v}unless$g->has_edge($v,$v)|| $self{$v}}return values%seen}sub all_predecessors {my$g=shift;$g->expect_directed;return$g->_all_predecessors(@_)}sub neighbours {my$g=shift;my$V=$g->[_V ];my@s=map {my@v=@{$_->[1 ]};shift@v;@v}$g->_edges_from(@_);my@p=map {my@v=@{$_->[1 ]};pop@v;@v}$g->_edges_to (@_);my%n;@n{@s }=@s;@n{@p }=@p;map {$V->_get_id_path($_)}keys%n}*neighbors=\&neighbours;sub all_neighbours {my$g=shift;my@init=@_;my@v=@init;my%n;my$o=0;while (1){my@p=$g->_all_predecessors(@v);my@s=$g->_all_successors(@v);@n{@p}=@p;@n{@s}=@s;@v=values%n;last if@v==$o;$o=@v}for my$v (@init){delete$n{$v}unless$g->has_edge($v,$v)}return values%n}*all_neighbors=\&all_neighbours;sub all_reachable {my$g=shift;$g->directed ? $g->all_successors(@_): $g->all_neighbors(@_)}sub delete_edge {my$g=shift;$g->expect_non_unionfind;my@i=$g->_vertex_ids(@_);return$g unless@i;my$i=$g->[_E ]->_get_path_id(@i);return$g unless defined$i;$g->[_E ]->_del_id($i);$g->[_G ]++;return$g}sub delete_vertex {my$g=shift;$g->expect_non_unionfind;my$V=$g->[_V ];return$g unless$V->has_path(@_);if (@_==1 &&!($g->[_f ]& (_HYPER|_REF|_UNIQ))){$g->delete_edge($_[0],$_)for$g->successors($_[0]);$g->delete_edge($_,$_[0])for$g->predecessors($_[0])}else {my$E=$g->[_E ];for my$e ($g->_edges_at(@_)){$E->_del_id($e->[0 ])}}$V->del_path(@_);$g->[_G ]++;return$g}sub get_vertex_count {my$g=shift;$g->[_V ]->_get_path_count(@_)|| 0}sub get_edge_count {my$g=shift;my@e=$g->_vertex_ids(@_);return 0 unless@e;$g->[_E ]->_get_path_count(@e)|| 0}sub delete_vertices {my$g=shift;$g->expect_non_unionfind;while (@_){my$v=shift @_;$g->delete_vertex($v)}return$g}sub delete_edges {my$g=shift;$g->expect_non_unionfind;while (@_){my ($u,$v)=splice @_,0,2;$g->delete_edge($u,$v)}return$g}sub _in_degree {my$g=shift;return undef unless @_ && $g->has_vertex(@_);my$in=0;$in += $g->get_edge_count(@$_)for$g->edges_to(@_);return$in}sub in_degree {my$g=shift;$g->_in_degree(@_)}sub _out_degree {my$g=shift;return undef unless @_ && $g->has_vertex(@_);my$out=0;$out += $g->get_edge_count(@$_)for$g->edges_from(@_);return$out}sub out_degree {my$g=shift;$g->_out_degree(@_)}sub _total_degree {my$g=shift;return undef unless @_ && $g->has_vertex(@_);$g->is_undirected ? $g->_in_degree(@_): $g-> in_degree(@_)- $g-> out_degree(@_)}sub degree {my$g=shift;if (@_){$g->_total_degree(@_)}elsif ($g->is_undirected){my$total=0;$total += $g->_total_degree($_)for$g->vertices05;return$total}else {return 0}}*vertex_degree=\°ree;sub is_sink_vertex {my$g=shift;return 0 unless @_;$g->successors(@_)==0 && $g->predecessors(@_)> 0}sub is_source_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)==0 && $g->successors(@_)> 0}sub is_successorless_vertex {my$g=shift;return 0 unless @_;$g->successors(@_)==0}sub is_predecessorless_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)==0}sub is_successorful_vertex {my$g=shift;return 0 unless @_;$g->successors(@_)> 0}sub is_predecessorful_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)> 0}sub is_isolated_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)==0 && $g->successors(@_)==0}sub is_interior_vertex {my$g=shift;return 0 unless @_;my$p=$g->predecessors(@_);my$s=$g->successors(@_);if ($g->is_self_loop_vertex(@_)){$p--;$s--}$p > 0 && $s > 0}sub is_exterior_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)==0 || $g->successors(@_)==0}sub is_self_loop_vertex {my$g=shift;return 0 unless @_;for my$s ($g->successors(@_)){return 1 if$s eq $_[0]}return 0}sub sink_vertices {my$g=shift;grep {$g->is_sink_vertex($_)}$g->vertices05}sub source_vertices {my$g=shift;grep {$g->is_source_vertex($_)}$g->vertices05}sub successorless_vertices {my$g=shift;grep {$g->is_successorless_vertex($_)}$g->vertices05}sub predecessorless_vertices {my$g=shift;grep {$g->is_predecessorless_vertex($_)}$g->vertices05}sub successorful_vertices {my$g=shift;grep {$g->is_successorful_vertex($_)}$g->vertices05}sub predecessorful_vertices {my$g=shift;grep {$g->is_predecessorful_vertex($_)}$g->vertices05}sub isolated_vertices {my$g=shift;grep {$g->is_isolated_vertex($_)}$g->vertices05}sub interior_vertices {my$g=shift;grep {$g->is_interior_vertex($_)}$g->vertices05}sub exterior_vertices {my$g=shift;grep {$g->is_exterior_vertex($_)}$g->vertices05}sub self_loop_vertices {my$g=shift;grep {$g->is_self_loop_vertex($_)}$g->vertices05}sub add_path {my$g=shift;my$u=shift;while (@_){my$v=shift;$g->add_edge($u,$v);$u=$v}return$g}sub delete_path {my$g=shift;$g->expect_non_unionfind;my$u=shift;while (@_){my$v=shift;$g->delete_edge($u,$v);$u=$v}return$g}sub has_path {my$g=shift;my$u=shift;while (@_){my$v=shift;return 0 unless$g->has_edge($u,$v);$u=$v}return$g}sub add_cycle {my$g=shift;$g->add_path(@_,$_[0])}sub delete_cycle {my$g=shift;$g->expect_non_unionfind;$g->delete_path(@_,$_[0])}sub has_cycle {my$g=shift;@_ ? ($g->has_path(@_,$_[0])? 1 : 0): 0}*has_this_cycle=\&has_cycle;sub has_a_cycle {my$g=shift;my@r=(back_edge=>\&Graph::Traversal::has_a_cycle);push@r,down_edge=>\&Graph::Traversal::has_a_cycle if$g->is_undirected;my$t=Graph::Traversal::DFS->new($g,@r,@_);$t->dfs;return$t->get_state('has_a_cycle')}sub find_a_cycle {my$g=shift;my@r=(back_edge=>\&Graph::Traversal::find_a_cycle);push@r,down_edge=>\&Graph::Traversal::find_a_cycle if$g->is_undirected;my$t=Graph::Traversal::DFS->new($g,@r,@_);$t->dfs;$t->has_state('a_cycle')? @{$t->get_state('a_cycle')}: ()}sub set_vertex_attribute {my$g=shift;$g->expect_non_multivertexed;my$value=pop;my$attr=pop;$g->add_vertex(@_)unless$g->has_vertex(@_);$g->[_V ]->_set_path_attr(@_,$attr,$value)}sub set_vertex_attribute_by_id {my$g=shift;$g->expect_multivertexed;my$value=pop;my$attr=pop;$g->add_vertex_by_id(@_)unless$g->has_vertex_by_id(@_);$g->[_V ]->_set_path_attr(@_,$attr,$value)}sub set_vertex_attributes {my$g=shift;$g->expect_non_multivertexed;my$attr=pop;$g->add_vertex(@_)unless$g->has_vertex(@_);$g->[_V ]->_set_path_attrs(@_,$attr)}sub set_vertex_attributes_by_id {my$g=shift;$g->expect_multivertexed;my$attr=pop;$g->add_vertex_by_id(@_)unless$g->has_vertex_by_id(@_);$g->[_V ]->_set_path_attrs(@_,$attr)}sub has_vertex_attributes {my$g=shift;$g->expect_non_multivertexed;return 0 unless$g->has_vertex(@_);$g->[_V ]->_has_path_attrs(@_)}sub has_vertex_attributes_by_id {my$g=shift;$g->expect_multivertexed;return 0 unless$g->has_vertex_by_id(@_);$g->[_V ]->_has_path_attrs(@_)}sub has_vertex_attribute {my$g=shift;$g->expect_non_multivertexed;my$attr=pop;return 0 unless$g->has_vertex(@_);$g->[_V ]->_has_path_attr(@_,$attr)}sub has_vertex_attribute_by_id {my$g=shift;$g->expect_multivertexed;my$attr=pop;return 0 unless$g->has_vertex_by_id(@_);$g->[_V ]->_has_path_attr(@_,$attr)}sub get_vertex_attributes {my$g=shift;$g->expect_non_multivertexed;return unless$g->has_vertex(@_);my$a=$g->[_V ]->_get_path_attrs(@_);($g->is_compat02)? (defined$a ? %{$a}: ()): $a}sub get_vertex_attributes_by_id {my$g=shift;$g->expect_multivertexed;return unless$g->has_vertex_by_id(@_);$g->[_V ]->_get_path_attrs(@_)}sub get_vertex_attribute {my$g=shift;$g->expect_non_multivertexed;my$attr=pop;return unless$g->has_vertex(@_);$g->[_V ]->_get_path_attr(@_,$attr)}sub get_vertex_attribute_by_id {my$g=shift;$g->expect_multivertexed;my$attr=pop;return unless$g->has_vertex_by_id(@_);$g->[_V ]->_get_path_attr(@_,$attr)}sub get_vertex_attribute_names {my$g=shift;$g->expect_non_multivertexed;return unless$g->has_vertex(@_);$g->[_V ]->_get_path_attr_names(@_)}sub get_vertex_attribute_names_by_id {my$g=shift;$g->expect_multivertexed;return unless$g->has_vertex_by_id(@_);$g->[_V ]->_get_path_attr_names(@_)}sub get_vertex_attribute_values {my$g=shift;$g->expect_non_multivertexed;return unless$g->has_vertex(@_);$g->[_V ]->_get_path_attr_values(@_)}sub get_vertex_attribute_values_by_id {my$g=shift;$g->expect_multivertexed;return unless$g->has_vertex_by_id(@_);$g->[_V ]->_get_path_attr_values(@_)}sub delete_vertex_attributes {my$g=shift;$g->expect_non_multivertexed;return undef unless$g->has_vertex(@_);$g->[_V ]->_del_path_attrs(@_)}sub delete_vertex_attributes_by_id {my$g=shift;$g->expect_multivertexed;return undef unless$g->has_vertex_by_id(@_);$g->[_V ]->_del_path_attrs(@_)}sub delete_vertex_attribute {my$g=shift;$g->expect_non_multivertexed;my$attr=pop;return undef unless$g->has_vertex(@_);$g->[_V ]->_del_path_attr(@_,$attr)}sub delete_vertex_attribute_by_id {my$g=shift;$g->expect_multivertexed;my$attr=pop;return undef unless$g->has_vertex_by_id(@_);$g->[_V ]->_del_path_attr(@_,$attr)}sub _set_edge_attribute {my$g=shift;my$value=pop;my$attr=pop;my$E=$g->[_E ];my$f=$E->[_f ];my@i;if ($E->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){@_=sort @_ if ($f & _UNORD);my$s=$E->[_s ];$g->add_edge(@_)unless exists$s->{$_[0]}&& exists$s->{$_[0]}->{$_[1]};@i=@{$g->[_V ]->[_s ]}{@_ }}else {$g->add_edge(@_)unless$g->has_edge(@_);@i=$g->_vertex_ids(@_)}$g->[_E ]->_set_path_attr(@i,$attr,$value)}sub set_edge_attribute {my$g=shift;$g->expect_non_multiedged;my$value=pop;my$attr=pop;my$E=$g->[_E ];$g->add_edge(@_)unless$g->has_edge(@_);$E->_set_path_attr($g->_vertex_ids(@_),$attr,$value)}sub set_edge_attribute_by_id {my$g=shift;$g->expect_multiedged;my$value=pop;my$attr=pop;my$id=pop;$g->[_E ]->_set_path_attr($g->_vertex_ids(@_),$id,$attr,$value)}sub set_edge_attributes {my$g=shift;$g->expect_non_multiedged;my$attr=pop;$g->add_edge(@_)unless$g->has_edge(@_);$g->[_E ]->_set_path_attrs($g->_vertex_ids(@_),$attr)}sub set_edge_attributes_by_id {my$g=shift;$g->expect_multiedged;my$attr=pop;$g->add_edge_by_id(@_)unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_set_path_attrs($g->_vertex_ids(@_),$id,$attr)}sub has_edge_attributes {my$g=shift;$g->expect_non_multiedged;return 0 unless$g->has_edge(@_);$g->[_E ]->_has_path_attrs($g->_vertex_ids(@_))}sub has_edge_attributes_by_id {my$g=shift;$g->expect_multiedged;return 0 unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_has_path_attrs($g->_vertex_ids(@_),$id)}sub has_edge_attribute {my$g=shift;$g->expect_non_multiedged;my$attr=pop;return 0 unless$g->has_edge(@_);$g->[_E ]->_has_path_attr($g->_vertex_ids(@_),$attr)}sub has_edge_attribute_by_id {my$g=shift;$g->expect_multiedged;my$attr=pop;return 0 unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_has_path_attr($g->_vertex_ids(@_),$id,$attr)}sub get_edge_attributes {my$g=shift;$g->expect_non_multiedged;return unless$g->has_edge(@_);my$a=$g->[_E ]->_get_path_attrs($g->_vertex_ids(@_));($g->is_compat02)? (defined$a ? %{$a}: ()): $a}sub get_edge_attributes_by_id {my$g=shift;$g->expect_multiedged;return unless$g->has_edge_by_id(@_);my$id=pop;return$g->[_E ]->_get_path_attrs($g->_vertex_ids(@_),$id)}sub _get_edge_attribute {my$g=shift;my$attr=pop;my$E=$g->[_E ];my$f=$E->[_f ];if ($E->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){@_=sort @_ if ($f & _UNORD);my$s=$E->[_s ];return unless exists$s->{$_[0]}&& exists$s->{$_[0]}->{$_[1]}}else {return unless$g->has_edge(@_)}my@i=$g->_vertex_ids(@_);$E->_get_path_attr(@i,$attr)}sub get_edge_attribute {my$g=shift;$g->expect_non_multiedged;my$attr=pop;return undef unless$g->has_edge(@_);my@i=$g->_vertex_ids(@_);return undef if@i==0 && @_;my$E=$g->[_E ];$E->_get_path_attr(@i,$attr)}sub get_edge_attribute_by_id {my$g=shift;$g->expect_multiedged;my$attr=pop;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_get_path_attr($g->_vertex_ids(@_),$id,$attr)}sub get_edge_attribute_names {my$g=shift;$g->expect_non_multiedged;return unless$g->has_edge(@_);$g->[_E ]->_get_path_attr_names($g->_vertex_ids(@_))}sub get_edge_attribute_names_by_id {my$g=shift;$g->expect_multiedged;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_get_path_attr_names($g->_vertex_ids(@_),$id)}sub get_edge_attribute_values {my$g=shift;$g->expect_non_multiedged;return unless$g->has_edge(@_);$g->[_E ]->_get_path_attr_values($g->_vertex_ids(@_))}sub get_edge_attribute_values_by_id {my$g=shift;$g->expect_multiedged;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_get_path_attr_values($g->_vertex_ids(@_),$id)}sub delete_edge_attributes {my$g=shift;$g->expect_non_multiedged;return unless$g->has_edge(@_);$g->[_E ]->_del_path_attrs($g->_vertex_ids(@_))}sub delete_edge_attributes_by_id {my$g=shift;$g->expect_multiedged;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_del_path_attrs($g->_vertex_ids(@_),$id)}sub delete_edge_attribute {my$g=shift;$g->expect_non_multiedged;my$attr=pop;return unless$g->has_edge(@_);$g->[_E ]->_del_path_attr($g->_vertex_ids(@_),$attr)}sub delete_edge_attribute_by_id {my$g=shift;$g->expect_multiedged;my$attr=pop;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_del_path_attr($g->_vertex_ids(@_),$id,$attr)}sub vertex {my$g=shift;$g->has_vertex(@_)? @_ : undef}sub out_edges {my$g=shift;return unless @_ && $g->has_vertex(@_);my@e=$g->edges_from(@_);wantarray ? map {@$_}@e : @e}sub in_edges {my$g=shift;return unless @_ && $g->has_vertex(@_);my@e=$g->edges_to(@_);wantarray ? map {@$_}@e : @e}sub add_vertices {my$g=shift;$g->add_vertex($_)for @_;return$g}sub add_edges {my$g=shift;while (@_){my$u=shift @_;if (ref$u eq 'ARRAY'){$g->add_edge(@$u)}else {if (@_){my$v=shift @_;$g->add_edge($u,$v)}else {require Carp;Carp::croak("Graph::add_edges: missing end vertex")}}}return$g}sub copy {my$g=shift;my%opt=_get_options(\@_);my$c=(ref$g)->new(map {$_=>$g->$_ ? 1 : 0}qw(directed compat02 refvertexed hypervertexed countvertexed multivertexed hyperedged countedged multiedged omniedged __stringified));for my$v ($g->isolated_vertices){$c->add_vertex($v)}for my$e ($g->edges05){$c->add_edge(@$e)}return$c}*copy_graph=\©sub _deep_copy_Storable {my$g=shift;my$safe=new Safe;local$Storable::Deparse=1;local$Storable::Eval=sub {$safe->reval($_[0])};return Storable::thaw(Storable::freeze($g))}sub _deep_copy_DataDumper {my$g=shift;my$d=Data::Dumper->new([$g]);use vars qw($VAR1);$d->Purity(1)->Terse(1)->Deepcopy(1);$d->Deparse(1)if $] >= 5.008;eval$d->Dump}sub deep_copy {if (_can_deep_copy_Storable()){return _deep_copy_Storable(@_)}else {return _deep_copy_DataDumper(@_)}}*deep_copy_graph=\&deep_copy;sub transpose_edge {my$g=shift;if ($g->is_directed){return undef unless$g->has_edge(@_);my$c=$g->get_edge_count(@_);my$a=$g->get_edge_attributes(@_);my@e=reverse @_;$g->delete_edge(@_)unless$g->has_edge(@e);$g->add_edge(@e)for 1..$c;$g->set_edge_attributes(@e,$a)if$a}return$g}sub transpose_graph {my$g=shift;my$t=$g->copy;if ($t->directed){for my$e ($t->edges05){$t->transpose_edge(@$e)}}return$t}*transpose=\&transpose_graph;sub complete_graph {my$g=shift;my$c=$g->new(directed=>$g->directed);my@v=$g->vertices05;for (my$i=0;$i <= $#v;$i++ ){for (my$j=0;$j <= $#v;$j++ ){next if$i >= $j;if ($g->is_undirected){$c->add_edge($v[$i],$v[$j])}else {$c->add_edge($v[$i],$v[$j]);$c->add_edge($v[$j],$v[$i])}}}return$c}*complement=\&complement_graph;sub complement_graph {my$g=shift;my$c=$g->new(directed=>$g->directed);my@v=$g->vertices05;for (my$i=0;$i <= $#v;$i++ ){for (my$j=0;$j <= $#v;$j++ ){next if$i >= $j;if ($g->is_undirected){$c->add_edge($v[$i],$v[$j])unless$g->has_edge($v[$i],$v[$j])}else {$c->add_edge($v[$i],$v[$j])unless$g->has_edge($v[$i],$v[$j]);$c->add_edge($v[$j],$v[$i])unless$g->has_edge($v[$j],$v[$i])}}}return$c}*complete=\&complete_graph;sub subgraph {my ($g,$src,$dst)=@_;$dst=$src unless defined$dst;unless (ref$src eq 'ARRAY' && ref$dst eq 'ARRAY'){Carp::croak("Graph::subgraph: need src and dst array references")}my$s=$g->new;my@u=grep {$g->has_vertex($_)}@$src;my@v=grep {$g->has_vertex($_)}@$dst;$s->add_vertices(@u,@v);for my$u (@u){my@e;for my$v (@v){if ($g->has_edge($u,$v)){push@e,[$u,$v]}}$s->add_edges(@e)}return$s}sub is_transitive {my$g=shift;Graph::TransitiveClosure::is_transitive($g)}my$defattr='weight';sub _defattr {return$defattr}sub add_weighted_vertex {my$g=shift;$g->expect_non_multivertexed;my$w=pop;$g->add_vertex(@_);$g->set_vertex_attribute(@_,$defattr,$w)}sub add_weighted_vertices {my$g=shift;$g->expect_non_multivertexed;while (@_){my ($v,$w)=splice @_,0,2;$g->add_vertex($v);$g->set_vertex_attribute($v,$defattr,$w)}}sub get_vertex_weight {my$g=shift;$g->expect_non_multivertexed;$g->get_vertex_attribute(@_,$defattr)}sub has_vertex_weight {my$g=shift;$g->expect_non_multivertexed;$g->has_vertex_attribute(@_,$defattr)}sub set_vertex_weight {my$g=shift;$g->expect_non_multivertexed;my$w=pop;$g->set_vertex_attribute(@_,$defattr,$w)}sub delete_vertex_weight {my$g=shift;$g->expect_non_multivertexed;$g->delete_vertex_attribute(@_,$defattr)}sub add_weighted_vertex_by_id {my$g=shift;$g->expect_multivertexed;my$w=pop;$g->add_vertex_by_id(@_);$g->set_vertex_attribute_by_id(@_,$defattr,$w)}sub add_weighted_vertices_by_id {my$g=shift;$g->expect_multivertexed;my$id=pop;while (@_){my ($v,$w)=splice @_,0,2;$g->add_vertex_by_id($v,$id);$g->set_vertex_attribute_by_id($v,$id,$defattr,$w)}}sub get_vertex_weight_by_id {my$g=shift;$g->expect_multivertexed;$g->get_vertex_attribute_by_id(@_,$defattr)}sub has_vertex_weight_by_id {my$g=shift;$g->expect_multivertexed;$g->has_vertex_attribute_by_id(@_,$defattr)}sub set_vertex_weight_by_id {my$g=shift;$g->expect_multivertexed;my$w=pop;$g->set_vertex_attribute_by_id(@_,$defattr,$w)}sub delete_vertex_weight_by_id {my$g=shift;$g->expect_multivertexed;$g->delete_vertex_attribute_by_id(@_,$defattr)}sub add_weighted_edge {my$g=shift;$g->expect_non_multiedged;if ($g->is_compat02){my$w=splice @_,1,1;$g->add_edge(@_);$g->set_edge_attribute(@_,$defattr,$w)}else {my$w=pop;$g->add_edge(@_);$g->set_edge_attribute(@_,$defattr,$w)}}sub add_weighted_edges {my$g=shift;$g->expect_non_multiedged;if ($g->is_compat02){while (@_){my ($u,$w,$v)=splice @_,0,3;$g->add_edge($u,$v);$g->set_edge_attribute($u,$v,$defattr,$w)}}else {while (@_){my ($u,$v,$w)=splice @_,0,3;$g->add_edge($u,$v);$g->set_edge_attribute($u,$v,$defattr,$w)}}}sub add_weighted_edges_by_id {my$g=shift;$g->expect_multiedged;my$id=pop;while (@_){my ($u,$v,$w)=splice @_,0,3;$g->add_edge_by_id($u,$v,$id);$g->set_edge_attribute_by_id($u,$v,$id,$defattr,$w)}}sub add_weighted_path {my$g=shift;$g->expect_non_multiedged;my$u=shift;while (@_){my ($w,$v)=splice @_,0,2;$g->add_edge($u,$v);$g->set_edge_attribute($u,$v,$defattr,$w);$u=$v}}sub get_edge_weight {my$g=shift;$g->expect_non_multiedged;$g->get_edge_attribute(@_,$defattr)}sub has_edge_weight {my$g=shift;$g->expect_non_multiedged;$g->has_edge_attribute(@_,$defattr)}sub set_edge_weight {my$g=shift;$g->expect_non_multiedged;my$w=pop;$g->set_edge_attribute(@_,$defattr,$w)}sub delete_edge_weight {my$g=shift;$g->expect_non_multiedged;$g->delete_edge_attribute(@_,$defattr)}sub add_weighted_edge_by_id {my$g=shift;$g->expect_multiedged;if ($g->is_compat02){my$w=splice @_,1,1;$g->add_edge_by_id(@_);$g->set_edge_attribute_by_id(@_,$defattr,$w)}else {my$w=pop;$g->add_edge_by_id(@_);$g->set_edge_attribute_by_id(@_,$defattr,$w)}}sub add_weighted_path_by_id {my$g=shift;$g->expect_multiedged;my$id=pop;my$u=shift;while (@_){my ($w,$v)=splice @_,0,2;$g->add_edge_by_id($u,$v,$id);$g->set_edge_attribute_by_id($u,$v,$id,$defattr,$w);$u=$v}}sub get_edge_weight_by_id {my$g=shift;$g->expect_multiedged;$g->get_edge_attribute_by_id(@_,$defattr)}sub has_edge_weight_by_id {my$g=shift;$g->expect_multiedged;$g->has_edge_attribute_by_id(@_,$defattr)}sub set_edge_weight_by_id {my$g=shift;$g->expect_multiedged;my$w=pop;$g->set_edge_attribute_by_id(@_,$defattr,$w)}sub delete_edge_weight_by_id {my$g=shift;$g->expect_multiedged;$g->delete_edge_attribute_by_id(@_,$defattr)}my%expected;@expected{qw(directed undirected acyclic)}=qw(undirected directed cyclic);sub _expected {my$exp=shift;my$got=@_ ? shift : $expected{$exp};$got=defined$got ? ", got $got" : "";if (my@caller2=caller(2)){die "$caller2[3]: expected $exp graph$got, at $caller2[1] line $caller2[2].\n"}else {my@caller1=caller(1);die "$caller1[3]: expected $exp graph$got, at $caller1[1] line $caller1[2].\n"}}sub expect_no_args {my$g=shift;return unless @_;my@caller1=caller(1);die "$caller1[3]: expected no arguments, got " .scalar @_ .", at $caller1[1] line $caller1[2]\n"}sub expect_undirected {my$g=shift;_expected('undirected')unless$g->is_undirected}sub expect_directed {my$g=shift;_expected('directed')unless$g->is_directed}sub expect_acyclic {my$g=shift;_expected('acyclic')unless$g->is_acyclic}sub expect_dag {my$g=shift;my@got;push@got,'undirected' unless$g->is_directed;push@got,'cyclic' unless$g->is_acyclic;_expected('directed acyclic',"@got")if@got}sub expect_hypervertexed {my$g=shift;_expected('hypervertexed')unless$g->is_hypervertexed}sub expect_hyperedged {my$g=shift;_expected('hyperedged')unless$g->is_hyperedged}sub expect_multivertexed {my$g=shift;_expected('multivertexed')unless$g->is_multivertexed}sub expect_non_multivertexed {my$g=shift;_expected('non-multivertexed')if$g->is_multivertexed}sub expect_non_multiedged {my$g=shift;_expected('non-multiedged')if$g->is_multiedged}sub expect_multiedged {my$g=shift;_expected('multiedged')unless$g->is_multiedged}sub expect_non_unionfind {my$g=shift;_expected('non-unionfind')if$g->has_union_find}sub _get_options {my@caller=caller(1);unless (@_==1 && ref $_[0]eq 'ARRAY'){die "$caller[3]: internal error: should be called with only one array ref argument, at $caller[1] line $caller[2].\n"}my@opt=@{$_[0]};unless (@opt % 2==0){die "$caller[3]: expected an options hash, got a non-even number of arguments, at $caller[1] line $caller[2].\n"}return@opt}sub __fisher_yates_shuffle (@) {my@a=@_;my$i=@a;while ($i--){my$j=int rand ($i+1);@a[$i,$j]=@a[$j,$i]}return@a}BEGIN {sub _shuffle(@);*_shuffle=$^P && $] < 5.009003 ? \&__fisher_yates_shuffle : \&List::Util::shuffle}sub random_graph {my$class=(@_ % 2)==0 ? 'Graph' : shift;my%opt=_get_options(\@_);my$random_edge;unless (exists$opt{vertices}&& defined$opt{vertices}){require Carp;Carp::croak("Graph::random_graph: argument 'vertices' missing or undef")}if (exists$opt{random_seed}){srand($opt{random_seed});delete$opt{random_seed}}if (exists$opt{random_edge}){$random_edge=$opt{random_edge};delete$opt{random_edge}}my@V;if (my$ref=ref$opt{vertices}){if ($ref eq 'ARRAY'){@V=@{$opt{vertices}}}else {Carp::croak("Graph::random_graph: argument 'vertices' illegal")}}else {@V=0..($opt{vertices}- 1)}delete$opt{vertices};my$V=@V;my$C=$V * ($V - 1)/ 2;my$E;if (exists$opt{edges}&& exists$opt{edges_fill}){Carp::croak("Graph::random_graph: both arguments 'edges' and 'edges_fill' specified")}$E=exists$opt{edges_fill}? $opt{edges_fill}* $C : $opt{edges};delete$opt{edges};delete$opt{edges_fill};my$g=$class->new(%opt);$g->add_vertices(@V);return$g if$V < 2;$C *= 2 if$g->directed;$E=$C / 2 unless defined$E;$E=int($E + 0.5);my$p=$E / $C;$random_edge=sub {$p}unless defined$random_edge;if ($p > 1.0 &&!($g->countedged || $g->multiedged)){require Carp;Carp::croak("Graph::random_graph: needs to be countedged or multiedged ($E > $C)")}my@V1=@V;my@V2=@V;@V1=_shuffle@V1;@V2=_shuffle@V2;LOOP: while ($E){for my$v1 (@V1){for my$v2 (@V2){next if$v1 eq $v2;my$q=$random_edge->($g,$v1,$v2,$p);if ($q && ($q==1 || rand()<= $q)&& !$g->has_edge($v1,$v2)){$g->add_edge($v1,$v2);$E--;last LOOP unless$E}}}}return$g}sub random_vertex {my$g=shift;my@V=$g->vertices05;@V[rand@V]}sub random_edge {my$g=shift;my@E=$g->edges05;@E[rand@E]}sub random_successor {my ($g,$v)=@_;my@S=$g->successors($v);@S[rand@S]}sub random_predecessor {my ($g,$v)=@_;my@P=$g->predecessors($v);@P[rand@P]}my$MST_comparator=sub {($_[0]|| 0)<=> ($_[1]|| 0)};sub _MST_attr {my$attr=shift;my$attribute=exists$attr->{attribute}? $attr->{attribute}: $defattr;my$comparator=exists$attr->{comparator}? $attr->{comparator}: $MST_comparator;return ($attribute,$comparator)}sub _MST_edges {my ($g,$attr)=@_;my ($attribute,$comparator)=_MST_attr($attr);map {$_->[1]}sort {$comparator->($a->[0],$b->[0],$a->[1],$b->[1])}map {[$g->get_edge_attribute(@$_,$attribute),$_ ]}$g->edges05}sub MST_Kruskal {my ($g,%attr)=@_;$g->expect_undirected;my$MST=Graph::Undirected->new;my$UF=Graph::UnionFind->new;for my$v ($g->vertices05){$UF->add($v)}for my$e ($g->_MST_edges(\%attr)){my ($u,$v)=@$e;my$t0=$UF->find($u);my$t1=$UF->find($v);unless ($t0 eq $t1){$UF->union($u,$v);$MST->add_edge($u,$v)}}return$MST}sub _MST_add {my ($g,$h,$HF,$r,$attr,$unseen)=@_;for my$s (grep {exists$unseen->{$_ }}$g->successors($r)){$HF->add(Graph::MSTHeapElem->new($r,$s,$g->get_edge_attribute($r,$s,$attr)))}}sub _next_alphabetic {shift;(sort keys %{$_[0]})[0]}sub _next_numeric {shift;(sort {$a <=> $b}keys %{$_[0]})[0]}sub _next_random {shift;(values %{$_[0]})[rand keys %{$_[0]}]}sub _root_opt {my$g=shift;my%opt=@_==1 ? (first_root=>$_[0]): _get_options(\@_);my%unseen;my@unseen=$g->vertices05;@unseen{@unseen }=@unseen;@unseen=_shuffle@unseen;my$r;if (exists$opt{start }){$opt{first_root }=$opt{start };$opt{next_root }=undef}if (exists$opt{get_next_root }){$opt{next_root }=$opt{get_next_root }}if (exists$opt{first_root }){if (ref$opt{first_root }eq 'CODE'){$r=$opt{first_root }->($g,\%unseen)}else {$r=$opt{first_root }}}else {$r=shift@unseen}my$next=exists$opt{next_root }? $opt{next_root }: $opt{next_alphabetic }? \&_next_alphabetic : $opt{next_numeric }? \&_next_numeric : \&_next_random;my$code=ref$next eq 'CODE';my$attr=exists$opt{attribute }? $opt{attribute }: $defattr;return (\%opt,\%unseen,\@unseen,$r,$next,$code,$attr)}sub _heap_walk {my ($g,$h,$add,$etc)=splice @_,0,4;my ($opt,$unseenh,$unseena,$r,$next,$code,$attr)=$g->_root_opt(@_);my$HF=Heap071::Fibonacci->new;while (defined$r){$add->($g,$h,$HF,$r,$attr,$unseenh,$etc);delete$unseenh->{$r };while (defined$HF->top){my$t=$HF->extract_top;if (defined$t){my ($u,$v,$w)=$t->val;if (exists$unseenh->{$v }){$h->set_edge_attribute($u,$v,$attr,$w);delete$unseenh->{$v };$add->($g,$h,$HF,$v,$attr,$unseenh,$etc)}}}return$h unless defined$next;$r=$code ? $next->($g,$unseenh): shift @$unseena;last unless defined$r}return$h}sub MST_Prim {my$g=shift;$g->expect_undirected;$g->_heap_walk(Graph::Undirected->new(),\&_MST_add,undef,@_)}*MST_Dijkstra=\&MST_Prim;*minimum_spanning_tree=\&MST_Prim;*is_cyclic=\&has_a_cycle;sub is_acyclic {my$g=shift;return!$g->is_cyclic}sub is_dag {my$g=shift;return$g->is_directed && $g->is_acyclic ? 1 : 0}*is_directed_acyclic_graph=\&is_dag;sub average_degree {my$g=shift;my$V=$g->vertices05;return$V ? $g->degree / $V : 0}sub density_limits {my$g=shift;my$V=$g->vertices05;my$M=$V * ($V - 1);$M /= 2 if$g->is_undirected;return (0.25 * $M,0.75 * $M,$M)}sub density {my$g=shift;my ($sparse,$dense,$complete)=$g->density_limits;return$complete ? $g->edges / $complete : 0}sub _attr02_012 {my ($g,$op,$ga,$va,$ea)=splice @_,0,5;if ($g->is_compat02){if (@_==0){return$ga->($g)}elsif (@_==1){return$va->($g,@_)}elsif (@_==2){return$ea->($g,@_)}else {die sprintf "$op: wrong number of arguments (%d)",scalar @_}}else {die "$op: not a compat02 graph"}}sub _attr02_123 {my ($g,$op,$ga,$va,$ea)=splice @_,0,5;if ($g->is_compat02){if (@_==1){return$ga->($g,@_)}elsif (@_==2){return$va->($g,@_[1,0])}elsif (@_==3){return$ea->($g,@_[1,2,0])}else {die sprintf "$op: wrong number of arguments (%d)",scalar @_}}else {die "$op: not a compat02 graph"}}sub _attr02_234 {my ($g,$op,$ga,$va,$ea)=splice @_,0,5;if ($g->is_compat02){if (@_==2){return$ga->($g,@_)}elsif (@_==3){return$va->($g,@_[1,0,2])}elsif (@_==4){return$ea->($g,@_[1,2,0,3])}else {die sprintf "$op: wrong number of arguments (%d)",scalar @_}}else {die "$op: not a compat02 graph"}}sub set_attribute {my$g=shift;$g->_attr02_234('set_attribute',\&Graph::set_graph_attribute,\&Graph::set_vertex_attribute,\&Graph::set_edge_attribute,@_)}sub set_attributes {my$g=shift;my$a=pop;$g->_attr02_123('set_attributes',\&Graph::set_graph_attributes,\&Graph::set_vertex_attributes,\&Graph::set_edge_attributes,$a,@_)}sub get_attribute {my$g=shift;$g->_attr02_123('get_attribute',\&Graph::get_graph_attribute,\&Graph::get_vertex_attribute,\&Graph::get_edge_attribute,@_)}sub get_attributes {my$g=shift;$g->_attr02_012('get_attributes',\&Graph::get_graph_attributes,\&Graph::get_vertex_attributes,\&Graph::get_edge_attributes,@_)}sub has_attribute {my$g=shift;return 0 unless @_;$g->_attr02_123('has_attribute',\&Graph::has_graph_attribute,\&Graph::has_vertex_attribute,\&Graph::get_edge_attribute,@_)}sub has_attributes {my$g=shift;$g->_attr02_012('has_attributes',\&Graph::has_graph_attributes,\&Graph::has_vertex_attributes,\&Graph::has_edge_attributes,@_)}sub delete_attribute {my$g=shift;$g->_attr02_123('delete_attribute',\&Graph::delete_graph_attribute,\&Graph::delete_vertex_attribute,\&Graph::delete_edge_attribute,@_)}sub delete_attributes {my$g=shift;$g->_attr02_012('delete_attributes',\&Graph::delete_graph_attributes,\&Graph::delete_vertex_attributes,\&Graph::delete_edge_attributes,@_)}sub topological_sort {my$g=shift;my%opt=_get_options(\@_);my$eic=$opt{empty_if_cyclic };my$hac;if ($eic){$hac=$g->has_a_cycle}else {$g->expect_dag}delete$opt{empty_if_cyclic };my$t=Graph::Traversal::DFS->new($g,%opt);my@s=$t->dfs;$hac ? (): reverse@s}*toposort=\&topological_sort;sub _undirected_copy_compute {my$g=shift;my$c=Graph::Undirected->new;for my$v ($g->isolated_vertices){$c->add_vertex($v)}for my$e ($g->edges05){$c->add_edge(@$e)}return$c}sub undirected_copy {my$g=shift;$g->expect_directed;return _check_cache($g,'undirected',\&_undirected_copy_compute)}*undirected_copy_graph=\&undirected_copy;sub directed_copy {my$g=shift;$g->expect_undirected;my$c=Graph::Directed->new;for my$v ($g->isolated_vertices){$c->add_vertex($v)}for my$e ($g->edges05){my@e=@$e;$c->add_edge(@e);$c->add_edge(reverse@e)}return$c}*directed_copy_graph=\&directed_copy;my%_cache_type=('connectivity'=>'_ccc','strong_connectivity'=>'_scc','biconnectivity'=>'_bcc','SPT_Dijkstra'=>'_spt_di','SPT_Bellman_Ford'=>'_spt_bf','undirected'=>'_undirected',);sub _check_cache {my ($g,$type,$code)=splice @_,0,3;my$c=$_cache_type{$type};if (defined$c){my$a=$g->get_graph_attribute($c);unless (defined$a && $a->[0 ]==$g->[_G ]){$a->[0 ]=$g->[_G ];$a->[1 ]=$code->($g,@_);$g->set_graph_attribute($c,$a)}return$a->[1 ]}else {Carp::croak("Graph: unknown cache type '$type'")}}sub _clear_cache {my ($g,$type)=@_;my$c=$_cache_type{$type};if (defined$c){$g->delete_graph_attribute($c)}else {Carp::croak("Graph: unknown cache type '$type'")}}sub connectivity_clear_cache {my$g=shift;_clear_cache($g,'connectivity')}sub strong_connectivity_clear_cache {my$g=shift;_clear_cache($g,'strong_connectivity')}sub biconnectivity_clear_cache {my$g=shift;_clear_cache($g,'biconnectivity')}sub SPT_Dijkstra_clear_cache {my$g=shift;_clear_cache($g,'SPT_Dijkstra');$g->delete_graph_attribute('SPT_Dijkstra_first_root')}sub SPT_Bellman_Ford_clear_cache {my$g=shift;_clear_cache($g,'SPT_Bellman_Ford')}sub undirected_copy_clear_cache {my$g=shift;_clear_cache($g,'undirected_copy')}sub _connected_components_compute {my$g=shift;my%cce;my%cci;my$cc=0;if ($g->has_union_find){my$UF=$g->_get_union_find();my$V=$g->[_V ];my%icce;my%icci;my$icc=0;for my$v ($g->unique_vertices){$cc=$UF->find($V->_get_path_id($v));if (defined$cc){$cce{$v }=$cc;push @{$cci{$cc }},$v}else {$icce{$v }=$icc;push @{$icci{$icc }},$v;$icc++}}if ($icc){@cce{keys%icce }=values%icce;@cci{keys%icci }=values%icci}}else {my@u=$g->unique_vertices;my%r;@r{@u }=@u;my$froot=sub {(each%r)[1]};my$nroot=sub {$cc++ if keys%r;(each%r)[1]};my$t=Graph::Traversal::DFS->new($g,first_root=>$froot,next_root=>$nroot,pre=>sub {my ($v,$t)=@_;$cce{$v }=$cc;push @{$cci{$cc }},$v;delete$r{$v }},@_);$t->dfs}return [\%cce,\%cci ]}sub _connected_components {my$g=shift;my$ccc=_check_cache($g,'connectivity',\&_connected_components_compute,@_);return @{$ccc}}sub connected_component_by_vertex {my ($g,$v)=@_;$g->expect_undirected;my ($CCE,$CCI)=$g->_connected_components();return$CCE->{$v }}sub connected_component_by_index {my ($g,$i)=@_;$g->expect_undirected;my ($CCE,$CCI)=$g->_connected_components();return defined$CCI->{$i }? @{$CCI->{$i }}: ()}sub connected_components {my$g=shift;$g->expect_undirected;my ($CCE,$CCI)=$g->_connected_components();return values %{$CCI}}sub same_connected_components {my$g=shift;$g->expect_undirected;if ($g->has_union_find){my$UF=$g->_get_union_find();my$V=$g->[_V ];my$u=shift;my$c=$UF->find($V->_get_path_id ($u));my$d;for my$v (@_){return 0 unless defined($d=$UF->find($V->_get_path_id($v)))&& $d eq $c}return 1}else {my ($CCE,$CCI)=$g->_connected_components();my$u=shift;my$c=$CCE->{$u };for my$v (@_){return 0 unless defined$CCE->{$v }&& $CCE->{$v }eq $c}return 1}}my$super_component=sub {join("+",sort @_)};sub connected_graph {my ($g,%opt)=@_;$g->expect_undirected;my$cg=Graph->new(undirected=>1);if ($g->has_union_find && $g->vertices==1){$cg->add_vertices($g->vertices)}else {my$sc_cb=exists$opt{super_component}? $opt{super_component}: $super_component;for my$cc ($g->connected_components()){my$sc=$sc_cb->(@$cc);$cg->add_vertex($sc);$cg->set_vertex_attribute($sc,'subvertices',[@$cc ])}}return$cg}sub is_connected {my$g=shift;$g->expect_undirected;my ($CCE,$CCI)=$g->_connected_components();return keys %{$CCI}==1}sub is_weakly_connected {my$g=shift;$g->expect_directed;$g->undirected_copy->is_connected(@_)}*weakly_connected=\&is_weakly_connected;sub weakly_connected_components {my$g=shift;$g->expect_directed;$g->undirected_copy->connected_components(@_)}sub weakly_connected_component_by_vertex {my$g=shift;$g->expect_directed;$g->undirected_copy->connected_component_by_vertex(@_)}sub weakly_connected_component_by_index {my$g=shift;$g->expect_directed;$g->undirected_copy->connected_component_by_index(@_)}sub same_weakly_connected_components {my$g=shift;$g->expect_directed;$g->undirected_copy->same_connected_components(@_)}sub weakly_connected_graph {my$g=shift;$g->expect_directed;$g->undirected_copy->connected_graph(@_)}sub _strongly_connected_components_compute {my$g=shift;my$t=Graph::Traversal::DFS->new($g);my@d=reverse$t->dfs;my@c;my$h=$g->transpose_graph;my$u=Graph::Traversal::DFS->new($h,next_root=>sub {my ($t,$u)=@_;my$root;while (defined($root=shift@d)){last if exists$u->{$root }}if (defined$root){push@c,[];return$root}else {return}},pre=>sub {my ($v,$t)=@_;push @{$c[-1]},$v},@_);$u->dfs;return \@c}sub _strongly_connected_components {my$g=shift;my$type='strong_connectivity';my$scc=_check_cache($g,$type,\&_strongly_connected_components_compute,@_);return defined$scc ? @$scc : ()}sub strongly_connected_components {my$g=shift;$g->expect_directed;$g->_strongly_connected_components(@_)}sub strongly_connected_component_by_vertex {my$g=shift;my$v=shift;$g->expect_directed;my@scc=$g->_strongly_connected_components(next_alphabetic=>1,@_);for (my$i=0;$i <= $#scc;$i++){for (my$j=0;$j <= $#{$scc[$i]};$j++){return$i if$scc[$i]->[$j]eq $v}}return}sub strongly_connected_component_by_index {my$g=shift;my$i=shift;$g->expect_directed;my$c=($g->_strongly_connected_components(@_))[$i ];return defined$c ? @{$c}: ()}sub same_strongly_connected_components {my$g=shift;$g->expect_directed;my@scc=$g->_strongly_connected_components(next_alphabetic=>1,@_);my@i;while (@_){my$v=shift;for (my$i=0;$i <= $#scc;$i++){for (my$j=0;$j <= $#{$scc[$i]};$j++){if ($scc[$i]->[$j]eq $v){push@i,$i;return 0 if@i > 1 && $i[-1]ne $i[0]}}}}return 1}sub is_strongly_connected {my$g=shift;$g->expect_directed;my$t=Graph::Traversal::DFS->new($g);my@d=reverse$t->dfs;my@c;my$h=$g->transpose;my$u=Graph::Traversal::DFS->new($h,next_root=>sub {my ($t,$u)=@_;my$root;while (defined($root=shift@d)){last if exists$u->{$root }}if (defined$root){unless (@{$t->{roots }}){push@c,[];return$root}else {$t->terminate;return}}else {return}},pre=>sub {my ($v,$t)=@_;push @{$c[-1]},$v},@_);$u->dfs;return @{$u->{roots }}==1 && keys %{$u->{unseen }}==0}*strongly_connected=\&is_strongly_connected;sub strongly_connected_graph {my$g=shift;my%attr=@_;$g->expect_directed;my$t=Graph::Traversal::DFS->new($g);my@d=reverse$t->dfs;my@c;my$h=$g->transpose;my$u=Graph::Traversal::DFS->new($h,next_root=>sub {my ($t,$u)=@_;my$root;while (defined($root=shift@d)){last if exists$u->{$root }}if (defined$root){push@c,[];return$root}else {return}},pre=>sub {my ($v,$t)=@_;push @{$c[-1]},$v});$u->dfs;my$sc_cb;my$hv_cb;_opt_get(\%attr,super_component=>\$sc_cb);_opt_get(\%attr,hypervertex=>\$hv_cb);_opt_unknown(\%attr);if (defined$hv_cb &&!defined$sc_cb){$sc_cb=sub {$hv_cb->([@_ ])}}unless (defined$sc_cb){$sc_cb=$super_component}my$s=Graph->new;my%c;my@s;for (my$i=0;$i < @c;$i++){my$c=$c[$i];$s->add_vertex($s[$i]=$sc_cb->(@$c));$s->set_vertex_attribute($s[$i],'subvertices',[@$c ]);for my$v (@$c){$c{$v}=$i}}my$n=@c;for my$v ($g->vertices){unless (exists$c{$v}){$c{$v}=$n;$s[$n]=$v;$n++}}for my$e ($g->edges05){my ($u,$v)=@$e;unless ($c{$u}==$c{$v}){my ($p,$q)=($s[$c{$u }],$s[$c{$v }]);$s->add_edge($p,$q)unless$s->has_edge($p,$q)}}if (my@i=$g->isolated_vertices){$s->add_vertices(map {$s[$c{$_ }]}@i)}return$s}sub _biconnectivity_out {my ($state,$u,$v)=@_;if (exists$state->{stack}){my@BC;while (@{$state->{stack}}){my$e=pop @{$state->{stack}};push@BC,$e;last if defined$u && $e->[0]eq $u && $e->[1]eq $v}if (@BC){push @{$state->{BC}},\@BC}}}sub _biconnectivity_dfs {my ($g,$u,$state)=@_;$state->{num}->{$u}=$state->{dfs}++;$state->{low}->{$u}=$state->{num}->{$u};for my$v ($g->successors($u)){unless (exists$state->{num}->{$v}){push @{$state->{stack}},[$u,$v];$state->{pred}->{$v}=$u;$state->{succ}->{$u}->{$v}++;_biconnectivity_dfs($g,$v,$state);if ($state->{low}->{$v}< $state->{low}->{$u}){$state->{low}->{$u}=$state->{low}->{$v}}if ($state->{low}->{$v}>= $state->{num}->{$u}){_biconnectivity_out($state,$u,$v)}}elsif (defined$state->{pred}->{$u}&& $state->{pred}->{$u}ne $v && $state->{num}->{$v}< $state->{num}->{$u}){push @{$state->{stack}},[$u,$v];if ($state->{num}->{$v}< $state->{low}->{$u}){$state->{low}->{$u}=$state->{num}->{$v}}}}}sub _biconnectivity_compute {my ($g)=@_;my%state;@{$state{BC}}=();@{$state{BR}}=();%{$state{V2BC}}=();%{$state{BC2V}}=();@{$state{AP}}=();$state{dfs}=0;my@u=_shuffle$g->vertices;for my$u (@u){unless (exists$state{num}->{$u}){_biconnectivity_dfs($g,$u,\%state);_biconnectivity_out(\%state);delete$state{stack}}}my$bci=0;for my$bc (@{$state{BC}}){for my$e (@$bc){for my$v (@$e){$state{V2BC}->{$v}->{$bci}++}}$bci++}for my$v ($g->vertices){unless (exists$state{V2BC}->{$v}){$state{V2BC}->{$v}->{$bci++}++}}for my$v ($g->vertices){for my$bc (keys %{$state{V2BC}->{$v}}){$state{BC2V}->{$bc}->{$v}->{$bc}++}}for my$v (keys %{$state{V2BC}}){if (keys %{$state{V2BC}->{$v}}> 1){push @{$state{AP}},$v}}for my$v (keys %{$state{BC2V}}){my@v=keys %{$state{BC2V}->{$v}};if (@v==2){push @{$state{BR}},\@v}}my@sg;for my$bc (@{$state{BC}}){my%v;my$w=Graph::Undirected->new();for my$e (@$bc){my ($u,$v)=@$e;$v{$u}++;$v{$v}++;$w->add_edge($u,$v)}push@sg,[keys%v ]}return [$state{AP},\@sg,$state{BR},$state{V2BC},]}sub biconnectivity {my$g=shift;$g->expect_undirected;my$bcc=_check_cache($g,'biconnectivity',\&_biconnectivity_compute,@_);return defined$bcc ? @$bcc : ()}sub is_biconnected {my$g=shift;my ($ap)=($g->biconnectivity(@_))[0];return$g->edges >= 2 ? @$ap==0 : undef }sub is_edge_connected {my$g=shift;my ($br)=($g->biconnectivity(@_))[2];return$g->edges >= 2 ? @$br==0 : undef}sub is_edge_separable {my$g=shift;my ($br)=($g->biconnectivity(@_))[2];return$g->edges >= 2 ? @$br > 0 : undef}sub articulation_points {my$g=shift;my ($ap)=($g->biconnectivity(@_))[0];return @$ap}*cut_vertices=\&articulation_points;sub biconnected_components {my$g=shift;my ($bc)=($g->biconnectivity(@_))[1];return @$bc}sub biconnected_component_by_index {my$g=shift;my$i=shift;my ($bc)=($g->biconnectivity(@_))[1];return$bc->[$i ]}sub biconnected_component_by_vertex {my$g=shift;my$v=shift;my ($v2bc)=($g->biconnectivity(@_))[3];return defined$v2bc->{$v }? keys %{$v2bc->{$v }}: ()}sub same_biconnected_components {my$g=shift;my$u=shift;my@u=$g->biconnected_component_by_vertex($u,@_);return 0 unless@u;my%ubc;@ubc{@u }=();while (@_){my$v=shift;my@v=$g->biconnected_component_by_vertex($v);if (@v){my%vbc;@vbc{@v }=();my$vi;for my$ui (keys%ubc){if (exists$vbc{$ui }){$vi=$ui;last}}return 0 unless defined$vi}}return 1}sub biconnected_graph {my ($g,%opt)=@_;my ($bc,$v2bc)=($g->biconnectivity,%opt)[1,3];my$bcg=Graph::Undirected->new;my$sc_cb=exists$opt{super_component}? $opt{super_component}: $super_component;for my$c (@$bc){$bcg->add_vertex(my$s=$sc_cb->(@$c));$bcg->set_vertex_attribute($s,'subvertices',[@$c ])}my%k;for my$i (0..$#$bc){my@u=@{$bc->[$i ]};my%i;@i{@u }=();for my$j (0..$#$bc){if ($i > $j){my@v=@{$bc->[$j ]};my%j;@j{@v }=();for my$u (@u){if (exists$j{$u }){unless ($k{$i }{$j }++){$bcg->add_edge($sc_cb->(@{$bc->[$i]}),$sc_cb->(@{$bc->[$j]}))}last}}}}}return$bcg}sub bridges {my$g=shift;my ($br)=($g->biconnectivity(@_))[2];return defined$br ? @$br : ()}sub _SPT_add {my ($g,$h,$HF,$r,$attr,$unseen,$etc)=@_;my$etc_r=$etc->{$r }|| 0;for my$s (grep {exists$unseen->{$_ }}$g->successors($r)){my$t=$g->get_edge_attribute($r,$s,$attr);$t=1 unless defined$t;if ($t < 0){require Carp;Carp::croak("Graph::SPT_Dijkstra: edge $r-$s is negative ($t)")}if (!defined($etc->{$s })|| ($etc_r + $t)< $etc->{$s }){my$etc_s=$etc->{$s }|| 0;$etc->{$s }=$etc_r + $t;$h->set_vertex_attribute($s,$attr,$etc->{$s });$h->set_vertex_attribute($s,'p',$r);$HF->add(Graph::SPTHeapElem->new($r,$s,$etc->{$s }))}}}sub _SPT_Dijkstra_compute {}sub SPT_Dijkstra {my$g=shift;my%opt=@_==1 ? (first_root=>$_[0]): @_;my$first_root=$opt{first_root };unless (defined$first_root){$opt{first_root }=$first_root=$g->random_vertex()}my$spt_di=$g->get_graph_attribute('_spt_di');unless (defined$spt_di && exists$spt_di->{$first_root }&& $spt_di->{$first_root }->[0 ]==$g->[_G ]){my%etc;my$sptg=$g->_heap_walk($g->new,\&_SPT_add,\%etc,%opt);$spt_di->{$first_root }=[$g->[_G ],$sptg ];$g->set_graph_attribute('_spt_di',$spt_di)}my$spt=$spt_di->{$first_root }->[1 ];$spt->set_graph_attribute('SPT_Dijkstra_root',$first_root);return$spt}*SSSP_Dijkstra=\&SPT_Dijkstra;*single_source_shortest_paths=\&SPT_Dijkstra;sub SP_Dijkstra {my ($g,$u,$v)=@_;my$sptg=$g->SPT_Dijkstra(first_root=>$u);my@path=($v);my%seen;my$V=$g->vertices;my$p;while (defined($p=$sptg->get_vertex_attribute($v,'p'))){last if exists$seen{$p};push@path,$p;$v=$p;$seen{$p}++;last if keys%seen==$V || $u eq $v}@path=()if@path && $path[-1]ne $u;return reverse@path}sub __SPT_Bellman_Ford {my ($g,$u,$v,$attr,$d,$p,$c0,$c1)=@_;return unless$c0->{$u };my$w=$g->get_edge_attribute($u,$v,$attr);$w=1 unless defined$w;if (defined$d->{$v }){if (defined$d->{$u }){if ($d->{$v }> $d->{$u }+ $w){$d->{$v }=$d->{$u }+ $w;$p->{$v }=$u;$c1->{$v }++}}}else {if (defined$d->{$u }){$d->{$v }=$d->{$u }+ $w;$p->{$v }=$u;$c1->{$v }++}}}sub _SPT_Bellman_Ford {my ($g,$opt,$unseenh,$unseena,$r,$next,$code,$attr)=@_;my%d;return unless defined$r;$d{$r }=0;my%p;my$V=$g->vertices;my%c0;$c0{$r }++;for (my$i=0;$i < $V;$i++){my%c1;for my$e ($g->edges){my ($u,$v)=@$e;__SPT_Bellman_Ford($g,$u,$v,$attr,\%d,\%p,\%c0,\%c1);if ($g->undirected){__SPT_Bellman_Ford($g,$v,$u,$attr,\%d,\%p,\%c0,\%c1)}}%c0=%c1 unless$i==$V - 1}for my$e ($g->edges){my ($u,$v)=@$e;if (defined$d{$u }&& defined$d{$v }){my$d=$g->get_edge_attribute($u,$v,$attr);if (defined$d && $d{$v }> $d{$u }+ $d){require Carp;Carp::croak("Graph::SPT_Bellman_Ford: negative cycle exists")}}}return (\%p,\%d)}sub _SPT_Bellman_Ford_compute {}sub SPT_Bellman_Ford {my$g=shift;my ($opt,$unseenh,$unseena,$r,$next,$code,$attr)=$g->_root_opt(@_);unless (defined$r){$r=$g->random_vertex();return unless defined$r}my$spt_bf=$g->get_graph_attribute('_spt_bf');unless (defined$spt_bf && exists$spt_bf->{$r }&& $spt_bf->{$r }->[0 ]==$g->[_G ]){my ($p,$d)=$g->_SPT_Bellman_Ford($opt,$unseenh,$unseena,$r,$next,$code,$attr);my$h=$g->new;for my$v (keys %$p){my$u=$p->{$v };$h->add_edge($u,$v);$h->set_edge_attribute($u,$v,$attr,$g->get_edge_attribute($u,$v,$attr));$h->set_vertex_attribute($v,$attr,$d->{$v });$h->set_vertex_attribute($v,'p',$u)}$spt_bf->{$r }=[$g->[_G ],$h ];$g->set_graph_attribute('_spt_bf',$spt_bf)}my$spt=$spt_bf->{$r }->[1 ];$spt->set_graph_attribute('SPT_Bellman_Ford_root',$r);return$spt}*SSSP_Bellman_Ford=\&SPT_Bellman_Ford;sub SP_Bellman_Ford {my ($g,$u,$v)=@_;my$sptg=$g->SPT_Bellman_Ford(first_root=>$u);my@path=($v);my%seen;my$V=$g->vertices;my$p;while (defined($p=$sptg->get_vertex_attribute($v,'p'))){last if exists$seen{$p};push@path,$p;$v=$p;$seen{$p}++;last if keys%seen==$V}return reverse@path}sub TransitiveClosure_Floyd_Warshall {my$self=shift;my$class=ref$self || $self;$self=shift unless ref$self;bless Graph::TransitiveClosure->new($self,@_),$class}*transitive_closure=\&TransitiveClosure_Floyd_Warshall;sub APSP_Floyd_Warshall {my$self=shift;my$class=ref$self || $self;$self=shift unless ref$self;bless Graph::TransitiveClosure->new($self,path=>1,@_),$class}*all_pairs_shortest_paths=\&APSP_Floyd_Warshall;sub _transitive_closure_matrix_compute {}sub transitive_closure_matrix {my$g=shift;my$tcm=$g->get_graph_attribute('_tcm');if (defined$tcm){if (ref$tcm eq 'ARRAY'){if ($tcm->[0 ]==$g->[_G ]){$tcm=$tcm->[1 ]}else {undef$tcm}}}unless (defined$tcm){my$apsp=$g->APSP_Floyd_Warshall(@_);$tcm=$apsp->get_graph_attribute('_tcm');$g->set_graph_attribute('_tcm',[$g->[_G ],$tcm ])}return$tcm}sub path_length {my$g=shift;my$tcm=$g->transitive_closure_matrix;$tcm->path_length(@_)}sub path_predecessor {my$g=shift;my$tcm=$g->transitive_closure_matrix;$tcm->path_predecessor(@_)}sub path_vertices {my$g=shift;my$tcm=$g->transitive_closure_matrix;$tcm->path_vertices(@_)}sub is_reachable {my$g=shift;my$tcm=$g->transitive_closure_matrix;$tcm->is_reachable(@_)}sub for_shortest_paths {my$g=shift;my$c=shift;my$t=$g->transitive_closure_matrix;my@v=$g->vertices;my$n=0;for my$u (@v){for my$v (@v){next unless$t->is_reachable($u,$v);$n++;$c->($t,$u,$v,$n)}}return$n}sub _minmax_path {my$g=shift;my$min;my$max;my$minp;my$maxp;$g->for_shortest_paths(sub {my ($t,$u,$v,$n)=@_;my$l=$t->path_length($u,$v);return unless defined$l;my$p;if ($u ne $v && (!defined$max || $l > $max)){$max=$l;$maxp=$p=[$t->path_vertices($u,$v)]}if ($u ne $v && (!defined$min || $l < $min)){$min=$l;$minp=$p || [$t->path_vertices($u,$v)]}});return ($min,$max,$minp,$maxp)}sub diameter {my$g=shift;my ($min,$max,$minp,$maxp)=$g->_minmax_path(@_);return defined$maxp ? (wantarray ? @$maxp : $max): undef}*graph_diameter=\&diameter;sub longest_path {my ($g,$u,$v)=@_;my$t=$g->transitive_closure_matrix;if (defined$u){if (defined$v){return wantarray ? $t->path_vertices($u,$v): $t->path_length($u,$v)}else {my$max;my@max;for my$v ($g->vertices){next if$u eq $v;my$l=$t->path_length($u,$v);if (defined$l && (!defined$max || $l > $max)){$max=$l;@max=$t->path_vertices($u,$v)}}return wantarray ? @max : $max}}else {if (defined$v){my$max;my@max;for my$u ($g->vertices){next if$u eq $v;my$l=$t->path_length($u,$v);if (defined$l && (!defined$max || $l > $max)){$max=$l;@max=$t->path_vertices($u,$v)}}return wantarray ? @max : @max - 1}else {my ($min,$max,$minp,$maxp)=$g->_minmax_path(@_);return defined$maxp ? (wantarray ? @$maxp : $max): undef}}}sub vertex_eccentricity {my ($g,$u)=@_;$g->expect_undirected;if ($g->is_connected){my$max;for my$v ($g->vertices){next if$u eq $v;my$l=$g->path_length($u,$v);if (defined$l && (!defined$max || $l > $max)){$max=$l}}return defined$max ? $max : Infinity()}else {return Infinity()}}sub shortest_path {my ($g,$u,$v)=@_;$g->expect_undirected;my$t=$g->transitive_closure_matrix;if (defined$u){if (defined$v){return wantarray ? $t->path_vertices($u,$v): $t->path_length($u,$v)}else {my$min;my@min;for my$v ($g->vertices){next if$u eq $v;my$l=$t->path_length($u,$v);if (defined$l && (!defined$min || $l < $min)){$min=$l;@min=$t->path_vertices($u,$v)}}print "min/1 = @min\n";return wantarray ? @min : $min}}else {if (defined$v){my$min;my@min;for my$u ($g->vertices){next if$u eq $v;my$l=$t->path_length($u,$v);if (defined$l && (!defined$min || $l < $min)){$min=$l;@min=$t->path_vertices($u,$v)}}print "min/2 = @min\n";return wantarray ? @min : $min}else {my ($min,$max,$minp,$maxp)=$g->_minmax_path(@_);return defined$minp ? (wantarray ? @$minp : $min): wantarray ? (): undef}}}sub radius {my$g=shift;$g->expect_undirected;my ($center,$radius)=(undef,Infinity());for my$v ($g->vertices){my$x=$g->vertex_eccentricity($v);($center,$radius)=($v,$x)if defined$x && $x < $radius}return$radius}sub center_vertices {my ($g,$delta)=@_;$g->expect_undirected;$delta=0 unless defined$delta;$delta=abs($delta);my@c;my$Inf=Infinity();my$r=$g->radius;if (defined$r && $r!=$Inf){for my$v ($g->vertices){my$e=$g->vertex_eccentricity($v);next unless defined$e && $e!=$Inf;push@c,$v if abs($e - $r)<= $delta}}return@c}*centre_vertices=\¢er_vertices;sub average_path_length {my$g=shift;my@A=@_;my$d=0;my$m=0;my$n=$g->for_shortest_paths(sub {my ($t,$u,$v,$n)=@_;my$l=$t->path_length($u,$v);if ($l){my$c=@A==0 || (@A==1 && $u eq $A[0])|| ((@A==2)&& (defined$A[0]&& $u eq $A[0])|| (defined$A[1]&& $v eq $A[1]));if ($c){$d += $l;$m++}}});return$m ? $d / $m : undef}sub is_multi_graph {my$g=shift;return 0 unless$g->is_multiedged || $g->is_countedged;my$multiedges=0;for my$e ($g->edges05){my ($u,@v)=@$e;for my$v (@v){return 0 if$u eq $v}$multiedges++ if$g->get_edge_count(@$e)> 1}return$multiedges}sub is_simple_graph {my$g=shift;return 1 unless$g->is_countedged || $g->is_multiedged;for my$e ($g->edges05){return 0 if$g->get_edge_count(@$e)> 1}return 1}sub is_pseudo_graph {my$g=shift;my$m=$g->is_countedged || $g->is_multiedged;for my$e ($g->edges05){my ($u,@v)=@$e;for my$v (@v){return 1 if$u eq $v}return 1 if$m && $g->get_edge_count($u,@v)> 1}return 0}my%_factorial=(0=>1,1=>1);sub __factorial {my$n=shift;for (my$i=2;$i <= $n;$i++){next if exists$_factorial{$i};$_factorial{$i}=$i * $_factorial{$i - 1}}$_factorial{$n}}sub _factorial {my$n=int(shift);if ($n < 0){require Carp;Carp::croak("factorial of a negative number")}__factorial($n)unless exists$_factorial{$n};return$_factorial{$n}}sub could_be_isomorphic {my ($g0,$g1)=@_;return 0 unless$g0->vertices==$g1->vertices;return 0 unless$g0->edges05==$g1->edges05;my%d0;for my$v0 ($g0->vertices){$d0{$g0->in_degree($v0)}{$g0->out_degree($v0)}++}my%d1;for my$v1 ($g1->vertices){$d1{$g1->in_degree($v1)}{$g1->out_degree($v1)}++}return 0 unless keys%d0==keys%d1;for my$da (keys%d0){return 0 unless exists$d1{$da}&& keys %{$d0{$da}}==keys %{$d1{$da}};for my$db (keys %{$d0{$da}}){return 0 unless exists$d1{$da}{$db}&& $d0{$da}{$db}==$d1{$da}{$db}}}for my$da (keys%d0){for my$db (keys %{$d0{$da}}){return 0 unless$d1{$da}{$db}==$d0{$da}{$db}}delete$d1{$da}}return 0 unless keys%d1==0;my$f=1;for my$da (keys%d0){for my$db (keys %{$d0{$da}}){$f *= _factorial(abs($d0{$da}{$db}))}}return$f}sub subgraph_by_radius {my ($g,$n,$rad)=@_;return unless defined$n && defined$rad && $rad >= 0;my$r=(ref$g)->new;if ($rad==0){return$r->add_vertex($n)}my%h;$h{1}=[[$n,$g->successors($n)]];for my$i (1..$rad){$h{$i+1}=[];for my$arr (@{$h{$i}}){my ($p,@succ)=@{$arr};for my$s (@succ){$r->add_edge($p,$s);push(@{$h{$i+1}},[$s,$g->successors($s)])if$i < $rad}}}return$r}sub clustering_coefficient {my ($g)=@_;my%clustering;my$gamma=0;for my$n ($g->vertices()){my$gamma_v=0;my@neigh=$g->successors($n);my%c;for my$u (@neigh){for my$v (@neigh){if (!$c{"$u-$v"}&& $g->has_edge($u,$v)){$gamma_v++;$c{"$u-$v"}=1;$c{"$v-$u"}=1}}}if (@neigh > 1){$clustering{$n}=$gamma_v/(@neigh * (@neigh - 1)/ 2);$gamma += $gamma_v/(@neigh * (@neigh - 1)/ 2)}else {$clustering{$n}=0}}$gamma /= $g->vertices();return wantarray ? ($gamma,%clustering): $gamma}sub betweenness {my$g=shift;my@V=$g->vertices();my%Cb;$Cb{$_}=0 for@V;for my$s (@V){my@S;my%P;$P{$_}=[]for@V;my%sigma;$sigma{$_}=0 for@V;$sigma{$s}=1;my%d;$d{$_}=-1 for@V;$d{$s}=0;my@Q;push@Q,$s;while (@Q){my$v=shift@Q;unshift@S,$v;for my$w ($g->successors($v)){if ($d{$w}< 0){push@Q,$w;$d{$w}=$d{$v}+ 1}if ($d{$w}==$d{$v}+ 1){$sigma{$w}+= $sigma{$v};push @{$P{$w}},$v}}}my%delta;$delta{$_}=0 for@V;while (@S){my$w=shift@S;for my$v (@{$P{$w}}){$delta{$v}+= $sigma{$v}/$sigma{$w}* (1 + $delta{$w})}if ($w ne $s){$Cb{$w}+= $delta{$w}}}}return%Cb}sub _dump {require Data::Dumper;my$d=Data::Dumper->new([$_[0]],[ref $_[0]]);defined wantarray ? $d->Dump : print$d->Dump}1; -GRAPH - -$fatpacked{"Graph/AdjacencyMap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMAP'; - package Graph::AdjacencyMap;use strict;require Exporter;use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);@ISA=qw(Exporter);@EXPORT_OK=qw(_COUNT _MULTI _COUNTMULTI _GEN_ID _HYPER _UNORD _UNIQ _REF _UNORDUNIQ _UNIONFIND _LIGHT _STR _REFSTR _n _f _a _i _s _p _g _u _ni _nc _na _nm);%EXPORT_TAGS=(flags=>[qw(_COUNT _MULTI _COUNTMULTI _GEN_ID _HYPER _UNORD _UNIQ _REF _UNORDUNIQ _UNIONFIND _LIGHT _STR _REFSTR)],fields=>[qw(_n _f _a _i _s _p _g _u _ni _nc _na _nm)]);sub _COUNT () {0x00000001}sub _MULTI () {0x00000002}sub _COUNTMULTI () {_COUNT|_MULTI}sub _HYPER () {0x00000004}sub _UNORD () {0x00000008}sub _UNIQ () {0x00000010}sub _REF () {0x00000020}sub _UNORDUNIQ () {_UNORD|_UNIQ}sub _UNIONFIND () {0x00000040}sub _LIGHT () {0x00000080}sub _STR () {0x00000100}sub _REFSTR () {_REF|_STR}my$_GEN_ID=0;sub _GEN_ID () {\$_GEN_ID}sub _ni () {0}sub _nc () {1}sub _na () {2}sub _nm () {3}sub _n () {0}sub _f () {1}sub _a () {2}sub _i () {3}sub _s () {4}sub _p () {5}sub _g () {6}sub _V () {2}sub _new {my$class=shift;my$map=bless [0,@_ ],$class;return$map}sub _ids {my$m=shift;return$m->[_i ]}sub has_paths {my$m=shift;return defined$m->[_i ]&& keys %{$m->[_i ]}}sub _dump {my$d=Data::Dumper->new([$_[0]],[ref $_[0]]);defined wantarray ? $d->Dump : print$d->Dump}sub _del_id {my ($m,$i)=@_;my@p=$m->_get_id_path($i);$m->del_path(@p)if@p}sub _new_node {my ($m,$n,$id)=@_;my$f=$m->[_f ];my$i=$m->[_n ]++;if (($f & _MULTI)){$id=0 if$id eq _GEN_ID;$$n=[$i,0,undef,{$id=>{}}]}elsif (($f & _COUNT)){$$n=[$i,1 ]}else {$$n=$i}return$i}sub _inc_node {my ($m,$n,$id)=@_;my$f=$m->[_f ];if (($f & _MULTI)){if ($id eq _GEN_ID){$$n->[_nc ]++ while exists $$n->[_nm ]->{$$n->[_nc ]};$id=$$n->[_nc ]}$$n->[_nm ]->{$id }={}}elsif (($f & _COUNT)){$$n->[_nc ]++}return$id}sub __get_path_node {my$m=shift;my ($p,$k);my$f=$m->[_f ];@_=sort @_ if ($f & _UNORD);if ($m->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){return unless exists$m->[_s ]->{$_[0]};$p=[$m->[_s ],$m->[_s ]->{$_[0]}];$k=[$_[0],$_[1]]}else {($p,$k)=$m->__has_path(@_)}return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return (exists$p->[-1]->{$l },$p->[-1]->{$l },$p,$k,$l)}sub set_path_by_multi_id {my$m=shift;my ($p,$k)=$m->__set_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return$m->__set_path_node($p,$l,@_)}sub get_multi_ids {my$m=shift;my$f=$m->[_f ];return ()unless ($f & _MULTI);my ($e,$n)=$m->__get_path_node(@_);return$e ? keys %{$n->[_nm ]}: ()}sub _has_path_attrs {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return keys %{$p->[-1]->{$l }->[_nm ]->{$id }}? 1 : 0}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return ref$n && $#$n==_na && keys %{$n->[_na ]}? 1 : 0}}sub _set_path_attrs {my$m=shift;my$f=$m->[_f ];my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(@_);push @_,$id if ($f & _MULTI);my ($p,$k)=$m->__set_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";$m->__set_path_node($p,$l,@_)unless exists$p->[-1]->{$l };if (($f & _MULTI)){$p->[-1]->{$l }->[_nm ]->{$id }=$attr}else {$p->[-1]->{$l }=[$p->[-1]->{$l },1 ]unless ref$p->[-1]->{$l };$p->[-1]->{$l }->[_na ]=$attr}}sub _has_path_attr {my$m=shift;my$f=$m->[_f ];my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";exists$p->[-1]->{$l }->[_nm ]->{$id }->{$attr }}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return ref$n && $#$n==_na ? exists$n->[_na ]->{$attr }: undef}}sub _set_path_attr {my$m=shift;my$f=$m->[_f ];my$val=pop;my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);my ($p,$k);$m->__attr(\@_);push @_,$id if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);if ($m->[_a ]==2 && @_==2 &&!($f & (_REF|_UNIQ|_HYPER|_UNIQ))){$m->[_s ]->{$_[0]}||= {};$p=[$m->[_s ],$m->[_s ]->{$_[0]}];$k=[$_[0],$_[1]]}else {($p,$k)=$m->__set_path(@_)}return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";$m->__set_path_node($p,$l,@_)unless exists$p->[-1]->{$l };if (($f & _MULTI)){$p->[-1]->{$l }->[_nm ]->{$id }->{$attr }=$val}else {$p->[-1]->{$l }=[$p->[-1]->{$l },1 ]unless ref$p->[-1]->{$l };$p->[-1]->{$l }->[_na ]->{$attr }=$val}return$val}sub _get_path_attrs {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";$p->[-1]->{$l }->[_nm ]->{$id }}else {my ($e,$n)=$m->__get_path_node(@_);return unless$e;return$n->[_na ]if ref$n && $#$n==_na;return}}sub _get_path_attr {my$m=shift;my$f=$m->[_f ];my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return$p->[-1]->{$l }->[_nm ]->{$id }->{$attr }}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return ref$n && $#$n==_na ? $n->[_na ]->{$attr }: undef}}sub _get_path_attr_names {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";keys %{$p->[-1]->{$l }->[_nm ]->{$id }}}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return keys %{$n->[_na ]}if ref$n && $#$n==_na;return}}sub _get_path_attr_values {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";values %{$p->[-1]->{$l }->[_nm ]->{$id }}}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return values %{$n->[_na ]}if ref$n && $#$n==_na;return}}sub _del_path_attrs {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";delete$p->[-1]->{$l }->[_nm ]->{$id };unless (keys %{$p->[-1]->{$l }->[_nm ]}|| (defined$p->[-1]->{$l }->[_na ]&& keys %{$p->[-1]->{$l }->[_na ]})){delete$p->[-1]->{$l }}}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;if (ref$n){$e=_na==$#$n && keys %{$n->[_na ]}? 1 : 0;$#$n=_na - 1;return$e}else {return 0}}}sub _del_path_attr {my$m=shift;my$f=$m->[_f ];my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";delete$p->[-1]->{$l }->[_nm ]->{$id }->{$attr };$m->_del_path_attrs(@_,$id)unless keys %{$p->[-1]->{$l }->[_nm ]->{$id }}}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;if (ref$n && $#$n==_na && exists$n->[_na ]->{$attr }){delete$n->[_na ]->{$attr };return 1}else {return 0}}}sub _is_COUNT {$_[0]->[_f ]& _COUNT}sub _is_MULTI {$_[0]->[_f ]& _MULTI}sub _is_HYPER {$_[0]->[_f ]& _HYPER}sub _is_UNORD {$_[0]->[_f ]& _UNORD}sub _is_UNIQ {$_[0]->[_f ]& _UNIQ}sub _is_REF {$_[0]->[_f ]& _REF}sub _is_STR {$_[0]->[_f ]& _STR}sub __arg {my$m=shift;my$f=$m->[_f ];my@a=@{$_[0]};if ($f & _UNIQ){my%u;if ($f & _UNORD){@u{@a }=@a;@a=values%u}else {my@u;for my$e (@a){push@u,$e if$u{$e}++==0}@a=@u}}@{$_[0]}=($f & _UNORD)? sort@a : @a}sub _successors {my$E=shift;my$g=shift;my$V=$g->[_V ];map {my@v=@{$_->[1 ]};shift@v;map {$V->_get_id_path($_)}@v}$g->_edges_from(@_)}sub _predecessors {my$E=shift;my$g=shift;my$V=$g->[_V ];if (wantarray){map {my@v=@{$_->[1 ]};pop@v;map {$V->_get_id_path($_)}@v}$g->_edges_to(@_)}else {return$g->_edges_to(@_)}}1; -GRAPH_ADJACENCYMAP - -$fatpacked{"Graph/AdjacencyMap/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMAP_HEAVY'; - package Graph::AdjacencyMap::Heavy;use strict;use Graph::AdjacencyMap qw(:flags :fields);use base 'Graph::AdjacencyMap';require overload;require Data::Dumper;sub __set_path {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);if (@_!=$m->[_a ]&&!($f & _HYPER)){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Heavy: arguments %d expected %d",scalar @_,$m->[_a ])}my$p;$p=($f & _HYPER)? (($m->[_s ]||= [])->[@_ ]||= {}): ($m->[_s ]||= {});my@p=$p;my@k;@_=sort @_ if ($m->[_f ]& _UNORD);while (@_){my$k=shift;my$q=ref$k && ($f & _REF)&& overload::Method($k,'""')? overload::StrVal($k): $k;if (@_){$p=$p->{$q }||= {};return unless$p;push@p,$p}push@k,$q}return (\@p,\@k)}sub __set_path_node {my ($m,$p,$l)=splice @_,0,3;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);unless (exists$p->[-1]->{$l }){my$i=$m->_new_node(\$p->[-1]->{$l },$id);$m->[_i ]->{defined$i ? $i : "" }=[@_ ];return defined$id ? ($id eq _GEN_ID ? $$id : $id): $i}else {return$m->_inc_node(\$p->[-1]->{$l },$id)}}sub set_path {my$m=shift;my$f=$m->[_f ];return if @_==0 &&!($f & _HYPER);if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($p,$k)=$m->__set_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return$m->__set_path_node($p,$l,@_)}sub __has_path {my$m=shift;my$f=$m->[_f ];if (@_!=$m->[_a ]&&!($f & _HYPER)){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Heavy: arguments %d expected %d",scalar @_,$m->[_a ])}if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my$p=$m->[_s ];return unless defined$p;$p=$p->[@_ ]if ($f & _HYPER);return unless defined$p;my@p=$p;my@k;while (@_){my$k=shift;my$q=ref$k && ($f & _REF)&& overload::Method($k,'""')? overload::StrVal($k): $k;if (@_){$p=$p->{$q };return unless defined$p;push@p,$p}push@k,$q}return (\@p,\@k)}sub has_path {my$m=shift;my$f=$m->[_f ];if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;return exists$p->[-1]->{defined$k->[-1]? $k->[-1]: "" }}sub has_path_by_multi_id {my$m=shift;my$f=$m->[_f ];my$id=pop;if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return exists$n->[_nm ]->{$id }}sub _get_path_node {my$m=shift;my$f=$m->[_f ];if ($m->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){@_=sort @_ if ($f & _UNORD);return unless exists$m->[_s ]->{$_[0]};my$p=[$m->[_s ],$m->[_s ]->{$_[0]}];my$k=[$_[0],$_[1]];my$l=$_[1];return (exists$p->[-1]->{$l },$p->[-1]->{$l },$p,$k,$l)}else {if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}$m->__get_path_node(@_)}}sub _get_path_id {my$m=shift;my$f=$m->[_f ];my ($e,$n);if ($m->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){@_=sort @_ if ($f & _UNORD);return unless exists$m->[_s ]->{$_[0]};my$p=$m->[_s ]->{$_[0]};$e=exists$p->{$_[1]};$n=$p->{$_[1]}}else {($e,$n)=$m->_get_path_node(@_)}return undef unless$e;return ref$n ? $n->[_ni ]: $n}sub _get_path_count {my$m=shift;my$f=$m->[_f ];my ($e,$n)=$m->_get_path_node(@_);return undef unless$e && defined$n;return ($f & _COUNT)? $n->[_nc ]: ($f & _MULTI)? scalar keys %{$n->[_nm ]}: 1}sub __attr {my$m=shift;if (@_){if (ref $_[0]&& @{$_[0]}){if (@{$_[0]}!=$m->[_a ]){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Heavy: arguments %d expected %d\n",scalar @{$_[0]},$m->[_a ])}my$f=$m->[_f ];if (@{$_[0]}> 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @{$_[0]}==2){@{$_[0]}=sort @{$_[0]}}else {$m->__arg(\@_)}}}}}sub _get_id_path {my ($m,$i)=@_;my$p=defined$i ? $m->[_i ]->{$i }: undef;return defined$p ? @$p : ()}sub del_path {my$m=shift;my$f=$m->[_f ];if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($e,$n,$p,$k,$l)=$m->__get_path_node(@_);return unless$e;my$c=($f & _COUNT)? --$n->[_nc ]: 0;if ($c==0){delete$m->[_i ]->{ref$n ? $n->[_ni ]: $n };delete$p->[-1]->{$l };while (@$p && @$k && keys %{$p->[-1]->{$k->[-1]}}==0){delete$p->[-1]->{$k->[-1]};pop @$p;pop @$k}}return 1}sub del_path_by_multi_id {my$m=shift;my$f=$m->[_f ];my$id=pop;if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($e,$n,$p,$k,$l)=$m->__get_path_node(@_);return unless$e;delete$n->[_nm ]->{$id };unless (keys %{$n->[_nm ]}){delete$m->[_i ]->{$n->[_ni ]};delete$p->[-1]->{$l };while (@$p && @$k && keys %{$p->[-1]->{$k->[-1]}}==0){delete$p->[-1]->{$k->[-1]};pop @$p;pop @$k}}return 1}sub paths {my$m=shift;return values %{$m->[_i ]}if defined$m->[_i ];wantarray ? (): 0}1; -GRAPH_ADJACENCYMAP_HEAVY - -$fatpacked{"Graph/AdjacencyMap/Light.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMAP_LIGHT'; - package Graph::AdjacencyMap::Light;use strict;use Graph::AdjacencyMap qw(:flags :fields);use base 'Graph::AdjacencyMap';use Scalar::Util qw(weaken);use Graph::AdjacencyMap::Heavy;use Graph::AdjacencyMap::Vertex;sub _V () {2}sub _E () {3}sub _F () {0}sub _new {my ($class,$graph,$flags,$arity)=@_;my$m=bless [],$class;$m->[_n ]=0;$m->[_f ]=$flags | _LIGHT;$m->[_a ]=$arity;$m->[_i ]={};$m->[_s ]={};$m->[_p ]={};$m->[_g ]=$graph;weaken$m->[_g ];return$m}sub set_path {my$m=shift;return if @_==0 &&!($m->[_f ]& _HYPER);my ($n,$f,$a,$i,$s,$p)=@$m;if ($a==2){@_=sort @_ if ($f & _UNORD)}my$e0=shift;if ($a==2){my$e1=shift;unless (exists$s->{$e0 }&& exists$s->{$e0 }->{$e1 }){$n=$m->[_n ]++;$i->{$n }=[$e0,$e1 ];$s->{$e0 }->{$e1 }=$n;$p->{$e1 }->{$e0 }=$n}}else {unless (exists$s->{$e0 }){$n=$m->[_n ]++;$s->{$e0 }=$n;$i->{$n }=$e0}}}sub has_path {my$m=shift;my ($n,$f,$a,$i,$s)=@$m;return 0 unless$a==@_;my$e;if ($a==2){@_=sort @_ if ($f & _UNORD);$e=shift;return 0 unless exists$s->{$e };$s=$s->{$e }}$e=shift;exists$s->{$e }}sub _get_path_id {my$m=shift;my ($n,$f,$a,$i,$s)=@$m;return undef unless$a==@_;my$e;if ($a==2){@_=sort @_ if ($f & _UNORD);$e=shift;return undef unless exists$s->{$e };$s=$s->{$e }}$e=shift;$s->{$e }}sub _get_path_count {my$m=shift;my ($n,$f,$a,$i,$s)=@$m;my$e;if (@_==2){@_=sort @_ if ($f & _UNORD);$e=shift;return undef unless exists$s->{$e };$s=$s->{$e }}$e=shift;return exists$s->{$e }? 1 : 0}sub has_paths {my$m=shift;my ($n,$f,$a,$i,$s)=@$m;keys %$s}sub paths {my$m=shift;my ($n,$f,$a,$i)=@$m;if (defined$i){my ($k,$v)=each %$i;if (ref$v){return values %{$i}}else {return map {[$_ ]}values %{$i}}}else {return ()}}sub _get_id_path {my$m=shift;my ($n,$f,$a,$i)=@$m;my$p=$i->{$_[0 ]};defined$p ? (ref$p eq 'ARRAY' ? @$p : $p): ()}sub del_path {my$m=shift;my ($n,$f,$a,$i,$s,$p)=@$m;if (@_==2){@_=sort @_ if ($f & _UNORD);my$e0=shift;return 0 unless exists$s->{$e0 };my$e1=shift;if (defined($n=$s->{$e0 }->{$e1 })){delete$i->{$n };delete$s->{$e0 }->{$e1 };delete$p->{$e1 }->{$e0 };delete$s->{$e0 }unless keys %{$s->{$e0 }};delete$p->{$e1 }unless keys %{$p->{$e1 }};return 1}}else {my$e=shift;if (defined($n=$s->{$e })){delete$i->{$n };delete$s->{$e };return 1}}return 0}sub __successors {my$E=shift;return wantarray ? (): 0 unless defined$E->[_s ];my$g=shift;my$V=$g->[_V ];return wantarray ? (): 0 unless defined$V && defined$V->[_s ];my$i=($V->[_f ]& _LIGHT)? $V->[_s ]->{$_[0]}: $V->_get_path_id($_[0]);return wantarray ? (): 0 unless defined$i && defined$E->[_s ]->{$i };return keys %{$E->[_s ]->{$i }}}sub _successors {my$E=shift;my$g=shift;my@s=$E->__successors($g,@_);if (($E->[_f ]& _UNORD)){push@s,$E->__predecessors($g,@_);my%s;@s{@s }=();@s=keys%s}my$V=$g->[_V ];return wantarray ? map {$V->[_i ]->{$_ }}@s : @s}sub __predecessors {my$E=shift;return wantarray ? (): 0 unless defined$E->[_p ];my$g=shift;my$V=$g->[_V ];return wantarray ? (): 0 unless defined$V && defined$V->[_s ];my$i=($V->[_f ]& _LIGHT)? $V->[_s ]->{$_[0]}: $V->_get_path_id($_[0]);return wantarray ? (): 0 unless defined$i && defined$E->[_p ]->{$i };return keys %{$E->[_p ]->{$i }}}sub _predecessors {my$E=shift;my$g=shift;my@p=$E->__predecessors($g,@_);if ($E->[_f ]& _UNORD){push@p,$E->__successors($g,@_);my%p;@p{@p }=();@p=keys%p}my$V=$g->[_V ];return wantarray ? map {$V->[_i ]->{$_ }}@p : @p}sub __attr {my$m=$_[0];my ($n,$f,$a,$i,$s,$p,$g)=@$m;my ($k,$v)=each %$i;my@V=@{$g->[_V ]};my@E=$g->edges;if (ref$v eq 'ARRAY'){@E=$g->edges;$g->[_E ]=$m=Graph::AdjacencyMap::Heavy->_new($f,2);$g->add_edges(@E)}else {$m=Graph::AdjacencyMap::Vertex->_new(($f & ~_LIGHT),1);$m->[_n ]=$V[_n ];$m->[_i ]=$V[_i ];$m->[_s ]=$V[_s ];$m->[_p ]=$V[_p ];$g->[_V ]=$m}$_[0]=$m;goto &{ref($m)."::__attr"}}sub _is_COUNT () {0}sub _is_MULTI () {0}sub _is_HYPER () {0}sub _is_UNIQ () {0}sub _is_REF () {0}1; -GRAPH_ADJACENCYMAP_LIGHT - -$fatpacked{"Graph/AdjacencyMap/Vertex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMAP_VERTEX'; - package Graph::AdjacencyMap::Vertex;use strict;use Graph::AdjacencyMap qw(:flags :fields);use base 'Graph::AdjacencyMap';use Scalar::Util qw(weaken);sub _new {my ($class,$flags,$arity)=@_;bless [0,$flags,$arity ],$class}require overload;sub __strval {my ($k,$f)=@_;ref$k && ($f & _REF)&& (($f & _STR)?!overload::Method($k,'""'): overload::Method($k,'""'))? overload::StrVal($k): $k}sub __set_path {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);if (@_!=1){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Vertex: arguments %d expected 1",scalar @_)}my$p;$p=$m->[_s ]||= {};my@p=$p;my@k;my$k=shift;my$q=__strval($k,$f);push@k,$q;return (\@p,\@k)}sub __set_path_node {my ($m,$p,$l)=splice @_,0,3;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);unless (exists$p->[-1]->{$l }){my$i=$m->_new_node(\$p->[-1]->{$l },$id);$m->[_i ]->{defined$i ? $i : "" }=$_[0]}else {$m->_inc_node(\$p->[-1]->{$l },$id)}}sub set_path {my$m=shift;my$f=$m->[_f ];my ($p,$k)=$m->__set_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";my$set=$m->__set_path_node($p,$l,@_);return$set}sub __has_path {my$m=shift;my$f=$m->[_f ];if (@_!=1){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap: arguments %d expected 1\n",scalar @_)}my$p=$m->[_s ];return unless defined$p;my@p=$p;my@k;my$k=shift;my$q=__strval($k,$f);push@k,$q;return (\@p,\@k)}sub has_path {my$m=shift;my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;return exists$p->[-1]->{defined$k->[-1]? $k->[-1]: "" }}sub has_path_by_multi_id {my$m=shift;my$id=pop;my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return exists$n->[_nm ]->{$id }}sub _get_path_id {my$m=shift;my$f=$m->[_f ];my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return ref$n ? $n->[_ni ]: $n}sub _get_path_count {my$m=shift;my$f=$m->[_f ];my ($e,$n)=$m->__get_path_node(@_);return 0 unless$e && defined$n;return ($f & _COUNT)? $n->[_nc ]: ($f & _MULTI)? scalar keys %{$n->[_nm ]}: 1}sub __attr {my$m=shift;if (@_ && ref $_[0]&& @{$_[0]}!=$m->[_a ]){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Vertex: arguments %d expected %d",scalar @{$_[0]},$m->[_a ])}}sub _get_id_path {my ($m,$i)=@_;return defined$m->[_i ]? $m->[_i ]->{$i }: undef}sub del_path {my$m=shift;my$f=$m->[_f ];my ($e,$n,$p,$k,$l)=$m->__get_path_node(@_);return unless$e;my$c=($f & _COUNT)? --$n->[_nc ]: 0;if ($c==0){delete$m->[_i ]->{ref$n ? $n->[_ni ]: $n };delete$p->[-1 ]->{$l }}return 1}sub del_path_by_multi_id {my$m=shift;my$f=$m->[_f ];my$id=pop;my ($e,$n,$p,$k,$l)=$m->__get_path_node(@_);return unless$e;delete$n->[_nm ]->{$id };unless (keys %{$n->[_nm ]}){delete$m->[_i ]->{$n->[_ni ]};delete$p->[-1]->{$l }}return 1}sub paths {my$m=shift;return map {[$_ ]}values %{$m->[_i ]}if defined$m->[_i ];wantarray ? (): 0}1; -GRAPH_ADJACENCYMAP_VERTEX - -$fatpacked{"Graph/AdjacencyMatrix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMATRIX'; - package Graph::AdjacencyMatrix;use strict;use Graph::BitMatrix;use Graph::Matrix;use base 'Graph::BitMatrix';use Graph::AdjacencyMap qw(:flags :fields);sub _V () {2}sub _E () {3}sub new {my ($class,$g,%opt)=@_;my$n;my@V=$g->vertices;my$want_distance;if (exists$opt{distance_matrix}){$want_distance=$opt{distance_matrix};delete$opt{distance_matrix}}my$d=Graph::_defattr();if (exists$opt{attribute_name}){$d=$opt{attribute_name};$want_distance++}delete$opt{attribute_name};my$want_transitive=0;if (exists$opt{is_transitive}){$want_transitive=$opt{is_transitive};delete$opt{is_transitive}}Graph::_opt_unknown(\%opt);if ($want_distance){$n=Graph::Matrix->new($g);for my$v (@V){$n->set($v,$v,0)}}my$m=Graph::BitMatrix->new($g,connect_edges=>$want_distance);if ($want_distance){my$Vi=$g->[_V]->[_i];my$Ei=$g->[_E]->[_i];my%V;@V{@V }=0 .. $#V;my$n0=$n->[0];my$n1=$n->[1];if ($g->is_undirected){for my$e (keys %{$Ei}){my ($i0,$j0)=@{$Ei->{$e }};my$i1=$V{$Vi->{$i0 }};my$j1=$V{$Vi->{$j0 }};my$u=$V[$i1 ];my$v=$V[$j1 ];$n0->[$i1 ]->[$j1 ]=$g->get_edge_attribute($u,$v,$d);$n0->[$j1 ]->[$i1 ]=$g->get_edge_attribute($v,$u,$d)}}else {for my$e (keys %{$Ei}){my ($i0,$j0)=@{$Ei->{$e }};my$i1=$V{$Vi->{$i0 }};my$j1=$V{$Vi->{$j0 }};my$u=$V[$i1 ];my$v=$V[$j1 ];$n0->[$i1 ]->[$j1 ]=$g->get_edge_attribute($u,$v,$d)}}}bless [$m,$n,[@V ]],$class}sub adjacency_matrix {my$am=shift;$am->[0]}sub distance_matrix {my$am=shift;$am->[1]}sub vertices {my$am=shift;@{$am->[2]}}sub is_adjacent {my ($m,$u,$v)=@_;$m->[0]->get($u,$v)? 1 : 0}sub distance {my ($m,$u,$v)=@_;defined$m->[1]? $m->[1]->get($u,$v): undef}1; -GRAPH_ADJACENCYMATRIX - -$fatpacked{"Graph/Attribute.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ATTRIBUTE'; - package Graph::Attribute;use strict;sub _F () {0}sub _COMPAT02 () {0x00000001}sub import {my$package=shift;my%attr=@_;my$caller=caller(0);if (exists$attr{array}){my$i=$attr{array};no strict 'refs';*{"${caller}::_get_attributes"}=sub {$_[0]->[$i ]};*{"${caller}::_set_attributes"}=sub {$_[0]->[$i ]||= {};$_[0]->[$i ]=$_[1]if @_==2;$_[0]->[$i ]};*{"${caller}::_has_attributes"}=sub {defined $_[0]->[$i ]};*{"${caller}::_delete_attributes"}=sub {undef $_[0]->[$i ];1}}elsif (exists$attr{hash}){my$k=$attr{hash};no strict 'refs';*{"${caller}::_get_attributes"}=sub {$_[0]->{$k }};*{"${caller}::_set_attributes"}=sub {$_[0]->{$k }||= {};$_[0]->{$k }=$_[1]if @_==2;$_[0]->{$k }};*{"${caller}::_has_attributes"}=sub {defined $_[0]->{$k }};*{"${caller}::_delete_attributes"}=sub {delete $_[0]->{$k }}}else {die "Graph::Attribute::import($package @_) caller $caller\n"}my@api=qw(get_attribute get_attributes set_attribute set_attributes has_attribute has_attributes delete_attribute delete_attributes get_attribute_names get_attribute_values);if (exists$attr{map}){my$map=$attr{map};for my$api (@api){my ($first,$rest)=($api =~ /^(\w+?)_(.+)/);no strict 'refs';*{"${caller}::${first}_${map}_${rest}"}=\&$api}}}sub set_attribute {my$g=shift;my$v=pop;my$a=pop;my$p=$g->_set_attributes;$p->{$a }=$v;return 1}sub set_attributes {my$g=shift;my$a=pop;my$p=$g->_set_attributes($a);return 1}sub has_attribute {my$g=shift;my$a=pop;my$p=$g->_get_attributes;$p ? exists$p->{$a }: 0}sub has_attributes {my$g=shift;$g->_get_attributes ? 1 : 0}sub get_attribute {my$g=shift;my$a=pop;my$p=$g->_get_attributes;$p ? $p->{$a }: undef}sub delete_attribute {my$g=shift;my$a=pop;my$p=$g->_get_attributes;if (defined$p){delete$p->{$a };return 1}else {return 0}}sub delete_attributes {my$g=shift;if ($g->_has_attributes){$g->_delete_attributes;return 1}else {return 0}}sub get_attribute_names {my$g=shift;my$p=$g->_get_attributes;defined$p ? keys %{$p}: ()}sub get_attribute_values {my$g=shift;my$p=$g->_get_attributes;defined$p ? values %{$p}: ()}sub get_attributes {my$g=shift;my$a=$g->_get_attributes;($g->[_F ]& _COMPAT02)? (defined$a ? %{$a}: ()): $a}1; -GRAPH_ATTRIBUTE - -$fatpacked{"Graph/BitMatrix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_BITMATRIX'; - package Graph::BitMatrix;use strict;sub _V () {2}sub _E () {3}sub _i () {3}sub _s () {4}sub new {my ($class,$g,%opt)=@_;my@V=$g->vertices;my$V=@V;my$Z="\0" x (($V + 7)/ 8);my%V;@V{@V }=0 .. $#V;my$bm=bless [[($Z)x $V ],\%V ],$class;my$bm0=$bm->[0];my$connect_edges;if (exists$opt{connect_edges}){$connect_edges=$opt{connect_edges};delete$opt{connect_edges}}$connect_edges=1 unless defined$connect_edges;Graph::_opt_unknown(\%opt);if ($connect_edges){my$Vi=$g->[_V]->[_i];my$Ei=$g->[_E]->[_i];if ($g->is_undirected){for my$e (keys %{$Ei}){my ($i0,$j0)=@{$Ei->{$e }};my$i1=$V{$Vi->{$i0 }};my$j1=$V{$Vi->{$j0 }};vec($bm0->[$i1],$j1,1)=1;vec($bm0->[$j1],$i1,1)=1}}else {for my$e (keys %{$Ei}){my ($i0,$j0)=@{$Ei->{$e }};vec($bm0->[$V{$Vi->{$i0 }}],$V{$Vi->{$j0 }},1)=1}}}return$bm}sub set {my ($m,$u,$v)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);vec($m->[0]->[$i],$j,1)=1 if defined$i && defined$j}sub unset {my ($m,$u,$v)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);vec($m->[0]->[$i],$j,1)=0 if defined$i && defined$j}sub get {my ($m,$u,$v)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);defined$i && defined$j ? vec($m->[0]->[$i],$j,1): undef}sub set_row {my ($m,$u)=splice @_,0,2;my$m0=$m->[0];my$m1=$m->[1];my$i=$m1->{$u };return unless defined$i;for my$v (@_){my$j=$m1->{$v };vec($m0->[$i],$j,1)=1 if defined$j}}sub unset_row {my ($m,$u)=splice @_,0,2;my$m0=$m->[0];my$m1=$m->[1];my$i=$m1->{$u };return unless defined$i;for my$v (@_){my$j=$m1->{$v };vec($m0->[$i],$j,1)=0 if defined$j}}sub get_row {my ($m,$u)=splice @_,0,2;my$m0=$m->[0];my$m1=$m->[1];my$i=$m1->{$u };return ()x @_ unless defined$i;my@r;for my$v (@_){my$j=$m1->{$v };push@r,defined$j ? (vec($m0->[$i],$j,1)? 1 : 0): undef}return@r}sub vertices {my ($m,$u,$v)=@_;keys %{$m->[1]}}1; -GRAPH_BITMATRIX - -$fatpacked{"Graph/Directed.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_DIRECTED'; - package Graph::Directed;use Graph;use base 'Graph';use strict;1; -GRAPH_DIRECTED - -$fatpacked{"Graph/MSTHeapElem.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_MSTHEAPELEM'; - package Graph::MSTHeapElem;use strict;use vars qw($VERSION @ISA);use Heap071::Elem;use base 'Heap071::Elem';sub new {my$class=shift;bless {u=>$_[0],v=>$_[1],w=>$_[2]},$class}sub cmp {($_[0]->{w }|| 0)<=> ($_[1]->{w }|| 0)}sub val {@{$_[0]}{qw(u v w) }}1; -GRAPH_MSTHEAPELEM - -$fatpacked{"Graph/Matrix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_MATRIX'; - package Graph::Matrix;use strict;sub new {my ($class,$g)=@_;my@V=$g->vertices;my$V=@V;my%V;@V{@V }=0 .. $#V;bless [[map {[]}0 .. $#V ],\%V ],$class}sub set {my ($m,$u,$v,$val)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);$m->[0]->[$i]->[$j]=$val}sub get {my ($m,$u,$v)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);$m->[0]->[$i]->[$j]}1; -GRAPH_MATRIX - -$fatpacked{"Graph/SPTHeapElem.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_SPTHEAPELEM'; - package Graph::SPTHeapElem;use strict;use vars qw($VERSION @ISA);use Heap071::Elem;use base 'Heap071::Elem';sub new {my$class=shift;bless {u=>$_[0],v=>$_[1],w=>$_[2]},$class}sub cmp {($_[0]->{w }|| 0)<=> ($_[1]->{w }|| 0)|| ($_[0]->{u }cmp $_[1]->{u })|| ($_[0]->{u }cmp $_[1]->{v })}sub val {@{$_[0]}{qw(u v w) }}1; -GRAPH_SPTHEAPELEM - -$fatpacked{"Graph/TransitiveClosure.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRANSITIVECLOSURE'; - package Graph::TransitiveClosure;use strict;use base 'Graph';use Graph::TransitiveClosure::Matrix;sub _G () {Graph::_G()}sub new {my ($class,$g,%opt)=@_;$g->expect_non_multiedged;%opt=(path_vertices=>1)unless%opt;my$attr=Graph::_defattr();if (exists$opt{attribute_name }){$attr=$opt{attribute_name }}$opt{reflexive }=1 unless exists$opt{reflexive };my$tcm=$g->new($opt{reflexive }? (vertices=>[$g->vertices ]): ());my$tcg=$g->get_graph_attribute('_tcg');if (defined$tcg && $tcg->[0 ]==$g->[_G ]){$tcg=$tcg->[1 ]}else {$tcg=Graph::TransitiveClosure::Matrix->new($g,%opt);$g->set_graph_attribute('_tcg',[$g->[_G ],$tcg ])}my$tcg00=$tcg->[0]->[0];my$tcg11=$tcg->[1]->[1];for my$u ($tcg->vertices){my$tcg00i=$tcg00->[$tcg11->{$u }];for my$v ($tcg->vertices){next if$u eq $v &&!$opt{reflexive };my$j=$tcg11->{$v };if (vec($tcg00i,$j,1)){my$val=$g->_get_edge_attribute($u,$v,$attr);$tcm->_set_edge_attribute($u,$v,$attr,defined$val ? $val : $u eq $v ? 0 : 1)}}}$tcm->set_graph_attribute('_tcm',$tcg);bless$tcm,$class}sub is_transitive {my$g=shift;$g->expect_no_args(@_);Graph::TransitiveClosure::Matrix::is_transitive($g)}1; -GRAPH_TRANSITIVECLOSURE - -$fatpacked{"Graph/TransitiveClosure/Matrix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRANSITIVECLOSURE_MATRIX'; - package Graph::TransitiveClosure::Matrix;use strict;use Graph::AdjacencyMatrix;use Graph::Matrix;sub _new {my ($g,$class,$opt,$want_transitive,$want_reflexive,$want_path,$want_path_vertices)=@_;my$m=Graph::AdjacencyMatrix->new($g,%$opt);my@V=$g->vertices;my$am=$m->adjacency_matrix;my$dm;my$pm;my@di;my%di;@di{@V }=0..$#V;my@ai=@{$am->[0]};my%ai=%{$am->[1]};my@pi;my%pi;unless ($want_transitive){$dm=$m->distance_matrix;@di=@{$dm->[0]};%di=%{$dm->[1]};$pm=Graph::Matrix->new($g);@pi=@{$pm->[0]};%pi=%{$pm->[1]};for my$u (@V){my$diu=$di{$u};my$aiu=$ai{$u};for my$v (@V){my$div=$di{$v};my$aiv=$ai{$v};next unless vec($ai[$aiu],$aiv,1);$di[$diu]->[$div]=$u eq $v ? 0 : 1 unless defined $di[$diu]->[$div];$pi[$diu]->[$div]=$v unless$u eq $v}}}for my$u (@V){my$diu=$di{$u};my$aiu=$ai{$u};my$didiu=$di[$diu];my$aiaiu=$ai[$aiu];for my$v (@V){my$div=$di{$v};my$aiv=$ai{$v};my$didiv=$di[$div];my$aiaiv=$ai[$aiv];if (vec($aiaiv,$aiu,1)|| ($want_reflexive && $u eq $v)){my$aivivo=$aiaiv;if ($want_transitive){if ($want_reflexive){for my$w (@V){next if$w eq $u;my$aiw=$ai{$w};return 0 if vec($aiaiu,$aiw,1)&& !vec($aiaiv,$aiw,1)}}else {$aiaiv |= $aiaiu}}else {if ($want_reflexive){$aiaiv |= $aiaiu;vec($aiaiv,$aiu,1)=1}else {$aiaiv |= $aiaiu}}if ($aiaiv ne $aivivo){$ai[$aiv]=$aiaiv;$aiaiu=$aiaiv if$u eq $v}}if ($want_path &&!$want_transitive){for my$w (@V){my$aiw=$ai{$w};next unless vec($aiaiv,$aiu,1)&& vec($aiaiu,$aiw,1);my$diw=$di{$w};my ($d0,$d1a,$d1b);if (defined$dm){$d0=$didiv->[$diw];$d1a=$didiv->[$diu]|| 1;$d1b=$didiu->[$diw]|| 1}else {$d1a=1;$d1b=1}my$d1=$d1a + $d1b;if (!defined$d0 || ($d1 < $d0)){$didiv->[$diw]=$d1;$pi[$div]->[$diw]=$pi[$div]->[$diu]if$want_path_vertices}}$didiu->[$div]=1 if$u ne $v && vec($aiaiu,$aiv,1)&& !defined$didiu->[$div]}}}return 1 if$want_transitive;my%V;@V{@V }=@V;$am->[0]=\@ai;$am->[1]=\%ai;if (defined$dm){$dm->[0]=\@di;$dm->[1]=\%di}if (defined$pm){$pm->[0]=\@pi;$pm->[1]=\%pi}bless [$am,$dm,$pm,\%V ],$class}sub new {my ($class,$g,%opt)=@_;my%am_opt=(distance_matrix=>1);if (exists$opt{attribute_name}){$am_opt{attribute_name}=$opt{attribute_name};delete$opt{attribute_name}}if ($opt{distance_matrix}){$am_opt{distance_matrix}=$opt{distance_matrix}}delete$opt{distance_matrix};if (exists$opt{path}){$opt{path_length}=$opt{path};$opt{path_vertices}=$opt{path};delete$opt{path}}my$want_path_length;if (exists$opt{path_length}){$want_path_length=$opt{path_length};delete$opt{path_length}}my$want_path_vertices;if (exists$opt{path_vertices}){$want_path_vertices=$opt{path_vertices};delete$opt{path_vertices}}my$want_reflexive;if (exists$opt{reflexive}){$want_reflexive=$opt{reflexive};delete$opt{reflexive}}my$want_transitive;if (exists$opt{is_transitive}){$want_transitive=$opt{is_transitive};$am_opt{is_transitive}=$want_transitive;delete$opt{is_transitive}}die "Graph::TransitiveClosure::Matrix::new: Unknown options: @{[map { qq['$_' => $opt{$_}]} keys %opt]}" if keys%opt;$want_reflexive=1 unless defined$want_reflexive;my$want_path=$want_path_length || $want_path_vertices;_new($g,$class,\%am_opt,$want_transitive,$want_reflexive,$want_path,$want_path_vertices)}sub has_vertices {my$tc=shift;for my$v (@_){return 0 unless exists$tc->[3]->{$v }}return 1}sub is_reachable {my ($tc,$u,$v)=@_;return undef unless$tc->has_vertices($u,$v);return 1 if$u eq $v;$tc->[0]->get($u,$v)}sub is_transitive {if (@_==1){__PACKAGE__->new($_[0],is_transitive=>1)}else {my ($tc,$u,$v)=@_;return undef unless$tc->has_vertices($u,$v);$tc->[0]->get($u,$v)}}sub vertices {my$tc=shift;values %{$tc->[3]}}sub path_length {my ($tc,$u,$v)=@_;return undef unless$tc->has_vertices($u,$v);return 0 if$u eq $v;$tc->[1]->get($u,$v)}sub path_predecessor {my ($tc,$u,$v)=@_;return undef if$u eq $v;return undef unless$tc->has_vertices($u,$v);$tc->[2]->get($u,$v)}sub path_vertices {my ($tc,$u,$v)=@_;return unless$tc->is_reachable($u,$v);return wantarray ? (): 0 if$u eq $v;my@v=($u);while ($u ne $v){last unless defined($u=$tc->path_predecessor($u,$v));push@v,$u}$tc->[2]->set($u,$v,[@v ])if@v;return@v}1; -GRAPH_TRANSITIVECLOSURE_MATRIX - -$fatpacked{"Graph/Traversal.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRAVERSAL'; - package Graph::Traversal;use strict;sub DEBUG () {0}sub reset {my$self=shift;$self->{unseen }={map {$_=>$_}$self->{graph }->vertices };$self->{seen }={};$self->{order }=[];$self->{preorder }=[];$self->{postorder }=[];$self->{roots }=[];$self->{tree }=Graph->new(directed=>$self->{graph }->directed);delete$self->{terminate }}my$see=sub {my$self=shift;$self->see};my$see_active=sub {my$self=shift;delete @{$self->{active }}{$self->see }};sub has_a_cycle {my ($u,$v,$t,$s)=@_;$s->{has_a_cycle }=1;$t->terminate}sub find_a_cycle {my ($u,$v,$t,$s)=@_;my@cycle=($u);push@cycle,$v unless$u eq $v;my$path=$t->{order };if (@$path){my$i=$#$path;while ($i >= 0 && $path->[$i ]ne $v){$i--}if ($i >= 0){unshift@cycle,@{$path}[$i+1 .. $#$path ]}}$s->{a_cycle }=\@cycle;$t->terminate}sub configure {my ($self,%attr)=@_;$self->{pre }=$attr{pre }if exists$attr{pre };$self->{post }=$attr{post }if exists$attr{post };$self->{pre_vertex }=$attr{pre_vertex }if exists$attr{pre_vertex };$self->{post_vertex }=$attr{post_vertex }if exists$attr{post_vertex };$self->{pre_edge }=$attr{pre_edge }if exists$attr{pre_edge };$self->{post_edge }=$attr{post_edge }if exists$attr{post_edge };if (exists$attr{successor }){$self->{tree_edge }=$self->{non_tree_edge }=$attr{successor }}if (exists$attr{unseen_successor }){if (exists$self->{tree_edge }){my$old_tree_edge=$self->{tree_edge };$self->{tree_edge }=sub {$old_tree_edge->(@_);$attr{unseen_successor }->(@_)}}else {$self->{tree_edge }=$attr{unseen_successor }}}if ($self->graph->multiedged || $self->graph->countedged){$self->{seen_edge }=$attr{seen_edge }if exists$attr{seen_edge };if (exists$attr{seen_successor }){$self->{seen_edge }=$attr{seen_edge }}}$self->{non_tree_edge }=$attr{non_tree_edge }if exists$attr{non_tree_edge };$self->{pre_edge }=$attr{tree_edge }if exists$attr{tree_edge };$self->{back_edge }=$attr{back_edge }if exists$attr{back_edge };$self->{down_edge }=$attr{down_edge }if exists$attr{down_edge };$self->{cross_edge }=$attr{cross_edge }if exists$attr{cross_edge };if (exists$attr{start }){$attr{first_root }=$attr{start };$attr{next_root }=undef}if (exists$attr{get_next_root }){$attr{next_root }=$attr{get_next_root }}$self->{next_root }=exists$attr{next_root }? $attr{next_root }: $attr{next_alphabetic }? \&Graph::_next_alphabetic : $attr{next_numeric }? \&Graph::_next_numeric : \&Graph::_next_random;$self->{first_root }=exists$attr{first_root }? $attr{first_root }: exists$attr{next_root }? $attr{next_root }: $attr{next_alphabetic }? \&Graph::_next_alphabetic : $attr{next_numeric }? \&Graph::_next_numeric : \&Graph::_next_random;$self->{next_successor }=exists$attr{next_successor }? $attr{next_successor }: $attr{next_alphabetic }? \&Graph::_next_alphabetic : $attr{next_numeric }? \&Graph::_next_numeric : \&Graph::_next_random;if (exists$attr{has_a_cycle }){my$has_a_cycle=ref$attr{has_a_cycle }eq 'CODE' ? $attr{has_a_cycle }: \&has_a_cycle;$self->{back_edge }=$has_a_cycle;if ($self->{graph }->is_undirected){$self->{down_edge }=$has_a_cycle}}if (exists$attr{find_a_cycle }){my$find_a_cycle=ref$attr{find_a_cycle }eq 'CODE' ? $attr{find_a_cycle }: \&find_a_cycle;$self->{back_edge }=$find_a_cycle;if ($self->{graph }->is_undirected){$self->{down_edge }=$find_a_cycle}}$self->{add }=\&add_order;$self->{see }=$see;delete@attr{qw(pre post pre_edge post_edge successor unseen_successor seen_successor tree_edge non_tree_edge back_edge down_edge cross_edge seen_edge start get_next_root next_root next_alphabetic next_numeric next_random next_successor first_root has_a_cycle find_a_cycle) };if (keys%attr){require Carp;my@attr=sort keys%attr;Carp::croak(sprintf "Graph::Traversal: unknown attribute%s @{[map { qq['$_'] } @attr]}\n",@attr==1 ? '' : 's')}}sub new {my$class=shift;my$g=shift;unless (ref$g && $g->isa('Graph')){require Carp;Carp::croak("Graph::Traversal: first argument is not a Graph")}my$self={graph=>$g,state=>{}};bless$self,$class;$self->reset;$self->configure(@_);return$self}sub terminate {my$self=shift;$self->{terminate }=1}sub add_order {my ($self,@next)=@_;push @{$self->{order }},@next}sub visit {my ($self,@next)=@_;delete @{$self->{unseen }}{@next };print "unseen = @{[sort keys %{$self->{unseen}}]}\n" if DEBUG;@{$self->{seen }}{@next }=@next;print "seen = @{[sort keys %{$self->{seen}}]}\n" if DEBUG;$self->{add }->($self,@next);print "order = @{$self->{order}}\n" if DEBUG;if (exists$self->{pre }){my$p=$self->{pre };for my$v (@next){$p->($v,$self)}}}sub visit_preorder {my ($self,@next)=@_;push @{$self->{preorder }},@next;for my$v (@next){$self->{preordern }->{$v }=$self->{preorderi }++}print "preorder = @{$self->{preorder}}\n" if DEBUG;$self->visit(@next)}sub visit_postorder {my ($self)=@_;my@post=reverse$self->{see }->($self);push @{$self->{postorder }},@post;for my$v (@post){$self->{postordern }->{$v }=$self->{postorderi }++}print "postorder = @{$self->{postorder}}\n" if DEBUG;if (exists$self->{post }){my$p=$self->{post };for my$v (@post){$p->($v,$self)}}if (exists$self->{post_edge }){my$p=$self->{post_edge };my$u=$self->current;if (defined$u){for my$v (@post){$p->($u,$v,$self,$self->{state })}}}}sub _callbacks {my ($self,$current,@all)=@_;return unless@all;my$nontree=$self->{non_tree_edge };my$back=$self->{back_edge };my$down=$self->{down_edge };my$cross=$self->{cross_edge };my$seen=$self->{seen_edge };my$bdc=defined$back || defined$down || defined$cross;if (defined$nontree || $bdc || defined$seen){my$u=$current;my$preu=$self->{preordern }->{$u };my$postu=$self->{postordern }->{$u };for my$v (@all){my$e=$self->{tree }->has_edge($u,$v);if (!$e && (defined$nontree || $bdc)){if (exists$self->{seen }->{$v }){$nontree->($u,$v,$self,$self->{state })if$nontree;if ($bdc){my$postv=$self->{postordern }->{$v };if ($back && (!defined$postv || $postv >= $postu)){$back ->($u,$v,$self,$self->{state })}else {my$prev=$self->{preordern }->{$v };if ($down && $prev > $preu){$down ->($u,$v,$self,$self->{state })}elsif ($cross && $prev < $preu){$cross->($u,$v,$self,$self->{state })}}}}}if ($seen){my$c=$self->graph->get_edge_count($u,$v);while ($c-- > 1){$seen->($u,$v,$self,$self->{state })}}}}}sub next {my$self=shift;return undef if$self->{terminate };my@next;while ($self->seeing){my$current=$self->current;print "current = $current\n" if DEBUG;@next=$self->{graph }->successors($current);print "next.0 - @next\n" if DEBUG;my%next;@next{@next }=@next;print "next.1 - @next\n" if DEBUG;@next=values%next;my@all=@next;print "all = @all\n" if DEBUG;for my$s (keys%next){delete$next{$s}if exists$self->{seen}->{$s}}@next=values%next;print "next.2 - @next\n" if DEBUG;if (@next){@next=$self->{next_successor }->($self,\%next);print "next.3 - @next\n" if DEBUG;for my$v (@next){$self->{tree }->add_edge($current,$v)}if (exists$self->{pre_edge }){my$p=$self->{pre_edge };my$u=$self->current;for my$v (@next){$p->($u,$v,$self,$self->{state })}}last}else {$self->visit_postorder}return undef if$self->{terminate };$self->_callbacks($current,@all)}print "next.4 - @next\n" if DEBUG;unless (@next){unless (@{$self->{roots }}){my$first=$self->{first_root };if (defined$first){@next=ref$first eq 'CODE' ? $self->{first_root }->($self,$self->{unseen }): $first;return unless@next}}unless (@next){return unless defined$self->{next_root };return unless@next=$self->{next_root }->($self,$self->{unseen })}return if exists$self->{seen }->{$next[0]};print "next.5 - @next\n" if DEBUG;push @{$self->{roots }},$next[0]}print "next.6 - @next\n" if DEBUG;if (@next){$self->visit_preorder(@next)}return$next[0]}sub _order {my ($self,$order)=@_;1 while defined$self->next;my$wantarray=wantarray;if ($wantarray){@{$self->{$order }}}elsif (defined$wantarray){shift @{$self->{$order }}}}sub preorder {my$self=shift;$self->_order('preorder')}sub postorder {my$self=shift;$self->_order('postorder')}sub unseen {my$self=shift;values %{$self->{unseen }}}sub seen {my$self=shift;values %{$self->{seen }}}sub seeing {my$self=shift;@{$self->{order }}}sub roots {my$self=shift;@{$self->{roots }}}sub is_root {my ($self,$v)=@_;for my$u (@{$self->{roots }}){return 1 if$u eq $v}return 0}sub tree {my$self=shift;$self->{tree }}sub graph {my$self=shift;$self->{graph }}sub vertex_by_postorder {my ($self,$i)=@_;exists$self->{postorder }&& $self->{postorder }->[$i ]}sub postorder_by_vertex {my ($self,$v)=@_;exists$self->{postordern }&& $self->{postordern }->{$v }}sub postorder_vertices {my ($self,$v)=@_;exists$self->{postordern }? %{$self->{postordern }}: ()}sub vertex_by_preorder {my ($self,$i)=@_;exists$self->{preorder }&& $self->{preorder }->[$i ]}sub preorder_by_vertex {my ($self,$v)=@_;exists$self->{preordern }&& $self->{preordern }->{$v }}sub preorder_vertices {my ($self,$v)=@_;exists$self->{preordern }? %{$self->{preordern }}: ()}sub has_state {my ($self,$var)=@_;exists$self->{state }&& exists$self->{state }->{$var }}sub get_state {my ($self,$var)=@_;exists$self->{state }? $self->{state }->{$var }: undef}sub set_state {my ($self,$var,$val)=@_;$self->{state }->{$var }=$val;return 1}sub delete_state {my ($self,$var)=@_;delete$self->{state }->{$var };delete$self->{state }unless keys %{$self->{state }};return 1}1; -GRAPH_TRAVERSAL - -$fatpacked{"Graph/Traversal/BFS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRAVERSAL_BFS'; - package Graph::Traversal::BFS;use strict;use Graph::Traversal;use base 'Graph::Traversal';sub current {my$self=shift;$self->{order }->[0 ]}sub see {my$self=shift;shift @{$self->{order }}}*bfs=\&Graph::Traversal::postorder;1; -GRAPH_TRAVERSAL_BFS - -$fatpacked{"Graph/Traversal/DFS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRAVERSAL_DFS'; - package Graph::Traversal::DFS;use strict;use Graph::Traversal;use base 'Graph::Traversal';sub current {my$self=shift;$self->{order }->[-1 ]}sub see {my$self=shift;pop @{$self->{order }}}*dfs=\&Graph::Traversal::postorder;1; -GRAPH_TRAVERSAL_DFS - -$fatpacked{"Graph/Undirected.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_UNDIRECTED'; - package Graph::Undirected;use Graph;use base 'Graph';use strict;sub new {my$class=shift;bless Graph->new(undirected=>1,@_),ref$class || $class}1; -GRAPH_UNDIRECTED - -$fatpacked{"Graph/UnionFind.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_UNIONFIND'; - package Graph::UnionFind;use strict;sub _PARENT () {0}sub _RANK () {1}sub new {my$class=shift;bless {},$class}sub add {my ($self,$elem)=@_;$self->{$elem }=[$elem,0 ]unless defined$self->{$elem}}sub has {my ($self,$elem)=@_;exists$self->{$elem }}sub _parent {return undef unless defined $_[1];if (@_==2){exists $_[0]->{$_[1 ]}? $_[0]->{$_[1]}->[_PARENT ]: undef}elsif (@_==3){$_[0]->{$_[1]}->[_PARENT ]=$_[2]}else {require Carp;Carp::croak(__PACKAGE__ ."::_parent: bad arity")}}sub _rank {return unless defined $_[1];if (@_==2){exists $_[0]->{$_[1]}? $_[0]->{$_[1]}->[_RANK ]: undef}elsif (@_==3){$_[0]->{$_[1]}->[_RANK ]=$_[2]}else {require Carp;Carp::croak(__PACKAGE__ ."::_rank: bad arity")}}sub find {my ($self,$x)=@_;my$px=$self->_parent($x);return unless defined$px;$self->_parent($x,$self->find($px))if$px ne $x;$self->_parent($x)}sub union {my ($self,$x,$y)=@_;$self->add($x)unless$self->has($x);$self->add($y)unless$self->has($y);my$px=$self->find($x);my$py=$self->find($y);return if$px eq $py;my$rx=$self->_rank($px);my$ry=$self->_rank($py);if ($rx > $ry){$self->_parent($py,$px)}else {$self->_parent($px,$py);$self->_rank($py,$ry + 1)if$rx==$ry}}sub same {my ($uf,$u,$v)=@_;my$fu=$uf->find($u);return undef unless defined$fu;my$fv=$uf->find($v);return undef unless defined$fv;$fu eq $fv}1; -GRAPH_UNIONFIND - -$fatpacked{"Heap071/Elem.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HEAP071_ELEM'; - package Heap071::Elem;use strict;use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);require Exporter;require AutoLoader;@ISA=qw(Exporter AutoLoader);@EXPORT=();sub new {my$self=shift;my$class=ref($self)|| $self;return bless {heap=>undef,@_ },$class}sub heap {my$self=shift;@_ ? ($self->{heap}=shift): $self->{heap}}sub cmp {die "This cmp method must be superceded by one that knows how to compare elements."}1; -HEAP071_ELEM - -$fatpacked{"Heap071/Fibonacci.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HEAP071_FIBONACCI'; - package Heap071::Fibonacci;use strict;use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);require Exporter;require AutoLoader;@ISA=qw(Exporter AutoLoader);@EXPORT=();my$debug=0;my$validate=0;sub debug {@_ ? ($debug=shift): $debug}sub validate {@_ ? ($validate=shift): $validate}my$width=3;my$bar=' | ';my$corner=' +-';my$vfmt="%3d";sub set_width {$width=shift;$width=2 if$width < 2;$vfmt="%${width}d";$bar=$corner=' ' x $width;substr($bar,-2,1)='|';substr($corner,-2,2)='+-'}sub hdump;sub hdump {my$el=shift;my$l1=shift;my$b=shift;my$ch;my$ch1;unless($el){print$l1,"\n";return}hdump$ch1=$el->{child},$l1 .sprintf($vfmt,$el->{val}->val),$b .$bar;if($ch1){for($ch=$ch1->{right};$ch!=$ch1;$ch=$ch->{right}){hdump$ch,$b .$corner,$b .$bar}}}sub heapdump {my$h;while($h=shift){my$top=$$h or last;my$el=$top;do {hdump$el,sprintf("%02d: ",$el->{degree}),' ';$el=$el->{right}}until$el==$top;print "\n"}}sub bhcheck;sub bhcheck {my$el=shift;my$p=shift;my$cur=$el;my$prev;my$ch;do {$prev=$cur;$cur=$cur->{right};die "bad back link" unless$cur->{left}==$prev;die "bad parent link" unless (defined$p && defined$cur->{p}&& $cur->{p}==$p)|| (!defined$p &&!defined$cur->{p});die "bad degree( $cur->{degree} > $p->{degree} )" if$p && $p->{degree}<= $cur->{degree};die "not heap ordered" if$p && $p->{val}->cmp($cur->{val})> 0;$ch=$cur->{child}and bhcheck$ch,$cur}until$cur==$el}sub heapcheck {my$h;my$el;while($h=shift){heapdump$h if$validate >= 2;$el=$$h and bhcheck$el,undef}}sub ascending_cut;sub elem;sub elem_DESTROY;sub link_to_left_of;sub new {my$self=shift;my$class=ref($self)|| $self;my$h=undef;bless \$h,$class}sub DESTROY {my$h=shift;elem_DESTROY $$h}sub add {my$h=shift;my$v=shift;$validate && do {die "Method 'heap' required for element on heap" unless$v->can('heap');die "Method 'cmp' required for element on heap" unless$v->can('cmp')};my$el=elem$v;my$top;if(!($top=$$h)){$$h=$el}else {link_to_left_of$top->{left},$el ;link_to_left_of$el,$top;$$h=$el if$v->cmp($top->{val})< 0}}sub top {my$h=shift;$$h && $$h->{val}}*minimum=\⊤sub extract_top {my$h=shift;my$el=$$h or return undef;my$ltop=$el->{left};my$cur;my$next;if($cur=$el->{child}){my$first=$cur;do {$cur->{p}=undef}until ($cur=$cur->{right})==$first;$cur=$cur->{left};link_to_left_of$ltop,$first;link_to_left_of$cur,$el}if($el->{right}==$el){$$h=undef}else {link_to_left_of$el->{left},$$h=$el->{right};$h->consolidate}my$top=$el->{val};$top->heap(undef);$el->{left}=$el->{right}=$el->{p}=$el->{child}=$el->{val}=undef;$top}*extract_minimum=\&extract_top;sub absorb {my$h=shift;my$h2=shift;my$el=$$h;unless($el){$$h=$$h2;$$h2=undef;return$h}my$el2=$$h2 or return$h;my$el2l=$el2->{left};link_to_left_of$el->{left},$el2;link_to_left_of$el2l,$el;$$h=$el2 if$el->{val}->cmp($el2->{val})> 0;$$h2=undef;$h}sub decrease_key {my$h=shift;my$top=$$h;my$v=shift;my$el=$v->heap or return undef;my$p;$$h=$el if$top->{val}->cmp($v)> 0;if($p=$el->{p}and $v->cmp($p->{val})< 0){ascending_cut$top,$p,$el}$v}sub delete {my$h=shift;my$v=shift;my$el=$v->heap or return undef;my$p;$p=$el->{p}and ascending_cut $$h,$p,$el;$$h=$el;$h->extract_top}sub elem {my$v=shift;my$el=undef;$el={p=>undef,degree=>0,mark=>0,child=>undef,val=>$v,left=>undef,right=>undef,};$el->{left}=$el->{right}=$el;$v->heap($el);$el}sub elem_DESTROY {my$el=shift;my$ch;my$next;$el->{left}->{right}=undef;while($el){$ch=$el->{child}and elem_DESTROY$ch;$next=$el->{right};defined$el->{val}and $el->{val}->heap(undef);$el->{child}=$el->{right}=$el->{left}=$el->{p}=$el->{val}=undef;$el=$next}}sub link_to_left_of {my$l=shift;my$r=shift;$l->{right}=$r;$r->{left}=$l}sub link_as_parent_of {my$p=shift;my$c=shift;my$pc;if($pc=$p->{child}){link_to_left_of$pc->{left},$c;link_to_left_of$c,$pc}else {link_to_left_of$c,$c}$p->{child}=$c;$c->{p}=$p;$p->{degree}++;$c->{mark}=0;$p}sub consolidate {my$h=shift;my$cur;my$this;my$next=$$h;my$last=$next->{left};my@a;do {$this=$cur=$next;$next=$cur->{right};my$d=$cur->{degree};my$alt;while($alt=$a[$d]){($cur,$alt)=($alt,$cur)if$cur->{val}->cmp($alt->{val})> 0;link_to_left_of$alt->{left},$alt->{right};link_as_parent_of$cur,$alt;$$h=$cur;$a[$d]=undef;++$d}$a[$d]=$cur}until$this==$last;$cur=$$h;for$cur (grep defined,@a){$$h=$cur if $$h->{val}->cmp($cur->{val})> 0}}sub ascending_cut {my$top=shift;my$p=shift;my$el=shift;while(1){if(--$p->{degree}){my$l=$el->{left};$p->{child}=$l;link_to_left_of$l,$el->{right}}else {$p->{child}=undef}link_to_left_of$top->{left},$el;link_to_left_of$el,$top;$el->{p}=undef;$el->{mark}=0;$el=$p;last unless$p=$el->{p};$el->{mark}=1,last unless$el->{mark}}}1; -HEAP071_FIBONACCI - -$fatpacked{"Igor/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_CLI'; - package Igor::CLI; +$fatpacked{"App/Igor/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_CLI'; + package App::Igor::CLI; use warnings; use strict; @@ -282,10 +22,10 @@ $fatpacked{"Igor/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_C use Const::Fast; use Data::Dumper; use Getopt::Long::Subcommand; - use Igor::Config; - use Igor::Repository; - use Igor::Package; - use Igor::Util qw(colored); + use App::Igor::Config; + use App::Igor::Repository; + use App::Igor::Package; + use App::Igor::Util qw(colored); use Try::Tiny; use Pod::Usage; @@ -335,7 +75,7 @@ $fatpacked{"Igor/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_C my $task = $opts->{task}; return $task if defined $task; - my $identifier = Igor::Util::guess_identifier; + my $identifier = App::Igor::Util::guess_identifier; my @tasks = grep { my $re = $cfgs->{$_}->{pattern} // $_; $identifier =~ /$re/ @@ -451,7 +191,7 @@ $fatpacked{"Igor/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_C $Log::ger::Output::Screen::colors{20} = "\e[0;31m"; # Parse the configfile - my $config = Igor::Config::from_file($opts->{configfile}); + my $config = App::Igor::Config::from_file($opts->{configfile}); # Determine the task to run my $task = find_task($opts, $config->configurations); @@ -507,6 +247,7 @@ $fatpacked{"Igor/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_C # Run the factors defined in the configuration push @transactions, @{$config->build_factor_transactions($effective_configuration->{factors})}; + push @transactions, @{$config->build_vault_transactions($effective_configuration->{vaults}, $effective_configuration->{merger}, $effective_configuration->{cachedirectory})}; # Make sure they are ordered correctly: @transactions = sort {$a->order cmp $b->order} @transactions; @@ -583,10 +324,10 @@ $fatpacked{"Igor/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_C } 1; -IGOR_CLI +APP_IGOR_CLI -$fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_CONFIG'; - package Igor::Config; +$fatpacked{"App/Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_CONFIG'; + package App::Igor::Config; use strict; use warnings; @@ -599,14 +340,14 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO use Data::Dumper; use Data::Diver; use Graph; - use Igor::Merge; - use Igor::Repository; - use Igor::Util; + use App::Igor::Merge; + use App::Igor::Repository; + use App::Igor::Util; use List::Util qw(reduce); use Log::ger; use Path::Tiny; use Try::Tiny; - use Types::Standard qw(Any ArrayRef Dict HashRef Map Optional Str); + use Types::Standard qw(Any ArrayRef Bool Dict HashRef Map Optional Str); use Storable qw(dclone); # Config file Schemata for TOML validation @@ -623,17 +364,25 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO path => Str, type => Optional[Str], ]; + my $vaultschema = Dict [ + path => Str, + command => Str, + cacheable => Optional[Bool], + type => Optional[Str], + ]; my $mergers = Map[Str, Str]; my $configurationschema = Dict[ - mergers => Optional[$mergers], - mergeconfig => Optional[HashRef], - dependencies => Optional[ArrayRef[Str]], - packages => Optional[ArrayRef[$packageschema]], - repositories => Optional[HashRef[$repositoryschema]], - facts => Optional[Any], - factors => Optional[ArrayRef[$factorschema]], - collections => Optional[HashRef[$collectionschema]], - pattern => Optional[Str], + mergers => Optional[$mergers], + mergeconfig => Optional[HashRef], + dependencies => Optional[ArrayRef[Str]], + packages => Optional[ArrayRef[$packageschema]], + repositories => Optional[HashRef[$repositoryschema]], + facts => Optional[Any], + factors => Optional[ArrayRef[$factorschema]], + vaults => Optional[ArrayRef[$vaultschema]], + collections => Optional[HashRef[$collectionschema]], + pattern => Optional[Str], + cachedirectory => Optional[Str], ]; my $configschema = Dict[ defaults => Optional[$configurationschema], @@ -650,6 +399,9 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO } } + $args->{defaults} //= {}; + $args->{defaults}->{cachedirectory} //= "./.cache"; + # Build Path::Tiny objects for my $cfg (values %{$args->{configurations}}, $args->{defaults}) { $cfg //= {}; @@ -663,11 +415,19 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO } $path }; + if (exists $cfg->{cachedirectory}) { + $cfg->{cachedirectory} = $make_abs->($cfg->{cachedirectory}); + } for my $factor (@{$cfg->{factors}}) { if (exists $factor->{path}) { $factor->{path} = $make_abs->($factor->{path}); } } + for my $vault (@{$cfg->{vaults}}) { + if (exists $vault->{path}) { + $vault->{path} = $make_abs->($vault->{path}); + } + } for my $repokey (keys %{$cfg->{repositories}}) { my $repo = $cfg->{repositories}->{$repokey}; if (exists $repo->{path}) { @@ -690,7 +450,7 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO my ($filepath) = @_; # Parse and read the config file - my $conf = Igor::Util::read_toml($filepath); + my $conf = App::Igor::Util::read_toml($filepath); log_debug "Parsed configuration at '$filepath':\n" . Dumper($conf); try { @@ -700,14 +460,14 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO die "Validating $filepath failed:\n$_"; }; - return Igor::Config->new(file => path($filepath), %{$conf}); + return App::Igor::Config->new(file => path($filepath), %{$conf}); } sub expand_dependencies { my ($cfgs, $root) = @_; # Expand the configuration dependencies by depth first search - return Igor::Util::toposort_dependencies($cfgs, $root, sub { $_[0]->{dependencies} }); + return App::Igor::Util::toposort_dependencies($cfgs, $root, sub { $_[0]->{dependencies} }); } sub determine_effective_configuration { @@ -726,22 +486,22 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO } reverse @cfgnames; my $configmergers = { - factors => \&Igor::Merge::list_concat, - packages => \&Igor::Merge::uniq_list_merge, - dependencies => \&Igor::Merge::uniq_list_merge, + factors => \&App::Igor::Merge::list_concat, + packages => \&App::Igor::Merge::uniq_list_merge, + dependencies => \&App::Igor::Merge::uniq_list_merge, # repositories and collections use the default hash merger, same for facts }; my $mergers = $self->defaults->{mergers} // {}; - my $cm = Igor::Util::traverse_nested_hash($self->defaults->{mergeconfig} // {}, sub { + my $cm = App::Igor::Util::traverse_nested_hash($self->defaults->{mergeconfig} // {}, sub { my ($name, $bc) = @_; unless(exists $mergers->{$name}) { die "Configured merger '$name' for path @{$bc} is not defined"; } - Igor::Util::file_to_coderef($mergers->{$name}); + App::Igor::Util::file_to_coderef($mergers->{$name}); }); $configmergers->{$_} = $cm->{$_} for (keys %$cm); - my $merger = Igor::Merge->new( + my $merger = App::Igor::Merge->new( mergers => $configmergers, ); @@ -752,6 +512,9 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO my $effective = reduce { $merger->merge($a, $b) } @cfgs; log_trace "Merged configuration: " . Dumper($effective); + # Store the merger within the effective configuration for later use + $effective->{merger} = $merger; + return $effective; } @@ -845,7 +608,7 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO } @packages; } - # Given a list of packages (as Igor::Package) get all inactive packages + # Given a list of packages (as App::Igor::Package) get all inactive packages sub complement_packages { my ($self, $packages) = @_; @@ -876,7 +639,7 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO my %packagedb = (); for my $name (sort keys %$repositories) { - my $repo = Igor::Repository->new(id => $name, directory => $repositories->{$name}->{path}, config => $config); + my $repo = App::Igor::Repository->new(id => $name, directory => $repositories->{$name}->{path}, config => $config); $repos{$name} = $repo; for my $pkg (keys %{$repo->packagedb}) { @@ -901,14 +664,14 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO for my $coll (keys %$collections) { $ctx->{collections}->{$coll} = {}; - my $pkg = Igor::Package->new(basedir => $self->file, repository => undef, id => "collection_$coll"); + my $pkg = App::Igor::Package->new(basedir => $self->file, repository => undef, id => "collection_$coll"); my $merger; if (defined $collections->{$coll}->{merger}) { my $mergerid = $collections->{$coll}->{merger}; my $mergerfile = $configuration->{mergers}->{$mergerid}; die "No such merger defined: $mergerid" unless defined $mergerfile; try { - $merger = Igor::Util::file_to_coderef($mergerfile); + $merger = App::Igor::Util::file_to_coderef($mergerfile); } catch { die "Error while processing collection '$coll': cannot create merger from $mergerfile: $_"; } @@ -918,10 +681,10 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO join('', map {$hash->{$_}} @keys) }; } - push @transactions, Igor::Operation::EmitCollection->new( + push @transactions, App::Igor::Operation::EmitCollection->new( collection => $coll, merger => $merger, - sink => Igor::Sink::File->new( path => $collections->{$coll}->{destination} + sink => App::Igor::Sink::File->new( path => $collections->{$coll}->{destination} , id => $pkg , perm => $collections->{$coll}->{perm} ), @@ -938,7 +701,19 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO my @transactions; for my $factor (@$factors) { - push @transactions, Igor::Operation::RunFactor->new(%$factor, order => 1); + push @transactions, App::Igor::Operation::RunFactor->new(%$factor, order => 1); + } + + return \@transactions; + } + + + sub build_vault_transactions { + my ($self, $vaults, $merger, $cachedirectory) = @_; + + my @transactions; + for my $vault (@$vaults) { + push @transactions, App::Igor::Operation::UnlockVault->new(%$vault, order => 1, merger => $merger, cachedirectory => $cachedirectory); } return \@transactions; @@ -947,21 +722,21 @@ $fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGO 1; __END__ -IGOR_CONFIG +APP_IGOR_CONFIG -$fatpacked{"Igor/Diff.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_DIFF'; - package Igor::Diff; +$fatpacked{"App/Igor/Diff.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_DIFF'; + package App::Igor::Diff; use Exporter 'import'; @EXPORT = qw(diff); use warnings; use strict; - { package Igor::Colordiff; + { package App::Igor::Colordiff; use warnings; use strict; - use Igor::Util qw(colored); + use App::Igor::Util qw(colored); use Text::Diff; our @ISA = qw(Text::Diff::Unified); @@ -999,14 +774,14 @@ $fatpacked{"Igor/Diff.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ my ($x, $y, $opts) = @_; # Set style, allowing overrides - $opts->{STYLE} //= 'Igor::Colordiff'; + $opts->{STYLE} //= 'App::Igor::Colordiff'; return Text::Diff::diff($x, $y, $opts); } -IGOR_DIFF +APP_IGOR_DIFF -$fatpacked{"Igor/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_MERGE'; - package Igor::Merge; +$fatpacked{"App/Igor/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_MERGE'; + package App::Igor::Merge; use warnings; use strict; @@ -1116,16 +891,16 @@ $fatpacked{"Igor/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR } 1; -IGOR_MERGE +APP_IGOR_MERGE -$fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_OPERATION'; - package Igor::Operation; +$fatpacked{"App/Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_OPERATION'; + package App::Igor::Operation; use strict; use warnings; use Class::Tiny qw(package order); use Data::Dumper; - use Igor::Sink; + use App::Igor::Sink; sub prepare { die 'Not implemented'; } sub check { die 'Not implemented'; } @@ -1146,32 +921,32 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' sub prepare_file_for_backend { my ($self, $file, $backend) = @_; - if ($backend == Igor::Pipeline::Type::FILE) { + if ($backend == App::Igor::Pipeline::Type::FILE) { # File backend: Simply pass the file return $file->absolute; - } elsif ($backend == Igor::Pipeline::Type::TEXT) { + } elsif ($backend == App::Igor::Pipeline::Type::TEXT) { # Text backend: Pass by content die "@{[$file->stringify]}: Is no regular file\n" . "Only operation 'symlink' with regular file targets (no collections)" unless -f $file; - return $file->slurp_utf8; + return $file->slurp; } die "Internal: Unknown backend: $backend"; } - package Igor::Operation::Template; + package App::Igor::Operation::Template; use strict; use warnings; - use Igor::Sink; + use App::Igor::Sink; use Class::Tiny qw(template sink), { content => undef, delimiters => undef, - backends => [Igor::Pipeline::Type::TEXT] + backends => [App::Igor::Pipeline::Type::TEXT] }; - use parent 'Igor::Operation'; + use parent 'App::Igor::Operation'; use Const::Fast; use Data::Dumper; @@ -1259,6 +1034,7 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' my $facts = $ctx->{facts}; my $packages = $ctx->{packages}; my $automatic = $ctx->{automatic}; + my $secrets = $ctx->{secrets}; my $srcfile = $self->template; die "Template $srcfile is not a regular file" unless -f $srcfile; @@ -1270,6 +1046,7 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' facts => $facts, packages => $packages, automatic => $automatic, + secrets => $secrets, }; # Use stricts requires that we predeclare those variables @@ -1321,7 +1098,7 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' $self->prepare($ctx); } - return $self->sink->emit(Igor::Pipeline::Type::TEXT, $self->content, $ctx); + return $self->sink->emit(App::Igor::Pipeline::Type::TEXT, $self->content, $ctx); } sub log { @@ -1337,7 +1114,7 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' log_warn "@{[ref($self)]}: prepare not called for template @{[$self->template]} when checking\n"; } - return $self->sink->check(Igor::Pipeline::Type::TEXT, $self->content, $ctx); + return $self->sink->check(App::Igor::Pipeline::Type::TEXT, $self->content, $ctx); } sub diff { @@ -1347,23 +1124,23 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' log_warn "@{[ref($self)]}: prepare not called for template @{[$self->template]} when diffing\n"; } - return $self->sink->diff( Igor::Pipeline::Type::TEXT, $self->content, $ctx + return $self->sink->diff( App::Igor::Pipeline::Type::TEXT, $self->content, $ctx , FILENAME_A => $self->template , MTIME_A => $self->template->stat->mtime()); } - package Igor::Operation::FileTransfer; + package App::Igor::Operation::FileTransfer; use strict; use warnings; - use Igor::Sink; + use App::Igor::Sink; use Class::Tiny qw(source sink), { - backends => [Igor::Pipeline::Type::FILE, Igor::Pipeline::Type::TEXT], + backends => [App::Igor::Pipeline::Type::FILE, App::Igor::Pipeline::Type::TEXT], data => undef, backend => undef, }; - use parent 'Igor::Operation'; + use parent 'App::Igor::Operation'; use Log::ger; use Time::localtime; @@ -1411,11 +1188,11 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' } - package Igor::Operation::EmitCollection; + package App::Igor::Operation::EmitCollection; use strict; use warnings; - use parent 'Igor::Operation'; + use parent 'App::Igor::Operation'; use Class::Tiny qw(collection merger sink), { data => undef, }; @@ -1440,20 +1217,20 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' log_trace "Merged collection '@{[$self->collection]}': $data"; $self->data($data); - return $self->sink->check(Igor::Pipeline::Type::TEXT, $self->data, $ctx); + return $self->sink->check(App::Igor::Pipeline::Type::TEXT, $self->data, $ctx); } sub apply { my ($self, $ctx) = @_; log_trace "Emitting collection '@{[$self->sink->path]}': @{[$self->data]}"; - return $self->sink->emit(Igor::Pipeline::Type::TEXT, $self->data, $ctx); + return $self->sink->emit(App::Igor::Pipeline::Type::TEXT, $self->data, $ctx); } sub diff { my ($self, $ctx) = @_; - return $self->sink->diff( Igor::Pipeline::Type::TEXT, $self->data, $ctx + return $self->sink->diff( App::Igor::Pipeline::Type::TEXT, $self->data, $ctx , FILENAME_A => "Collection " . $self->collection , MTIME_A => time()); } @@ -1464,17 +1241,17 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' log_info "Emitting collection '@{[$self->sink->stringify]}'"; } - package Igor::Operation::RunCommand; + package App::Igor::Operation::RunCommand; use strict; use warnings; - use Igor::Sink; + use App::Igor::Sink; use Class::Tiny qw(command), { basedir => "", backends => [], }; - use parent 'Igor::Operation'; + use parent 'App::Igor::Operation'; use Cwd; use Log::ger; @@ -1548,16 +1325,16 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' return ''; } - package Igor::Operation::RunFactor; + package App::Igor::Operation::RunFactor; use strict; use warnings; use Class::Tiny qw(path), { type => "perl", }; - use parent 'Igor::Operation'; + use parent 'App::Igor::Operation'; - use Igor::Merge; + use App::Igor::Merge; use String::ShellQuote; use TOML; use TOML::Parser; @@ -1570,39 +1347,25 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' my $facts; if ($self->type eq 'perl') { log_debug "Executing file '@{[$self->path]}' as perl-factor"; - my $factor = Igor::Util::file_to_coderef($self->path); + my $factor = App::Igor::Util::file_to_coderef($self->path); $facts = $factor->(); } elsif ($self->type eq 'script') { log_debug "Executing file '@{[$self->path]}' as script-factor"; - local $TOML::PARSER = TOML::Parser->new( - inflate_boolean => sub { $_[0] eq 'true' ? \1 : \0 }, - ); my $cmd = shell_quote($self->path); - my $output = `$cmd`; - if ($? == -1) { - die "Failed to execute factor $cmd: $!\n"; - } elsif ($? & 127) { - die "Factor '$cmd' died with signal @{[($? & 127)]}\n"; - } elsif (($? >> 8) != 0) { - die "Factor '$cmd' failed: Factor exited with @{[$? >> 8]}\n"; - } - - if (!defined($output)) { - die "Failed to run factor command: '$cmd'"; - } + my $output = App::Igor::Util::capture($cmd); try { - $facts = from_toml($output); + $facts = App::Igor::Util::read_toml_str($output); } catch { - die "Factor '$cmd' failed: Invalid TOML produces:\n$_"; - } + die "Factor '$cmd' failed: Invalid TOML produced:\n$_"; + }; } else { die "Unknown factor type: @{[$self->type]}"; } # Use the HashMerger to merge the automatic variables my $auto = $ctx->{automatic} // {}; - my $merger = Igor::Merge->new(); + my $merger = App::Igor::Merge->new(); $ctx->{automatic} = $merger->merge($auto, $facts); 1; } @@ -1626,12 +1389,160 @@ $fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' return ''; } + + package App::Igor::Operation::UnlockVault; + use strict; + use warnings; + + use Class::Tiny qw(path command merger cachedirectory), { + type => "shell", + cacheable => 0, + }; + use parent 'App::Igor::Operation'; + + use App::Igor::Merge; + use Data::Dumper; + use Digest::SHA; + use Log::ger; + use Path::Tiny; + use String::ShellQuote; + use TOML::Parser; + use TOML; + use Try::Tiny; + + sub checksum { + my ($filename) = @_; + + my $sha256 = Digest::SHA->new(256); + try { + # Forcing stringification of $filename is imprtant here + # Might be a Path::Tiny object and Digest::SHA inspects reftypes + $sha256->addfile("$filename", "b"); + } catch { + die "Failed to checksum vault '$filename': $_"; + }; + + return $sha256->hexdigest(); + } + + sub decrypt { + my ($command, $file) = @_; + + my $vault = shell_quote($file); + my $cmd = "$command"; + log_info "Unlocking vault file '$file' using command: $cmd"; + $ENV{IGOR_VAULT} = $file; + my $outfile = File::Temp->new(); + $ENV{IGOR_OUTFILE} = $outfile->filename; + + try { + App::Igor::Util::execute($cmd); + } catch { + die "Failed to decrypt vault '$vault' using command '$cmd':\n$_"; + }; + my $output = path($outfile->filename)->slurp(); + + delete $ENV{IGOR_VAULT}; + delete $ENV{IGOR_OUTFILE}; + + return $output; + } + + # Cache logic. Cached, decoded vaults are stored in $cachedir and identified + # by their sha256sum as a filename. + sub cache_lookup { + my ($cachedir, $vaultfile) = @_; + + my $digest = checksum($vaultfile->stringify); + my $cached = $cachedir->child($digest); + if ($cached->is_file) { + log_debug "Vault $vaultfile found in cache: $cached"; + return $cached->slurp(); + } else { + log_debug "Vault $vaultfile not found in cache: $cached does not exist"; + return undef; + } + } + + sub cache_store { + my ($cachedir, $vaultfile, $content) = @_; + + my $digest = checksum($vaultfile->stringify); + # ensure the cachedirectory exists + $cachedir->mkpath; + my $cached = $cachedir->child($digest); + + + # Create + $cached->touch; + # Cached files are most likely to be kept private + $cached->chmod(0700); + # actually write the data (spew will not work due to permissions + # ending up to be the umask) + $cached->append({truncate => 1}, $content); + } + + sub retrieve { + my ($filepath, $command, $cacheable, $cachedir) = @_; + my $content = cache_lookup($cachedir, $filepath); + if (!defined $content) { + $content = decrypt($command, $filepath); + if ($cacheable) { + cache_store($cachedir, $filepath, $content); + } + } + + return $content; + } + + sub prepare { + my ($self, $ctx) = @_; + + # Currently, we only support one type of vaults + die "Unsupported vault type '@{[$self->type]}" unless $self->type eq "shell"; + + my $data = retrieve($self->{path}, $self->command, $self->cacheable, $self->cachedirectory); + + my $facts; + try { + $facts = App::Igor::Util::read_toml_str($data); + } catch { + die "Unlocking vault '@{[$self->{path}]}' failed: Invalid TOML produced:\n$_"; + }; + log_trace "Retrieved vault '@{[$self->{path}]}':\n" . Dumper($facts); + + # Use the HashMerger to merge the automatic variables + my $secrets = $ctx->{secrets} // {}; + my $merger = $self->merger; + $ctx->{secrets} = $merger->merge($secrets, $facts); + 1; + } + + sub check { + 1; + } + + sub apply { + 1; + } + + sub log { + my ($self) = @_; + log_info "Already unlocked vault '@{[$self->{path}]}'"; + 1; + } + + sub diff { + my ($self) = @_; + return ''; + } + 1; __END__ -IGOR_OPERATION +APP_IGOR_OPERATION -$fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_PACKAGE'; - package Igor::Package; +$fatpacked{"App/Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_PACKAGE'; + package App::Igor::Package; use strict; use warnings; @@ -1651,8 +1562,8 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG use Type::Tiny; use Types::Standard qw(Any ArrayRef Dict HashRef Optional Str); - use Igor::Operation; - use Igor::Util; + use App::Igor::Operation; + use App::Igor::Util; # Config file Schemata for TOML validation my $commandschema = Str | ArrayRef[Str]; @@ -1707,7 +1618,7 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG my ($filepath, $repository) = @_; # Parse and read the config file - my $conf = Igor::Util::read_toml($filepath); + my $conf = App::Igor::Util::read_toml($filepath); my $packagedir = path($filepath)->parent; return from_hash($conf, $packagedir, $repository); @@ -1717,7 +1628,7 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG my ($filepath, $repository, $config) = @_; my $packagedir = path($filepath)->parent; - my $packagesub = Igor::Util::file_to_coderef($filepath); + my $packagesub = App::Igor::Util::file_to_coderef($filepath); my $conf; { # execute this from the packageidr my $dir = pushd($packagedir); @@ -1736,7 +1647,7 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG die "Validating package-configuration at $basedir failed:\n$_"; }; - return Igor::Package->new(basedir => $basedir + return App::Igor::Package->new(basedir => $basedir , repository => $repository , id => $basedir->basename , %{$conf}); @@ -1758,9 +1669,9 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG my ($file, $id) = @_; if (defined($file->{dest})) { - return Igor::Sink::File->new(path => $file->{dest}, id => $id, perm => $file->{perm}, operation => $file->{operation}); + return App::Igor::Sink::File->new(path => $file->{dest}, id => $id, perm => $file->{perm}, operation => $file->{operation}); } elsif (defined($file->{collection})) { - return Igor::Sink::Collection->new(collection => $file->{collection}, id => $id); + return App::Igor::Sink::Collection->new(collection => $file->{collection}, id => $id); } else { die "Failed to determine sink for file: " . Dumper($file); } @@ -1772,7 +1683,7 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG # Run precommands for my $cmd (@{$self->precmds}) { - push @transactions, Igor::Operation::RunCommand->new( + push @transactions, App::Igor::Operation::RunCommand->new( package => $self, command => $cmd, basedir => $self->basedir, @@ -1785,7 +1696,7 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG my $source = path("@{[$self->basedir]}/$file->{source}"); # File mode bits: 07777 -> parts to copy $file->{perm} //= $source->stat->mode & 07777; - push @transactions, Igor::Operation::FileTransfer->new( + push @transactions, App::Igor::Operation::FileTransfer->new( package => $self, source => $source, sink => determine_sink($file, $self->qname), @@ -1795,7 +1706,7 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG # Run the templates for my $tmpl (@{$self->templates}) { - push @transactions, Igor::Operation::Template->new( + push @transactions, App::Igor::Operation::Template->new( package => $self, template => path("@{[$self->basedir]}/$tmpl->{source}"), sink => determine_sink($tmpl, $self->qname), @@ -1806,7 +1717,7 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG # Now run the postcommands for my $cmd (@{$self->postcmds}) { - push @transactions, Igor::Operation::RunCommand->new( + push @transactions, App::Igor::Operation::RunCommand->new( package => $self, command => $cmd, basedir => $self->basedir, @@ -1837,7 +1748,7 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG my ($self) = @_; my @files = map { $_->{dest} } @{$self->files}, @{$self->templates}; - my @artifacts = map { Igor::Util::glob($_) } @{$self->artifacts}; + my @artifacts = map { App::Igor::Util::glob($_) } @{$self->artifacts}; return map { path($_)->realpath->stringify @@ -1847,10 +1758,10 @@ $fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IG 1; __END__ -IGOR_PACKAGE +APP_IGOR_PACKAGE -$fatpacked{"Igor/Repository.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_REPOSITORY'; - package Igor::Repository; +$fatpacked{"App/Igor/Repository.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_REPOSITORY'; + package App::Igor::Repository; use strict; use warnings; @@ -1858,8 +1769,8 @@ $fatpacked{"Igor/Repository.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<< packagedb => {} }; - use Igor::Package; - use Igor::Util; + use App::Igor::Package; + use App::Igor::Util; use Path::Tiny; use Data::Dumper; use Log::ger; @@ -1879,9 +1790,9 @@ $fatpacked{"Igor/Repository.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<< my $package; if ((my $packagedesc = $path->child("package.toml"))->is_file) { - $package = Igor::Package::from_file($packagedesc, $self); + $package = App::Igor::Package::from_file($packagedesc, $self); } elsif ((my $packagedescpl = $path->child("package.pl"))->is_file) { - $package = Igor::Package::from_perl_file($packagedescpl, $self, $conf); + $package = App::Igor::Package::from_perl_file($packagedescpl, $self, $conf); log_debug ("Evaluated @{[$packagedescpl->stringify]}: " . Dumper($package)); } return unless defined($package); @@ -1896,7 +1807,7 @@ $fatpacked{"Igor/Repository.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<< sub dependency_graph { my ($self) = @_; - my $g = Igor::Util::build_graph($self->packagedb, sub { + my $g = App::Igor::Util::build_graph($self->packagedb, sub { $_[0]->dependencies; }); @@ -1928,12 +1839,12 @@ $fatpacked{"Igor/Repository.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<< 1; __END__ -IGOR_REPOSITORY +APP_IGOR_REPOSITORY -$fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_SINK'; +$fatpacked{"App/Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_SINK'; use strict; - package Igor::Sink { + package App::Igor::Sink { use strict; use warnings; @@ -1947,7 +1858,7 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ } - package Igor::Pipeline::Type { + package App::Igor::Pipeline::Type { use strict; use constant { @@ -1961,11 +1872,11 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ }; } - package Igor::Sink::File { + package App::Igor::Sink::File { use strict; use warnings; - use parent 'Igor::Sink'; + use parent 'App::Igor::Sink'; use Class::Tiny qw(path), { perm => undef, operation => undef, @@ -1974,11 +1885,11 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ use Const::Fast; use Data::Dumper; use Log::ger; - use Igor::Diff (); + use App::Igor::Diff (); use Try::Tiny; use Fcntl ':mode'; - const my @REQUIRES => (Igor::Pipeline::Type::FILE, Igor::Pipeline::Type::TEXT); + const my @REQUIRES => (App::Igor::Pipeline::Type::FILE, App::Igor::Pipeline::Type::TEXT); sub BUILD { my ($self, $args) = @_; @@ -1995,11 +1906,11 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ my ($self, $typeref, $dataref) = @_; if (defined $self->operation && $self->operation eq "copy") { - $$typeref = Igor::Pipeline::Type::TEXT; + $$typeref = App::Igor::Pipeline::Type::TEXT; # Text backend: Pass by content die "@{[$$dataref->stringify]}: Is no regular file\n" . "Only operation 'symlink' with regular file targets (no collections) are supported for directories" unless -f $$dataref; - $$dataref = $$dataref->slurp_utf8(); + $$dataref = $$dataref->slurp(); } } @@ -2010,13 +1921,13 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ prepare_for_copy($self, \$type, \$data); - if ($type == Igor::Pipeline::Type::TEXT) { + if ($type == App::Igor::Pipeline::Type::TEXT) { try { - $changeneeded = $self->path->slurp_utf8() ne $data; + $changeneeded = $self->path->slurp() ne $data; } catch { $changeneeded = 1; }; - } elsif ($type == Igor::Pipeline::Type::FILE) { + } elsif ($type == App::Igor::Pipeline::Type::FILE) { try { $changeneeded = not (S_ISLNK($self->path->lstat->mode) && ($self->path->realpath eq $data->realpath)); } catch { @@ -2035,7 +1946,7 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ sub emit { my ($self, $type, $data) = @_; - return Igor::Pipeline::Type::UNCHANGED unless $self->check($type, $data); + return App::Igor::Pipeline::Type::UNCHANGED unless $self->check($type, $data); prepare_for_copy($self, \$type, \$data); @@ -2044,17 +1955,17 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ $self->path->parent->mkpath; } - if ($type == Igor::Pipeline::Type::TEXT) { + if ($type == App::Igor::Pipeline::Type::TEXT) { log_trace "spew(@{[$self->path]}, " . Dumper($data) . ")"; # write the data - $self->path->spew_utf8($data); + $self->path->spew($data); # Fix permissions if requested if (defined $self->perm) { $self->path->chmod($self->perm); } - } elsif ($type == Igor::Pipeline::Type::FILE) { + } elsif ($type == App::Igor::Pipeline::Type::FILE) { my $dest = $self->path->absolute; # Remove the link if it exists @@ -2066,7 +1977,7 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ die "Unsupported type \"$type\" at \"" . __PACKAGE__ . "\" when emitting file @{[$self->path]}"; } - return Igor::Pipeline::Type::CHANGED; + return App::Igor::Pipeline::Type::CHANGED; } sub diff { @@ -2075,15 +1986,15 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ prepare_for_copy($self, \$type, \$data); my $diff; - if ($type == Igor::Pipeline::Type::TEXT) { + if ($type == App::Igor::Pipeline::Type::TEXT) { try { - $diff = Igor::Diff::diff \$data, $self->path->stringify, \%opts; + $diff = App::Igor::Diff::diff \$data, $self->path->stringify, \%opts; } catch { $diff = $_; } - } elsif ($type == Igor::Pipeline::Type::FILE) { + } elsif ($type == App::Igor::Pipeline::Type::FILE) { try { - $diff = Igor::Diff::diff $data->stringify, $self->path->stringify, \%opts; + $diff = App::Igor::Diff::diff $data->stringify, $self->path->stringify, \%opts; } catch { $diff = $_; } @@ -2107,7 +2018,7 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ } } - package Igor::Sink::Collection { + package App::Igor::Sink::Collection { use strict; use warnings; @@ -2115,7 +2026,7 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ # will later be used to fuse the collection. Therefore check, emit and diff # are subs, only crating a suitable ctx for the actual ops. - use parent 'Igor::Sink'; + use parent 'App::Igor::Sink'; use Class::Tiny qw(collection id), { checked => 0, }; @@ -2125,7 +2036,7 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ use Log::ger; use Text::Diff (); - const my @REQUIRES => (Igor::Pipeline::Type::TEXT); + const my @REQUIRES => (App::Igor::Pipeline::Type::TEXT); sub requires { \@REQUIRES } @@ -2137,7 +2048,7 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ # Sanity-check: Input type die "Unsupported type \"$type\" at \"@{[__PACKAGE__]}\" " - . "when emitting to collection @{[$self->collection]} for @{[$self->id]}" if Igor::Pipeline::Type::TEXT != $type; + . "when emitting to collection @{[$self->collection]} for @{[$self->id]}" if App::Igor::Pipeline::Type::TEXT != $type; # Ensure that collection exists die "Unknown collection '@{[$self->collection]}' for package '@{[$self->id]}'" @@ -2162,7 +2073,7 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ # Sets $ctx $self->check($type, $data, $ctx); - return Igor::Pipeline::Type::UNCHANGED; + return App::Igor::Pipeline::Type::UNCHANGED; } sub diff { @@ -2186,10 +2097,10 @@ $fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ 1; __END__ -IGOR_SINK +APP_IGOR_SINK -$fatpacked{"Igor/Types.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_TYPES'; - package Igor::Types; +$fatpacked{"App/Igor/Types.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_TYPES'; + package App::Igor::Types; use warnings; use strict; @@ -2207,10 +2118,10 @@ $fatpacked{"Igor/Types.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR 1; __END__ -IGOR_TYPES +APP_IGOR_TYPES -$fatpacked{"Igor/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_UTIL'; - package Igor::Util; +$fatpacked{"App/Igor/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_IGOR_UTIL'; + package App::Igor::Util; use Exporter 'import'; @EXPORT_OK = qw(colored); @@ -2247,6 +2158,21 @@ $fatpacked{"Igor/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ return $conf; } + sub read_toml_str { + my ($data) = @_; + + state $parser = TOML::Parser->new( + inflate_boolean => sub { $_[0] eq 'true' ? \1 : \0 }, + ); + my ($conv, $err) = $parser->parse($data); + unless ($conv) { + log_error "Parsing of toml data failed: $err"; + die $err; + } + + return $conv; + } + sub build_graph { my ($hash, $lambda_deps) = @_; @@ -2362,10 +2288,307 @@ $fatpacked{"Igor/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_ return \%result; } + sub capture { + my ($cmd) = @_; + + log_debug "Executing command '$cmd'"; + my $output = `$cmd`; + if ($? == -1) { + die "Failed to execute command '$cmd': $!\n"; + } elsif ($? & 127) { + die "Command '$cmd' died with signal @{[($? & 127)]}\n"; + } elsif (($? >> 8) != 0) { + die "Command '$cmd' failed: Factor exited with @{[$? >> 8]}\n"; + } + + if (!defined($output)) { + die "Failed to capture output for command '$cmd'"; + } + + return $output; + } + + + sub execute { + my ($cmd) = @_; + + log_debug "Executing command '$cmd'"; + my $retval = system($cmd); + if ($retval == -1) { + die "Failed to execute command '$cmd': $!\n"; + } elsif ($retval & 127) { + die "Command '$cmd' died with signal @{[($retval & 127)]}\n"; + } elsif (($retval >> 8) != 0) { + die "Command '$cmd' failed: Factor exited with @{[$retval >> 8]}\n"; + } + + return $retval; + } + 1; __END__ -IGOR_UTIL +APP_IGOR_UTIL + +$fatpacked{"Class/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_TINY'; + use 5.006;use strict;no strict 'refs';use warnings;package Class::Tiny;our$VERSION='1.006';use Carp ();require($] >= 5.010 ? "mro.pm" : "MRO/Compat.pm");my%CLASS_ATTRIBUTES;sub import {my$class=shift;my$pkg=caller;$class->prepare_class($pkg);$class->create_attributes($pkg,@_)if @_}sub prepare_class {my ($class,$pkg)=@_;@{"${pkg}::ISA"}="Class::Tiny::Object" unless @{"${pkg}::ISA"}}sub create_attributes {my ($class,$pkg,@spec)=@_;my%defaults=map {ref $_ eq 'HASH' ? %$_ : ($_=>undef)}@spec;my@attr=grep {defined and!ref and /^[^\W\d]\w*$/s or Carp::croak "Invalid accessor name '$_'"}keys%defaults;$CLASS_ATTRIBUTES{$pkg}{$_}=$defaults{$_}for@attr;$class->_gen_accessor($pkg,$_)for grep {!*{"$pkg\::$_"}{CODE}}@attr;Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub _gen_accessor {my ($class,$pkg,$name)=@_;my$outer_default=$CLASS_ATTRIBUTES{$pkg}{$name};my$sub=$class->__gen_sub_body($name,defined($outer_default),ref($outer_default));eval "package $pkg; my \$default=\$outer_default; $sub";Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub __gen_sub_body {my ($self,$name,$has_default,$default_type)=@_;if ($has_default && $default_type eq 'CODE'){return << "HERE"}elsif ($has_default){return << "HERE"}else {return << "HERE"}}sub get_all_attributes_for {my ($class,$pkg)=@_;my%attr=map {$_=>undef}map {keys %{$CLASS_ATTRIBUTES{$_}|| {}}}@{mro::get_linear_isa($pkg)};return keys%attr}sub get_all_attribute_defaults_for {my ($class,$pkg)=@_;my$defaults={};for my$p (reverse @{mro::get_linear_isa($pkg)}){while (my ($k,$v)=each %{$CLASS_ATTRIBUTES{$p}|| {}}){$defaults->{$k}=$v}}return$defaults}package Class::Tiny::Object;our$VERSION='1.006';my (%HAS_BUILDARGS,%BUILD_CACHE,%DEMOLISH_CACHE,%ATTR_CACHE);my$_PRECACHE=sub {no warnings 'once';my ($class)=@_;my$linear_isa=@{"$class\::ISA"}==1 && ${"$class\::ISA"}[0]eq "Class::Tiny::Object" ? [$class]: mro::get_linear_isa($class);$DEMOLISH_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::DEMOLISH"}@$linear_isa ];$BUILD_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::BUILD"}reverse @$linear_isa ];$HAS_BUILDARGS{$class}=$class->can("BUILDARGS");return$ATTR_CACHE{$class}={map {$_=>1}Class::Tiny->get_all_attributes_for($class)}};sub new {my$class=shift;my$valid_attrs=$ATTR_CACHE{$class}|| $_PRECACHE->($class);my$args;if ($HAS_BUILDARGS{$class}){$args=$class->BUILDARGS(@_)}else {if (@_==1 && ref $_[0]){my%copy=eval {%{$_[0]}};Carp::croak("Argument to $class->new() could not be dereferenced as a hash")if $@;$args=\%copy}elsif (@_ % 2==0){$args={@_}}else {Carp::croak("$class->new() got an odd number of elements")}}my$self=bless {map {$_=>$args->{$_}}grep {exists$valid_attrs->{$_}}keys %$args },$class;$self->BUILDALL($args)if!delete$args->{__no_BUILD__}&& @{$BUILD_CACHE{$class}};return$self}sub BUILDALL {$_->(@_)for @{$BUILD_CACHE{ref $_[0]}}}require Devel::GlobalDestruction unless defined ${^GLOBAL_PHASE};sub DESTROY {my$self=shift;my$class=ref$self;my$in_global_destruction=defined ${^GLOBAL_PHASE} ? ${^GLOBAL_PHASE} eq 'DESTRUCT' : Devel::GlobalDestruction::in_global_destruction();for my$demolisher (@{$DEMOLISH_CACHE{$class}}){my$e=do {local ($?,$@);eval {$demolisher->($self,$in_global_destruction)};$@};no warnings 'misc';die$e if$e}}1; + sub $name { + return ( + ( \@_ == 1 && exists \$_[0]{$name} ) + ? ( \$_[0]{$name} ) + : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default->( \$_[0] ) ) + ); + } + HERE + sub $name { + return ( + ( \@_ == 1 && exists \$_[0]{$name} ) + ? ( \$_[0]{$name} ) + : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default ) + ); + } + HERE + sub $name { + return \@_ == 1 ? \$_[0]{$name} : ( \$_[0]{$name} = \$_[1] ); + } + HERE +CLASS_TINY + +$fatpacked{"Const/Fast.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CONST_FAST'; + package Const::Fast;{$Const::Fast::VERSION='0.014'}use 5.008;use strict;use warnings FATAL=>'all';use Scalar::Util qw/reftype blessed/;use Carp qw/croak/;use Sub::Exporter::Progressive 0.001007 -setup=>{exports=>[qw/const/],groups=>{default=>[qw/const/]}};sub _dclone($) {require Storable;no warnings 'redefine';*_dclone=\&Storable::dclone;goto&Storable::dclone}my%skip=map {$_=>1}qw/CODE GLOB/;sub _make_readonly {my (undef,$dont_clone)=@_;if (my$reftype=reftype $_[0]and not blessed($_[0])and not &Internals::SvREADONLY($_[0])){$_[0]=_dclone($_[0])if!$dont_clone && &Internals::SvREFCNT($_[0])> 1 &&!$skip{$reftype};&Internals::SvREADONLY($_[0],1);if ($reftype eq 'SCALAR' || $reftype eq 'REF'){_make_readonly(${$_[0]},1)}elsif ($reftype eq 'ARRAY'){_make_readonly($_)for @{$_[0]}}elsif ($reftype eq 'HASH'){&Internals::hv_clear_placeholders($_[0]);_make_readonly($_)for values %{$_[0]}}}Internals::SvREADONLY($_[0],1);return}sub const(\[$@%]@) {my (undef,@args)=@_;croak 'Invalid first argument, need an reference' if not defined reftype($_[0]);croak 'Attempt to reassign a readonly variable' if&Internals::SvREADONLY($_[0]);if (reftype $_[0]eq 'SCALAR' or reftype $_[0]eq 'REF'){croak 'No value for readonly variable' if@args==0;croak 'Too many arguments in readonly assignment' if@args > 1;${$_[0]}=$args[0]}elsif (reftype $_[0]eq 'ARRAY'){@{$_[0]}=@args}elsif (reftype $_[0]eq 'HASH'){croak 'Odd number of elements in hash assignment' if@args % 2;%{$_[0]}=@args}else {croak 'Can\'t make variable readonly'}_make_readonly($_[0],1);return}1; +CONST_FAST + +$fatpacked{"Data/Diver.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DIVER'; + package Data::Diver;use strict;require Exporter;use vars qw($VERSION @EXPORT_OK);BEGIN {$VERSION=1.01_01;@EXPORT_OK=qw(Dive DiveRef DiveVal DiveError DiveDie DiveClear);*import=\&Exporter::import;*isa=\&UNIVERSAL::isa}my@lastError;sub _Error {@lastError=@_[2,0,1];return}sub DiveError {return@lastError}sub DiveClear {@lastError=()}sub DiveDie {@_=Dive(@_)if 1 < @_;return wantarray ? @_ : pop @_ if @_ ||!@lastError;my($errDesc,$ref,$svKey)=@lastError;die "$errDesc using $$svKey on $ref (from Data::Diver).\n"}sub Dive {return if!@_;my$ref=shift @_;return$ref if!$ref;while(@_){my$key=shift @_;if(!defined$key){return _Error($ref,\$key,"undef() on non-scalar-ref")if!eval {my$x=$$ref;1};$ref=$$ref}elsif(eval {my$x=$key->[0];1}&& isa($ref,'CODE')){if(@_ &&!defined $_[0]){$ref=\ $ref->(@$key)}else {$ref=[$ref->(@$key)]}}elsif($key =~ /^-?\d+$/ && eval {my$x=$ref->[0];1}){return _Error($ref,\$key,"Index out of range")if$key < -@$ref || $#$ref < $key;$ref=$ref->[$key]}elsif(eval {exists$ref->{$key}}){if(eval {my$x=$$key;1}){$ref=$ref->{$$key}}else {$ref=$ref->{$key}}}elsif(eval {my$x=$ref->{$key};1}){return _Error($ref,\$key,"Key not present in hash")}else {return _Error($ref,\$key,"Not a valid type of reference")}}return$ref}sub DiveVal :lvalue {${DiveRef(@_)}}sub DiveRef {return if!@_;my$sv=\shift @_;return $$sv if!$$sv;while(@_){my$key=shift @_;if(!defined$key){$sv=\$$$sv}elsif(eval {my$x=$key->[0];1}&& isa($$sv,'CODE')){if(@_ &&!defined $_[0]){$sv=\ $$sv->(@$key)}else {$sv=\[$$sv->(@$key)]}}elsif(eval {my$x=$$key;1}and!defined($$sv)|| eval {my$x=$$sv->{0};1}){$sv=\$$sv->{$$key}}elsif($key =~ /^-?\d+$/ and!defined($$sv)|| eval {my$x=$$sv->[0];1}){$sv=\$$sv->[$key]}else {$sv=\$$sv->{$key}}}return$sv}'Data::Diver'; +DATA_DIVER + +$fatpacked{"Data/Dmp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DATA_DMP'; + package Data::Dmp;our$DATE='2017-01-30';our$VERSION='0.23';use 5.010001;use strict;use warnings;use Scalar::Util qw(looks_like_number blessed reftype refaddr);require Exporter;our@ISA=qw(Exporter);our@EXPORT=qw(dd dmp);our%_seen_refaddrs;our%_subscripts;our@_fixups;our$OPT_PERL_VERSION="5.010";our$OPT_REMOVE_PRAGMAS=0;our$OPT_DEPARSE=1;our$OPT_STRINGIFY_NUMBERS=0;my%esc=("\a"=>"\\a","\b"=>"\\b","\t"=>"\\t","\n"=>"\\n","\f"=>"\\f","\r"=>"\\r","\e"=>"\\e",);sub _double_quote {local($_)=$_[0];s/([\\\"\@\$])/\\$1/g;return qq("$_") unless /[^\040-\176]/;s/([\a\b\t\n\f\r\e])/$esc{$1}/g;s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;s/([^\040-\176])/sprintf('\\x{%X}',ord($1))/eg;return qq("$_")}sub _dump_code {my$code=shift;state$deparse=do {require B::Deparse;B::Deparse->new("-l")};my$res=$deparse->coderef2text($code);my ($res_before_first_line,$res_after_first_line)=$res =~ /(.+?)^(#line .+)/ms;if ($OPT_REMOVE_PRAGMAS){$res_before_first_line="{"}elsif ($OPT_PERL_VERSION < 5.016){$res_before_first_line =~ s/no feature ':all';/no feature;/m}$res_after_first_line =~ s/^#line .+//gm;$res="sub" .$res_before_first_line .$res_after_first_line;$res =~ s/^\s+//gm;$res =~ s/\n+//g;$res =~ s/;\}\z/}/;$res}sub _quote_key {$_[0]=~ /\A-?[A-Za-z_][A-Za-z0-9_]*\z/ || $_[0]=~ /\A-?[1-9][0-9]{0,8}\z/ ? $_[0]: _double_quote($_[0])}sub _dump {my ($val,$subscript)=@_;my$ref=ref($val);if ($ref eq ''){if (!defined($val)){return "undef"}elsif (looks_like_number($val)&&!$OPT_STRINGIFY_NUMBERS && $val eq $val+0 && $val !~ /\A-?(?:inf(?:inity)?|nan)\z/i){return$val}else {return _double_quote($val)}}my$refaddr=refaddr($val);$_subscripts{$refaddr}//= $subscript;if ($_seen_refaddrs{$refaddr}++){push@_fixups,"\$a->$subscript=\$a",($_subscripts{$refaddr}? "->$_subscripts{$refaddr}" : ""),";";return "'fix'"}my$class;if ($ref eq 'Regexp' || $ref eq 'REGEXP'){require Regexp::Stringify;return Regexp::Stringify::stringify_regexp(regexp=>$val,with_qr=>1,plver=>$OPT_PERL_VERSION)}if (blessed$val){$class=$ref;$ref=reftype($val)}my$res;if ($ref eq 'ARRAY'){$res="[";my$i=0;for (@$val){$res .= "," if$i;$res .= _dump($_,"$subscript\[$i]");$i++}$res .= "]"}elsif ($ref eq 'HASH'){$res="{";my$i=0;for (sort keys %$val){$res .= "," if$i++;my$k=_quote_key($_);my$v=_dump($val->{$_},"$subscript\{$k}");$res .= "$k=>$v"}$res .= "}"}elsif ($ref eq 'SCALAR'){$res="\\"._dump($$val,$subscript)}elsif ($ref eq 'REF'){$res="\\"._dump($$val,$subscript)}elsif ($ref eq 'CODE'){$res=$OPT_DEPARSE ? _dump_code($val): 'sub{"DUMMY"}'}else {die "Sorry, I can't dump $val (ref=$ref) yet"}$res="bless($res,"._double_quote($class).")" if defined($class);$res}our$_is_dd;sub _dd_or_dmp {local%_seen_refaddrs;local%_subscripts;local@_fixups;my$res;if (@_ > 1){$res="(" .join(",",map {_dump($_,'')}@_).")"}else {$res=_dump($_[0],'')}if (@_fixups){$res="do{my\$a=$res;" .join("",@_fixups)."\$a}"}if ($_is_dd){say$res;return wantarray()|| @_ > 1 ? @_ : $_[0]}else {return$res}}sub dd {local$_is_dd=1;_dd_or_dmp(@_)}sub dmp {goto&_dd_or_dmp}1; +DATA_DMP + +$fatpacked{"Devel/TypeTiny/Perl56Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_TYPETINY_PERL56COMPAT'; + package Devel::TypeTiny::Perl56Compat;use 5.006;use strict;use warnings;our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.002001';use B ();unless (exists&B::perlstring){my$d;*B::perlstring=sub {no warnings 'uninitialized';require Data::Dumper;$d ||= 'Data::Dumper'->new([])->Indent(0)->Purity(0)->Pad('')->Useqq(1)->Terse(1)->Freezer('')->Toaster('');my$perlstring=$d->Values([''.shift])->Dump;($perlstring =~ /^"/)? $perlstring : qq["$perlstring"]}}unless (exists&B::cstring){*B::cstring=\&B::perlstring}push@B::EXPORT_OK,qw(perlstring cstring);5.6; +DEVEL_TYPETINY_PERL56COMPAT + +$fatpacked{"Devel/TypeTiny/Perl58Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DEVEL_TYPETINY_PERL58COMPAT'; + package Devel::TypeTiny::Perl58Compat;use 5.006;use strict;use warnings;our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.002001';eval 'require re';unless (exists&re::is_regexp){require B;*re::is_regexp=sub {eval {B::svref_2object($_[0])->MAGIC->TYPE eq 'r'}}}5.6; +DEVEL_TYPETINY_PERL58COMPAT + +$fatpacked{"Error/TypeTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ERROR_TYPETINY'; + package Error::TypeTiny;use 5.006001;use strict;use warnings;BEGIN {$Error::TypeTiny::AUTHORITY='cpan:TOBYINK';$Error::TypeTiny::VERSION='1.002001'}use overload q[""]=>sub {$_[0]->to_string},q[bool]=>sub {1},fallback=>1,;our%CarpInternal;$CarpInternal{$_}++ for qw(Eval::TypeTiny Eval::TypeTiny::Sandbox Exporter::Tiny Test::TypeTiny Type::Coercion Type::Coercion::Union Error::TypeTiny Type::Library Type::Params Type::Registry Types::Standard Types::Standard::_Stringable Types::TypeTiny Type::Tiny Type::Tiny::Class Type::Tiny::Duck Type::Tiny::Enum Type::Tiny::Intersection Type::Tiny::Role Type::Tiny::Union Type::Utils);sub new {my$class=shift;my%params=(@_==1)? %{$_[0]}: @_;return bless \%params,$class}sub throw {my$class=shift;my ($level,@caller,%ctxt)=0;while (defined scalar caller($level)and $CarpInternal{scalar caller($level)}){$level++};if (((caller($level - 1))[1]||"")=~ /^parameter validation for '(.+?)'$/){my ($pkg,$func)=($1 =~ m{^(.+)::(\w+)$});$level++ if caller($level)eq ($pkg||"")}$level++ if ((caller($level))[1]=~ /^\(eval \d+\)$/ and (caller($level))[3]eq '(eval)');@ctxt{qw/package file line/}=caller($level);my$stack=undef;if (our$StackTrace){require Devel::StackTrace;$stack="Devel::StackTrace"->new(ignore_package=>[keys%CarpInternal ],)}die(our$LastError=$class->new(context=>\%ctxt,stack_trace=>$stack,@_,))}sub message {$_[0]{message}||= $_[0]->_build_message};sub context {$_[0]{context}};sub stack_trace {$_[0]{stack_trace}};sub to_string {my$e=shift;my$c=$e->context;my$m=$e->message;$m =~ /\n\z/s ? $m : $c ? sprintf("%s at %s line %s.\n",$m,$c->{file}||'file?',$c->{line}||'NaN'): sprintf("%s\n",$m)}sub _build_message {return 'An exception has occurred'}sub croak {my ($fmt,@args)=@_;@_=(__PACKAGE__,message=>sprintf($fmt,@args),);goto \&throw}1; +ERROR_TYPETINY + +$fatpacked{"Error/TypeTiny/Assertion.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ERROR_TYPETINY_ASSERTION'; + package Error::TypeTiny::Assertion;use 5.006001;use strict;use warnings;BEGIN {if ($] < 5.008){require Devel::TypeTiny::Perl56Compat}}BEGIN {$Error::TypeTiny::Assertion::AUTHORITY='cpan:TOBYINK';$Error::TypeTiny::Assertion::VERSION='1.002001'}require Error::TypeTiny;our@ISA='Error::TypeTiny';sub type {$_[0]{type}};sub value {$_[0]{value}};sub varname {$_[0]{varname}||= '$_'};sub attribute_step {$_[0]{attribute_step}};sub attribute_name {$_[0]{attribute_name}};sub has_type {defined $_[0]{type}};sub has_attribute_step {exists $_[0]{attribute_step}};sub has_attribute_name {exists $_[0]{attribute_name}};sub new {my$class=shift;my$self=$class->SUPER::new(@_);if (ref$Method::Generate::Accessor::CurrentAttribute){require B;my%d=%{$Method::Generate::Accessor::CurrentAttribute};$self->{attribute_name}=$d{name}if defined$d{name};$self->{attribute_step}=$d{step}if defined$d{step};if (defined$d{init_arg}){$self->{varname}=sprintf('$args->{%s}',B::perlstring($d{init_arg}))}elsif (defined$d{name}){$self->{varname}=sprintf('$self->{%s}',B::perlstring($d{name}))}}return$self}sub message {my$e=shift;$e->varname eq '$_' ? $e->SUPER::message : sprintf('%s (in %s)',$e->SUPER::message,$e->varname)}sub _build_message {my$e=shift;$e->has_type ? sprintf('%s did not pass type constraint "%s"',Type::Tiny::_dd($e->value),$e->type): sprintf('%s did not pass type constraint',Type::Tiny::_dd($e->value))}*to_string=sub {my$e=shift;my$msg=$e->message;my$c=$e->context;$msg .= sprintf(" at %s line %s",$c->{file}||'file?',$c->{line}||'NaN')if$c;my$explain=$e->explain;return "$msg\n" unless @{$explain || []};$msg .= "\n";for my$line (@$explain){$msg .= " $line\n"}return$msg}if $] >= 5.008;sub explain {my$e=shift;return undef unless$e->has_type;$e->type->validate_explain($e->value,$e->varname)}1; +ERROR_TYPETINY_ASSERTION + +$fatpacked{"Error/TypeTiny/Compilation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ERROR_TYPETINY_COMPILATION'; + package Error::TypeTiny::Compilation;use 5.006001;use strict;use warnings;BEGIN {$Error::TypeTiny::Compilation::AUTHORITY='cpan:TOBYINK';$Error::TypeTiny::Compilation::VERSION='1.002001'}require Error::TypeTiny;our@ISA='Error::TypeTiny';sub code {$_[0]{code}};sub environment {$_[0]{environment}||= {}};sub errstr {$_[0]{errstr}};sub _build_message {my$self=shift;sprintf("Failed to compile source because: %s",$self->errstr)}1; +ERROR_TYPETINY_COMPILATION + +$fatpacked{"Error/TypeTiny/WrongNumberOfParameters.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ERROR_TYPETINY_WRONGNUMBEROFPARAMETERS'; + package Error::TypeTiny::WrongNumberOfParameters;use 5.006001;use strict;use warnings;BEGIN {$Error::TypeTiny::WrongNumberOfParameters::AUTHORITY='cpan:TOBYINK';$Error::TypeTiny::WrongNumberOfParameters::VERSION='1.002001'}require Error::TypeTiny;our@ISA='Error::TypeTiny';sub minimum {$_[0]{minimum}};sub maximum {$_[0]{maximum}};sub got {$_[0]{got}};sub has_minimum {exists $_[0]{minimum}};sub has_maximum {exists $_[0]{maximum}};sub _build_message {my$e=shift;if ($e->has_minimum and $e->has_maximum and $e->minimum==$e->maximum){return sprintf("Wrong number of parameters; got %d; expected %d",$e->got,$e->minimum,)}elsif ($e->has_minimum and $e->has_maximum and $e->minimum < $e->maximum){return sprintf("Wrong number of parameters; got %d; expected %d to %d",$e->got,$e->minimum,$e->maximum,)}elsif ($e->has_minimum){return sprintf("Wrong number of parameters; got %d; expected at least %d",$e->got,$e->minimum,)}else {return sprintf("Wrong number of parameters; got %d",$e->got,)}}1; +ERROR_TYPETINY_WRONGNUMBEROFPARAMETERS + +$fatpacked{"Eval/TypeTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EVAL_TYPETINY'; + package Eval::TypeTiny;use strict;BEGIN {*HAS_LEXICAL_SUBS=($] >= 5.018)? sub(){!!1}: sub(){!!0}};{my$hlv;sub HAS_LEXICAL_VARS () {$hlv=!!eval {require Devel::LexAlias;exists(&Devel::LexAlias::lexalias)}unless defined$hlv;$hlv}}sub _clean_eval {local $@;local$SIG{__DIE__};my$r=eval $_[0];my$e=$@;return ($r,$e)}our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.002001';our@EXPORT=qw(eval_closure);our@EXPORT_OK=qw(HAS_LEXICAL_SUBS HAS_LEXICAL_VARS);sub import {no warnings "redefine";our@ISA=qw(Exporter::Tiny);require Exporter::Tiny;my$next=\&Exporter::Tiny::import;*import=$next;my$class=shift;my$opts={ref($_[0])? %{+shift}: ()};$opts->{into}||= scalar(caller);return$class->$next($opts,@_)}use warnings;sub eval_closure {my (%args)=@_;my$src=ref$args{source}eq "ARRAY" ? join("\n",@{$args{source}}): $args{source};$args{alias}=0 unless defined$args{alias};$args{line}=1 unless defined$args{line};$args{description}=~ s/[^\w .:-\[\]\(\)\{\}\']//g if defined$args{description};$src=qq{#line $args{line} "$args{description}"\n$src} if defined$args{description}&&!($^P & 0x10);$args{environment}||= {};my$sandpkg='Eval::TypeTiny::Sandbox';my$alias=exists($args{alias})? $args{alias}: 0;my@keys=sort keys %{$args{environment}};my$i=0;my$source=join "\n"=>("package $sandpkg;","sub {",map(_make_lexical_assignment($_,$i++,$alias),@keys),$src,"}",);_manufacture_ties()if$alias &&!HAS_LEXICAL_VARS;my ($compiler,$e)=_clean_eval($source);if ($e){chomp$e;require Error::TypeTiny::Compilation;"Error::TypeTiny::Compilation"->throw(code=>(ref$args{source}eq "ARRAY" ? join("\n",@{$args{source}}): $args{source}),errstr=>$e,environment=>$args{environment},)}my$code=$compiler->(@{$args{environment}}{@keys});undef($compiler);if ($alias && HAS_LEXICAL_VARS){Devel::LexAlias::lexalias($code,$_,$args{environment}{$_})for grep!/^\&/,@keys}return$code}my$tmp;sub _make_lexical_assignment {my ($key,$index,$alias)=@_;my$name=substr($key,1);if (HAS_LEXICAL_SUBS and $key =~ /^\&/){$tmp++;my$tmpname='$__LEXICAL_SUB__'.$tmp;return "no warnings 'experimental::lexical_subs';"."use feature 'lexical_subs';"."my $tmpname = \$_[$index];"."my sub $name { goto $tmpname };"}if (!$alias){my$sigil=substr($key,0,1);return "my $key = $sigil\{ \$_[$index] };"}elsif (HAS_LEXICAL_VARS){return "my $key;"}else {my$tieclass={'@'=>'Eval::TypeTiny::_TieArray','%'=>'Eval::TypeTiny::_TieHash','$'=>'Eval::TypeTiny::_TieScalar',}->{substr($key,0,1)};return sprintf('tie(my(%s), "%s", $_[%d]);',$key,$tieclass,$index,)}}{my$tie;sub _manufacture_ties {$tie ||= eval <<'FALLBACK'}}1; + no warnings qw(void once uninitialized numeric); + + { + package # + Eval::TypeTiny::_TieArray; + require Tie::Array; + our @ISA = qw( Tie::StdArray ); + sub TIEARRAY { + my $class = shift; + bless $_[0] => $class; + } + sub AUTOLOAD { + my $self = shift; + my ($method) = (our $AUTOLOAD =~ /(\w+)$/); + defined tied(@$self) and return tied(@$self)->$method(@_); + require Carp; + Carp::croak(qq[Can't call method "$method" on an undefined value]); + } + sub can { + my $self = shift; + my $code = $self->SUPER::can(@_) + || (defined tied(@$self) and tied(@$self)->can(@_)); + return $code; + } + use overload + q[bool] => sub { !! tied @{$_[0]} }, + q[""] => sub { '' . tied @{$_[0]} }, + q[0+] => sub { 0 + tied @{$_[0]} }, + fallback => 1, + ; + } + { + package # + Eval::TypeTiny::_TieHash; + require Tie::Hash; + our @ISA = qw( Tie::StdHash ); + sub TIEHASH { + my $class = shift; + bless $_[0] => $class; + } + sub AUTOLOAD { + my $self = shift; + my ($method) = (our $AUTOLOAD =~ /(\w+)$/); + defined tied(%$self) and return tied(%$self)->$method(@_); + require Carp; + Carp::croak(qq[Can't call method "$method" on an undefined value]); + } + sub can { + my $self = shift; + my $code = $self->SUPER::can(@_) + || (defined tied(%$self) and tied(%$self)->can(@_)); + return $code; + } + use overload + q[bool] => sub { !! tied %{$_[0]} }, + q[""] => sub { '' . tied %{$_[0]} }, + q[0+] => sub { 0 + tied %{$_[0]} }, + fallback => 1, + ; + } + { + package # + Eval::TypeTiny::_TieScalar; + require Tie::Scalar; + our @ISA = qw( Tie::StdScalar ); + sub TIESCALAR { + my $class = shift; + bless $_[0] => $class; + } + sub AUTOLOAD { + my $self = shift; + my ($method) = (our $AUTOLOAD =~ /(\w+)$/); + defined tied($$self) and return tied($$self)->$method(@_); + require Carp; + Carp::croak(qq[Can't call method "$method" on an undefined value]); + } + sub can { + my $self = shift; + my $code = $self->SUPER::can(@_) + || (defined tied($$self) and tied($$self)->can(@_)); + return $code; + } + use overload + q[bool] => sub { !! tied ${$_[0]} }, + q[""] => sub { '' . tied ${$_[0]} }, + q[0+] => sub { 0 + tied ${$_[0]} }, + fallback => 1, + ; + } + + 1; + FALLBACK +EVAL_TYPETINY + +$fatpacked{"Exporter/Shiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_SHINY'; + package Exporter::Shiny;use 5.006001;use strict;use warnings;use Exporter::Tiny ();our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.000000';sub import {my$me=shift;my$caller=caller;(my$nominal_file=$caller)=~ s(::)(/)g;$INC{"$nominal_file\.pm"}||= __FILE__;if (@_==2 and $_[0]eq -setup){my (undef,$opts)=@_;@_=@{delete($opts->{exports})|| []};if (%$opts){Exporter::Tiny::_croak('Unsupported Sub::Exporter-style options: %s',join(q[, ],sort keys %$opts),)}}ref($_)&& Exporter::Tiny::_croak('Expected sub name, got ref %s',$_)for @_;no strict qw(refs);push @{"$caller\::ISA"},'Exporter::Tiny';push @{"$caller\::EXPORT_OK"},@_}1; +EXPORTER_SHINY + +$fatpacked{"Exporter/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_TINY'; + package Exporter::Tiny;use 5.006001;use strict;use warnings;no warnings qw(void once uninitialized numeric redefine);our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.000000';our@EXPORT_OK=qw<mkopt mkopt_hash _croak _carp>;sub _croak ($;@) {require Carp;my$fmt=shift;@_=sprintf($fmt,@_);goto \&Carp::croak}sub _carp ($;@) {require Carp;my$fmt=shift;@_=sprintf($fmt,@_);goto \&Carp::carp}my$_process_optlist=sub {my$class=shift;my ($global_opts,$opts,$want,$not_want)=@_;while (@$opts){my$opt=shift @{$opts};my ($name,$value)=@$opt;($name =~ m{\A\!(/.+/[msixpodual]+)\z})? do {my@not=$class->_exporter_expand_regexp($1,$value,$global_opts);++$not_want->{$_->[0]}for@not}: ($name =~ m{\A\!(.+)\z})? (++$not_want->{$1}): ($name =~ m{\A[:-](.+)\z})? push(@$opts,$class->_exporter_expand_tag($1,$value,$global_opts)): ($name =~ m{\A/.+/[msixpodual]+\z})? push(@$opts,$class->_exporter_expand_regexp($name,$value,$global_opts)): push(@$want,$opt)}};sub import {my$class=shift;my$global_opts=+{@_ && ref($_[0])eq q(HASH) ? %{+shift}: ()};$global_opts->{into}=caller unless exists$global_opts->{into};my@want;my%not_want;$global_opts->{not}=\%not_want;my@args=do {no strict qw(refs);@_ ? @_ : @{"$class\::EXPORT"}};my$opts=mkopt(\@args);$class->$_process_optlist($global_opts,$opts,\@want,\%not_want);my$permitted=$class->_exporter_permitted_regexp($global_opts);$class->_exporter_validate_opts($global_opts);for my$wanted (@want){next if$not_want{$wanted->[0]};my%symbols=$class->_exporter_expand_sub(@$wanted,$global_opts,$permitted);$class->_exporter_install_sub($_,$wanted->[1],$global_opts,$symbols{$_})for keys%symbols}}sub unimport {my$class=shift;my$global_opts=+{@_ && ref($_[0])eq q(HASH) ? %{+shift}: ()};$global_opts->{into}=caller unless exists$global_opts->{into};$global_opts->{is_unimport}=1;my@want;my%not_want;$global_opts->{not}=\%not_want;my@args=do {our%TRACKED;@_ ? @_ : keys(%{$TRACKED{$class}{$global_opts->{into}}})};my$opts=mkopt(\@args);$class->$_process_optlist($global_opts,$opts,\@want,\%not_want);my$permitted=$class->_exporter_permitted_regexp($global_opts);$class->_exporter_validate_unimport_opts($global_opts);my$expando=$class->can('_exporter_expand_sub');$expando=undef if$expando==\&_exporter_expand_sub;for my$wanted (@want){next if$not_want{$wanted->[0]};if ($wanted->[1]){_carp("Passing options to unimport '%s' makes no sense",$wanted->[0])unless (ref($wanted->[1])eq 'HASH' and not keys %{$wanted->[1]})}my%symbols=defined($expando)? $class->$expando(@$wanted,$global_opts,$permitted): ($wanted->[0]=>sub {"dummy"});$class->_exporter_uninstall_sub($_,$wanted->[1],$global_opts)for keys%symbols}}sub _exporter_validate_opts {1}sub _exporter_validate_unimport_opts {1}sub _exporter_merge_opts {my$class=shift;my ($tag_opts,$global_opts,@stuff)=@_;$tag_opts={}unless ref($tag_opts)eq q(HASH);_croak('Cannot provide an -as option for tags')if exists$tag_opts->{-as}&& ref$tag_opts->{-as}ne 'CODE';my$optlist=mkopt(\@stuff);for my$export (@$optlist){next if defined($export->[1])&& ref($export->[1])ne q(HASH);my%sub_opts=(%{$export->[1]or {}},%$tag_opts);$sub_opts{-prefix}=sprintf('%s%s',$tag_opts->{-prefix},$export->[1]{-prefix})if exists($export->[1]{-prefix})&& exists($tag_opts->{-prefix});$sub_opts{-suffix}=sprintf('%s%s',$export->[1]{-suffix},$tag_opts->{-suffix})if exists($export->[1]{-suffix})&& exists($tag_opts->{-suffix});$export->[1]=\%sub_opts}return @$optlist}sub _exporter_expand_tag {no strict qw(refs);my$class=shift;my ($name,$value,$globals)=@_;my$tags=\%{"$class\::EXPORT_TAGS"};return$class->_exporter_merge_opts($value,$globals,$tags->{$name}->($class,@_))if ref($tags->{$name})eq q(CODE);return$class->_exporter_merge_opts($value,$globals,@{$tags->{$name}})if exists$tags->{$name};return$class->_exporter_merge_opts($value,$globals,@{"$class\::EXPORT"},@{"$class\::EXPORT_OK"})if$name eq 'all';return$class->_exporter_merge_opts($value,$globals,@{"$class\::EXPORT"})if$name eq 'default';$globals->{$name}=$value || 1;return}sub _exporter_expand_regexp {no strict qw(refs);our%TRACKED;my$class=shift;my ($name,$value,$globals)=@_;my$compiled=eval("qr$name");my@possible=$globals->{is_unimport}? keys(%{$TRACKED{$class}{$globals->{into}}}): @{"$class\::EXPORT_OK"};$class->_exporter_merge_opts($value,$globals,grep /$compiled/,@possible)}sub _exporter_permitted_regexp {no strict qw(refs);my$class=shift;my$re=join "|",map quotemeta,sort {length($b)<=> length($a)or $a cmp $b}@{"$class\::EXPORT"},@{"$class\::EXPORT_OK"};qr{^(?:$re)$}ms}sub _exporter_expand_sub {my$class=shift;my ($name,$value,$globals,$permitted)=@_;$permitted ||= $class->_exporter_permitted_regexp($globals);no strict qw(refs);if ($name =~ $permitted){my$generator=$class->can("_generate_$name");return$name=>$class->$generator($name,$value,$globals)if$generator;my$sub=$class->can($name);return$name=>$sub if$sub}$class->_exporter_fail(@_)}sub _exporter_fail {my$class=shift;my ($name,$value,$globals)=@_;return if$globals->{is_unimport};_croak("Could not find sub '%s' exported by %s",$name,$class)}sub _exporter_install_sub {my$class=shift;my ($name,$value,$globals,$sym)=@_;my$into=$globals->{into};my$installer=$globals->{installer}|| $globals->{exporter};$name=ref$globals->{as}? $globals->{as}->($name): ref$value->{-as}? $value->{-as}->($name): exists$value->{-as}? $value->{-as}: $name;return unless defined$name;unless (ref($name)){my ($prefix)=grep defined,$value->{-prefix},$globals->{prefix},q();my ($suffix)=grep defined,$value->{-suffix},$globals->{suffix},q();$name="$prefix$name$suffix"}return ($$name=$sym)if ref($name)eq q(SCALAR);return ($into->{$name}=$sym)if ref($into)eq q(HASH);no strict qw(refs);if (exists &{"$into\::$name"}and \&{"$into\::$name"}!=$sym){my ($level)=grep defined,$value->{-replace},$globals->{replace},q(0);my$action={carp=>\&_carp,0=>\&_carp,''=>\&_carp,warn=>\&_carp,nonfatal=>\&_carp,croak=>\&_croak,fatal=>\&_croak,die=>\&_croak,}->{$level}|| sub {};$action->($action==\&_croak ? "Refusing to overwrite existing sub '%s::%s' with sub '%s' exported by %s" : "Overwriting existing sub '%s::%s' with sub '%s' exported by %s",$into,$name,$_[0],$class,)}our%TRACKED;$TRACKED{$class}{$into}{$name}=$sym;no warnings qw(prototype);$installer ? $installer->($globals,[$name,$sym]): (*{"$into\::$name"}=$sym)}sub _exporter_uninstall_sub {our%TRACKED;my$class=shift;my ($name,$value,$globals,$sym)=@_;my$into=$globals->{into};ref$into and return;no strict qw(refs);my$our_coderef=$TRACKED{$class}{$into}{$name};my$cur_coderef=exists(&{"$into\::$name"})? \&{"$into\::$name"}: -1;return unless$our_coderef==$cur_coderef;my$stash=\%{"$into\::"};my$old=delete$stash->{$name};my$full_name=join('::',$into,$name);for my$type (qw(SCALAR HASH ARRAY IO)){next unless defined(*{$old}{$type});*$full_name=*{$old}{$type}}delete$TRACKED{$class}{$into}{$name}}sub mkopt {my$in=shift or return [];my@out;$in=[map(($_=>ref($in->{$_})? $in->{$_}: ()),sort keys %$in)]if ref($in)eq q(HASH);for (my$i=0;$i < @$in;$i++){my$k=$in->[$i];my$v;($i==$#$in)? ($v=undef): !defined($in->[$i+1])? (++$i,($v=undef)): !ref($in->[$i+1])? ($v=undef): ($v=$in->[++$i]);push@out,[$k=>$v ]}\@out}sub mkopt_hash {my$in=shift or return;my%out=map +($_->[0]=>$_->[1]),@{mkopt($in)};\%out}1; +EXPORTER_TINY + +$fatpacked{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH'; + package File::Which;use strict;use warnings;use Exporter ();use File::Spec ();our$VERSION='1.22';our@ISA='Exporter';our@EXPORT='which';our@EXPORT_OK='where';use constant IS_VMS=>($^O eq 'VMS');use constant IS_MAC=>($^O eq 'MacOS');use constant IS_DOS=>($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');use constant IS_CYG=>($^O eq 'cygwin' || $^O eq 'msys');my@PATHEXT=('');if (IS_DOS){if ($ENV{PATHEXT}){push@PATHEXT,split ';',$ENV{PATHEXT}}else {push@PATHEXT,qw{.com .exe .bat}}}elsif (IS_VMS){push@PATHEXT,qw{.exe .com}}elsif (IS_CYG){push@PATHEXT,qw{.exe .com}}sub which {my ($exec)=@_;return undef unless defined$exec;return undef if$exec eq '';my$all=wantarray;my@results=();if (IS_VMS){my$symbol=`SHOW SYMBOL $exec`;chomp($symbol);unless ($?){return$symbol unless$all;push@results,$symbol}}if (IS_MAC){my@aliases=split /\,/,$ENV{Aliases};for my$alias (@aliases){if (lc($alias)eq lc($exec)){chomp(my$file=`Alias $alias`);last unless$file;return$file unless$all;push@results,$file;last}}}return$exec if!IS_VMS and!IS_MAC and!IS_DOS and $exec =~ /\// and -f $exec and -x $exec;my@path=File::Spec->path;if (IS_DOS or IS_VMS or IS_MAC){unshift@path,File::Spec->curdir}for my$base (map {File::Spec->catfile($_,$exec)}@path){for my$ext (@PATHEXT){my$file=$base.$ext;next if -d $file;if (-x _ or (IS_MAC || ((IS_DOS or IS_CYG)and grep {$file =~ /$_\z/i}@PATHEXT[1..$#PATHEXT])and -e _)){return$file unless$all;push@results,$file}}}if ($all){return@results}else {return undef}}sub where {my@res=which($_[0]);return@res}1; +FILE_WHICH + +$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD'; + use strict;use warnings;package File::pushd;our$VERSION='1.014';our@EXPORT=qw(pushd tempd);our@ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub {File::Spec->canonpath($_[0]->{_pushd})},fallback=>1;sub pushd {unless (defined wantarray){warnings::warnif(void=>'Useless use of File::pushd::pushd in void context');return}my ($target_dir,$options)=@_;$options->{untaint_pattern}||= qr{^([-+@\w./]+)$};$target_dir="." unless defined$target_dir;croak "Can't locate directory $target_dir" unless -d $target_dir;my$tainted_orig=getcwd;my$orig;if ($tainted_orig =~ $options->{untaint_pattern}){$orig=$1}else {$orig=$tainted_orig}my$tainted_dest;eval {$tainted_dest=$target_dir ? abs_path($target_dir): $orig};croak "Can't locate absolute path for $target_dir: $@" if $@;my$dest;if ($tainted_dest =~ $options->{untaint_pattern}){$dest=$1}else {$dest=$tainted_dest}if ($dest ne $orig){chdir$dest or croak "Can't chdir to $dest\: $!"}my$self=bless {_pushd=>$dest,_original=>$orig },__PACKAGE__;return$self}sub tempd {unless (defined wantarray){warnings::warnif(void=>'Useless use of File::pushd::tempd in void context');return}my ($options)=@_;my$dir;eval {$dir=pushd(File::Temp::tempdir(CLEANUP=>0),$options)};croak $@ if $@;$dir->{_tempd}=1;return$dir}sub preserve {my$self=shift;return 1 if!$self->{"_tempd"};if (@_==0){return$self->{_preserve}=1}else {return$self->{_preserve}=$_[0]? 1 : 0}}sub DESTROY {my ($self)=@_;my$orig=$self->{_original};chdir$orig if$orig;if ($self->{_tempd}&&!$self->{_preserve}){my$err=do {local $@;eval {rmtree($self->{_pushd})};$@};carp$err if$err}}1; +FILE_PUSHD + +$fatpacked{"Getopt/Long/Subcommand.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG_SUBCOMMAND'; + package Getopt::Long::Subcommand;our$DATE='2017-08-12';our$VERSION='0.102';use 5.010001;use strict;use warnings;require Exporter;our@ISA=qw(Exporter);our@EXPORT=qw(GetOptions);my@known_cmdspec_keys=qw(options subcommands default_subcommand summary description completion configure);sub _cmdspec_opts_to_gl_ospec {my ($cmdspec_opts,$is_completion,$res)=@_;return {map {if ($is_completion){($_=>sub{})}else {my$k=$_;my$v=$cmdspec_opts->{$k};my$handler=ref($v)eq 'HASH' ? $v->{handler}: $v;if (ref($handler)eq 'CODE'){my$orig_handler=$handler;$handler=sub {my ($cb,$val)=@_;$orig_handler->($cb,$val,$res)}}($k=>$handler)}}keys %$cmdspec_opts }}sub _gl_getoptions {require Getopt::Long;my ($ospec,$configure,$pass_through,$res)=@_;my@configure=@{$configure // ['no_ignore_case','no_getopt_compat','gnu_compat','bundling']};if ($pass_through){push@configure,'pass_through' unless grep {$_ eq 'pass_through'}@configure}else {@configure=grep {$_ ne 'pass_through'}@configure}my$old_conf=Getopt::Long::Configure(@configure);local$SIG{__WARN__}=sub {}if$pass_through;local$res->{_non_options_argv}=[];my$gl_res=Getopt::Long::GetOptions(%$ospec,'<>'=>sub {push @{$res->{_non_options_argv}},$_[0]},);@ARGV=@{$res->{_non_options_argv}};Getopt::Long::Configure($old_conf);$gl_res}sub _GetOptions {my ($cmdspec,$is_completion,$res,$stash)=@_;$res //= {success=>undef};$stash //= {path=>'',level=>0,};{for my$k (keys %$cmdspec){(grep {$_ eq $k}@known_cmdspec_keys)or die "Unknown command specification key '$k'" .($stash->{path}? " (under $stash->{path})" : "")."\n"}}my$has_subcommands=$cmdspec->{subcommands}&& keys(%{$cmdspec->{subcommands}});my$pass_through=$has_subcommands || $is_completion;my$ospec=_cmdspec_opts_to_gl_ospec($cmdspec->{options},$is_completion,$res);unless (_gl_getoptions($ospec,$cmdspec->{configure},$pass_through,$res)){$res->{success}=0;return$res}if ($is_completion){$res->{comp_ospec}//= {};for (keys %$ospec){$res->{comp_ospec}{$_}=$ospec->{$_}}}if ($has_subcommands){if ($is_completion){$res->{comp_subcommand_names}[$stash->{level}]=[sort keys %{$cmdspec->{subcommands}}]}$res->{subcommand}//= [];my$push;my$sc_name;if (defined$res->{subcommand}[$stash->{level}]){$sc_name=$res->{subcommand}[$stash->{level}]}elsif (@ARGV){$sc_name=shift@ARGV;$push++}elsif (defined$cmdspec->{default_subcommand}){$sc_name=$cmdspec->{default_subcommand};$push++}else {$res->{success}=1;return$res}if ($is_completion){push @{$res->{comp_subcommand_name}},$sc_name}my$sc_spec=$cmdspec->{subcommands}{$sc_name};unless ($sc_spec){warn "Unknown subcommand '$sc_name'".($stash->{path}? " for $stash->{path}":"")."\n" unless$is_completion;$res->{success}=0;return$res};push @{$res->{subcommand}},$sc_name if$push;local$stash->{path}=($stash->{path}? "/" : "").$sc_name;local$stash->{level}=$stash->{level}+1;_GetOptions($sc_spec,$is_completion,$res,$stash)}$res->{success}//= 1;$res}sub GetOptions {my%cmdspec=@_;my ($is_completion,$shell,$words,$cword);CHECK_COMPLETION: {if ($ENV{COMP_SHELL}){($shell=$ENV{COMP_SHELL})=~ s!.+/!!}elsif ($ENV{COMMAND_LINE}){$shell='tcsh'}else {$shell='bash'}if ($ENV{COMP_LINE}|| $ENV{COMMAND_LINE}){if ($ENV{COMP_LINE}){$is_completion++;require Complete::Bash;($words,$cword)=@{Complete::Bash::parse_cmdline(undef,undef,{truncate_current_word=>1})};($words,$cword)=@{Complete::Bash::join_wordbreak_words($words,$cword)}}elsif ($ENV{COMMAND_LINE}){$is_completion++;require Complete::Tcsh;$shell='tcsh';($words,$cword)=@{Complete::Tcsh::parse_cmdline()}}else {last CHECK_COMPLETION}shift @$words;$cword--;@ARGV=@$words}}my$res=_GetOptions(\%cmdspec,$is_completion);if ($is_completion){my$ospec=$res->{comp_ospec};require Complete::Getopt::Long;my$compres=Complete::Getopt::Long::complete_cli_arg(words=>$words,cword=>$cword,getopt_spec=>$ospec,extras=>{stash=>$res->{stash},},bundling=>do {if (!$cmdspec{configure}){1}elsif (grep {$_ eq 'bundling'}@{$cmdspec{configure}}){1}elsif (grep {$_ eq 'no_bundling'}@{$cmdspec{configure}}){0}else {0}},completion=>sub {my%args=@_;my$word=$args{word}// '';my$type=$args{type};my$stash=$args{stash};if ($type eq 'arg' && $args{argpos}< @{$res->{comp_subcommand_names}//[]}){require Complete::Util;return Complete::Util::complete_array_elem(array=>$res->{comp_subcommand_names}[$args{argpos}],word=>$res->{comp_subcommand_name}[$args{argpos}],)}$args{getopt_res}=$res;$args{subcommand}=$res->{comp_subcommand_name};$cmdspec{completion}->(%args)if$cmdspec{completion}},);if ($shell eq 'bash'){print Complete::Bash::format_completion($compres)}elsif ($shell eq 'tcsh'){print Complete::Tcsh::format_completion($compres)}else {die "Unknown shell '$shell'"}exit 0}$res}1; +GETOPT_LONG_SUBCOMMAND + +$fatpacked{"Graph.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH'; + package Graph;use strict;use warnings;no warnings 'redefine';BEGIN {if (0){$SIG{__DIE__ }=\&__carp_confess;$SIG{__WARN__}=\&__carp_confess}sub __carp_confess {require Carp;Carp::confess(@_)}}use Graph::AdjacencyMap qw(:flags :fields);use vars qw($VERSION);$VERSION='0.9704';require 5.006;my$can_deep_copy_Storable=eval {require Storable;require B::Deparse;Storable->VERSION(2.05);B::Deparse->VERSION(0.61);1};sub _can_deep_copy_Storable () {return$can_deep_copy_Storable}use Graph::AdjacencyMap::Heavy;use Graph::AdjacencyMap::Light;use Graph::AdjacencyMap::Vertex;use Graph::UnionFind;use Graph::TransitiveClosure;use Graph::Traversal::DFS;use Graph::MSTHeapElem;use Graph::SPTHeapElem;use Graph::Undirected;use Heap071::Fibonacci;use List::Util qw(shuffle first);use Scalar::Util qw(weaken);use Safe;sub _F () {0}sub _G () {1}sub _V () {2}sub _E () {3}sub _A () {4}sub _U () {5}sub _S () {6}sub _P () {7}my$Inf;BEGIN {if ($] >= 5.022){$Inf=eval '+"Inf"'}else {local$SIG{FPE};eval {$Inf=exp(999)}|| eval {$Inf=9**9**9}|| eval {$Inf=1e+999}|| {$Inf=1e+99 }}}sub Infinity () {$Inf}use Graph::Attribute array=>_A,map=>'graph';sub _COMPAT02 () {0x00000001}sub stringify {my$g=shift;my$u=$g->is_undirected;my$e=$u ? '=' : '-';my@e=map {my@v=map {ref($_)eq 'ARRAY' ? "[" .join(" ",@$_)."]" : "$_"}@$_;join($e,$u ? sort {"$a" cmp "$b"}@v : @v)}$g->edges05;my@s=sort {"$a" cmp "$b"}@e;push@s,sort {"$a" cmp "$b"}$g->isolated_vertices;join(",",@s)}sub eq {"$_[0]" eq "$_[1]"}sub boolify {1}sub ne {"$_[0]" ne "$_[1]"}use overload '""'=>\&stringify,'bool'=>\&boolify,'eq'=>\&eq,'ne'=>\≠sub _opt {my ($opt,$flags,%flags)=@_;while (my ($flag,$FLAG)=each%flags){if (exists$opt->{$flag}){$$flags |= $FLAG if$opt->{$flag};delete$opt->{$flag}}if (exists$opt->{my$non="non$flag"}){$$flags &= ~$FLAG if$opt->{$non};delete$opt->{$non}}}}sub is_compat02 {my ($g)=@_;$g->[_F ]& _COMPAT02}*compat02=\&is_compat02;sub has_union_find {my ($g)=@_;($g->[_F ]& _UNIONFIND)&& defined$g->[_U ]}sub _get_union_find {my ($g)=@_;$g->[_U ]}sub _opt_get {my ($opt,$key,$var)=@_;if (exists$opt->{$key}){$$var=$opt->{$key};delete$opt->{$key}}}sub _opt_unknown {my ($opt)=@_;if (my@opt=keys %$opt){my$f=(caller(1))[3];require Carp;Carp::confess(sprintf "$f: Unknown option%s: @{[map { qq['$_'] } sort @opt]}",@opt > 1 ? 's' : '')}}sub new {my$class=shift;my$gflags=0;my$vflags;my$eflags;my%opt=_get_options(\@_);if (ref$class && $class->isa('Graph')){no strict 'refs';for my$c (qw(undirected refvertexed compat02 hypervertexed countvertexed multivertexed hyperedged countedged multiedged omniedged __stringified)){if (&{"Graph::$c"}($class)){$opt{$c}++}}if (&{"Graph::has_union_find"}($class)){$opt{unionfind}++}}_opt_get(\%opt,undirected=>\$opt{omniedged});_opt_get(\%opt,omnidirected=>\$opt{omniedged});if (exists$opt{directed}){$opt{omniedged}=!$opt{directed};delete$opt{directed}}my$vnonomni=$opt{nonomnivertexed}|| (exists$opt{omnivertexed}&&!$opt{omnivertexed});my$vnonuniq=$opt{nonuniqvertexed}|| (exists$opt{uniqvertexed}&&!$opt{uniqvertexed});_opt(\%opt,\$vflags,countvertexed=>_COUNT,multivertexed=>_MULTI,hypervertexed=>_HYPER,omnivertexed=>_UNORD,uniqvertexed=>_UNIQ,refvertexed=>_REF,refvertexed_stringified=>_REFSTR,__stringified=>_STR,);_opt(\%opt,\$eflags,countedged=>_COUNT,multiedged=>_MULTI,hyperedged=>_HYPER,omniedged=>_UNORD,uniqedged=>_UNIQ,);_opt(\%opt,\$gflags,compat02=>_COMPAT02,unionfind=>_UNIONFIND,);if (exists$opt{vertices_unsorted}){my$unsorted=$opt{vertices_unsorted};delete$opt{vertices_unsorted};require Carp;Carp::confess("Graph: vertices_unsorted must be true")unless$unsorted}my@V;if ($opt{vertices}){require Carp;Carp::confess("Graph: vertices should be an array ref")unless ref$opt{vertices}eq 'ARRAY';@V=@{$opt{vertices}};delete$opt{vertices}}my@E;if ($opt{edges}){unless (ref$opt{edges}eq 'ARRAY'){require Carp;Carp::confess("Graph: edges should be an array ref of array refs")}@E=@{$opt{edges}};delete$opt{edges}}_opt_unknown(\%opt);my$uflags;if (defined$vflags){$uflags=$vflags;$uflags |= _UNORD unless$vnonomni;$uflags |= _UNIQ unless$vnonuniq}else {$uflags=_UNORDUNIQ;$vflags=0}if (!($vflags & _HYPER)&& ($vflags & _UNORDUNIQ)){my@but;push@but,'unordered' if ($vflags & _UNORD);push@but,'unique' if ($vflags & _UNIQ);require Carp;Carp::confess(sprintf "Graph: not hypervertexed but %s",join(' and ',@but))}unless (defined$eflags){$eflags=($gflags & _COMPAT02)? _COUNT : 0}if (!($vflags & _HYPER)&& ($vflags & _UNIQ)){require Carp;Carp::confess("Graph: not hypervertexed but uniqvertexed")}if (($vflags & _COUNT)&& ($vflags & _MULTI)){require Carp;Carp::confess("Graph: both countvertexed and multivertexed")}if (($eflags & _COUNT)&& ($eflags & _MULTI)){require Carp;Carp::confess("Graph: both countedged and multiedged")}my$g=bless [],ref$class || $class;$g->[_F ]=$gflags;$g->[_G ]=0;$g->[_V ]=($vflags & (_HYPER | _MULTI))? Graph::AdjacencyMap::Heavy->_new($uflags,1): (($vflags & ~_UNORD)? Graph::AdjacencyMap::Vertex->_new($uflags,1): Graph::AdjacencyMap::Light->_new($g,$uflags,1));$g->[_E ]=(($vflags & _HYPER)|| ($eflags & ~_UNORD))? Graph::AdjacencyMap::Heavy->_new($eflags,2): Graph::AdjacencyMap::Light->_new($g,$eflags,2);$g->add_vertices(@V)if@V;if (@E){for my$e (@E){unless (ref$e eq 'ARRAY'){require Carp;Carp::confess("Graph: edges should be array refs")}$g->add_edge(@$e)}}if (($gflags & _UNIONFIND)){$g->[_U ]=Graph::UnionFind->new}return$g}sub countvertexed {$_[0]->[_V ]->_is_COUNT}sub multivertexed {$_[0]->[_V ]->_is_MULTI}sub hypervertexed {$_[0]->[_V ]->_is_HYPER}sub omnivertexed {$_[0]->[_V ]->_is_UNORD}sub uniqvertexed {$_[0]->[_V ]->_is_UNIQ}sub refvertexed {$_[0]->[_V ]->_is_REF}sub refvertexed_stringified {$_[0]->[_V ]->_is_REFSTR}sub __stringified {$_[0]->[_V ]->_is_STR}sub countedged {$_[0]->[_E ]->_is_COUNT}sub multiedged {$_[0]->[_E ]->_is_MULTI}sub hyperedged {$_[0]->[_E ]->_is_HYPER}sub omniedged {$_[0]->[_E ]->_is_UNORD}sub uniqedged {$_[0]->[_E ]->_is_UNIQ}*undirected=\&omniedged;*omnidirected=\&omniedged;sub directed {!$_[0]->[_E ]->_is_UNORD}*is_directed=\&directed;*is_undirected=\&undirected;*is_countvertexed=\&countvertexed;*is_multivertexed=\&multivertexed;*is_hypervertexed=\&hypervertexed;*is_omnidirected=\&omnidirected;*is_uniqvertexed=\&uniqvertexed;*is_refvertexed=\&refvertexed;*is_refvertexed_stringified=\&refvertexed_stringified;*is_countedged=\&countedged;*is_multiedged=\&multiedged;*is_hyperedged=\&hyperedged;*is_omniedged=\&omniedged;*is_uniqedged=\&uniqedged;sub _union_find_add_vertex {my ($g,$v)=@_;my$UF=$g->[_U ];$UF->add($g->[_V ]->_get_path_id($v))}sub add_vertex {my$g=shift;if (@_!=1){$g->expect_hypervertexed}if ($g->is_multivertexed){return$g->add_vertex_by_id(@_,_GEN_ID)}my@r;if (@_ > 1){unless ($g->is_countvertexed || $g->is_hypervertexed){require Carp;Carp::croak("Graph::add_vertex: use add_vertices for more than one vertex or use hypervertexed")}for my$v (@_){if (defined$v){$g->[_V ]->set_path($v)unless$g->has_vertex($v)}else {require Carp;Carp::croak("Graph::add_vertex: undef vertex")}}}for my$v (@_){unless (defined$v){require Carp;Carp::croak("Graph::add_vertex: undef vertex")}}$g->[_V ]->set_path(@_);$g->[_G ]++;$g->_union_find_add_vertex(@_)if$g->has_union_find;return$g}sub has_vertex {my$g=shift;my$V=$g->[_V ];return exists$V->[_s ]->{$_[0]}if ($V->[_f ]& _LIGHT);$V->has_path(@_)}sub vertices05 {my$g=shift;my@v=$g->[_V ]->paths(@_);if (wantarray){return$g->[_V ]->_is_HYPER ? @v : map {ref $_ eq 'ARRAY' ? @$_ : $_}@v}else {return scalar@v}}sub vertices {my$g=shift;my@v=$g->vertices05;if ($g->is_compat02){wantarray ? sort@v : scalar@v}else {if ($g->is_multivertexed || $g->is_countvertexed){if (wantarray){my@V;for my$v (@v){push@V,($v)x $g->get_vertex_count($v)}return@V}else {my$V=0;for my$v (@v){$V += $g->get_vertex_count($v)}return$V}}else {return@v}}}*vertices_unsorted=\&vertices_unsorted;sub unique_vertices {my$g=shift;my@v=$g->vertices05;if ($g->is_compat02){wantarray ? sort@v : scalar@v}else {return@v}}sub has_vertices {my$g=shift;scalar$g->[_V ]->has_paths(@_)}sub _add_edge {my$g=shift;my$V=$g->[_V ];my@e;if (($V->[_f ])& _LIGHT){for my$v (@_){$g->add_vertex($v)unless exists$V->[_s ]->{$v };push@e,$V->[_s ]->{$v }}}else {my$h=$g->[_V ]->_is_HYPER;for my$v (@_){my@v=ref$v eq 'ARRAY' && $h ? @$v : $v;$g->add_vertex(@v)unless$V->has_path(@v);push@e,$V->_get_path_id(@v)}}return@e}sub _union_find_add_edge {my ($g,$u,$v)=@_;$g->[_U ]->union($u,$v)}sub add_edge {my$g=shift;if (@_!=2){$g->expect_hyperedged}if ($g->is_multiedged){unless (@_==2 || $g->is_hyperedged){require Carp;Carp::croak("Graph::add_edge: use add_edges for more than one edge")}return$g->add_edge_by_id(@_,_GEN_ID)}my@e=$g->_add_edge(@_);$g->[_E ]->set_path(@e);$g->[_G ]++;$g->_union_find_add_edge(@e)if$g->has_union_find;return$g}sub _vertex_ids {my$g=shift;my$V=$g->[_V ];my@e;if (($V->[_f ]& _LIGHT)){for my$v (@_){return ()unless exists$V->[_s ]->{$v };push@e,$V->[_s ]->{$v }}}else {my$h=$g->[_V ]->_is_HYPER;for my$v (@_){my@v=ref$v eq 'ARRAY' && $h ? @$v : $v;return ()unless$V->has_path(@v);push@e,$V->_get_path_id(@v)}}return@e}sub has_edge {my$g=shift;my$E=$g->[_E ];my$V=$g->[_V ];my@i;if (($V->[_f ]& _LIGHT)&& @_==2){return 0 unless exists$V->[_s ]->{$_[0]}&& exists$V->[_s ]->{$_[1]};@i=@{$V->[_s ]}{@_[0,1 ]}}else {@i=$g->_vertex_ids(@_);return 0 if@i==0 && @_}my$f=$E->[_f ];if ($E->[_a ]==2 && @i==2 &&!($f & (_HYPER|_REF|_UNIQ))){@i=sort@i if ($f & _UNORD);return exists$E->[_s ]->{$i[0]}&& exists$E->[_s ]->{$i[0]}->{$i[1]}? 1 : 0}else {return defined$E->_get_path_id(@i)? 1 : 0}}sub edges05 {my$g=shift;my$V=$g->[_V ];my@e=$g->[_E ]->paths(@_);wantarray ? map {[map {my@v=$V->_get_id_path($_);@v==1 ? $v[0]: [@v ]}@$_ ]}@e : @e}sub edges02 {my$g=shift;if (@_ && defined $_[0]){unless (defined $_[1]){my@e=$g->edges_at($_[0]);wantarray ? map {@$_}sort {$a->[0]cmp $b->[0]|| $a->[1]cmp $b->[1]}@e : @e}else {die "edges02: unimplemented option"}}else {my@e=map {($_)x $g->get_edge_count(@$_)}$g->edges05(@_);wantarray ? map {@$_}sort {$a->[0]cmp $b->[0]|| $a->[1]cmp $b->[1]}@e : @e}}sub unique_edges {my$g=shift;($g->is_compat02)? $g->edges02(@_): $g->edges05(@_)}sub edges {my$g=shift;if ($g->is_compat02){return$g->edges02(@_)}else {if ($g->is_multiedged || $g->is_countedged){if (wantarray){my@E;for my$e ($g->edges05){push@E,($e)x $g->get_edge_count(@$e)}return@E}else {my$E=0;for my$e ($g->edges05){$E += $g->get_edge_count(@$e)}return$E}}else {return$g->edges05}}}sub has_edges {my$g=shift;scalar$g->[_E ]->has_paths(@_)}sub add_vertex_by_id {my$g=shift;$g->expect_multivertexed;$g->[_V ]->set_path_by_multi_id(@_);$g->[_G ]++;$g->_union_find_add_vertex(@_)if$g->has_union_find;return$g}sub add_vertex_get_id {my$g=shift;$g->expect_multivertexed;my$id=$g->[_V ]->set_path_by_multi_id(@_,_GEN_ID);$g->[_G ]++;$g->_union_find_add_vertex(@_)if$g->has_union_find;return$id}sub has_vertex_by_id {my$g=shift;$g->expect_multivertexed;$g->[_V ]->has_path_by_multi_id(@_)}sub delete_vertex_by_id {my$g=shift;$g->expect_multivertexed;$g->expect_non_unionfind;my$V=$g->[_V ];return unless$V->has_path_by_multi_id(@_);$V->del_path_by_multi_id(@_);$g->[_G ]++;return$g}sub get_multivertex_ids {my$g=shift;$g->expect_multivertexed;$g->[_V ]->get_multi_ids(@_)}sub add_edge_by_id {my$g=shift;$g->expect_multiedged;my$id=pop;my@e=$g->_add_edge(@_);$g->[_E ]->set_path_by_multi_id(@e,$id);$g->[_G ]++;$g->_union_find_add_edge(@e)if$g->has_union_find;return$g}sub add_edge_get_id {my$g=shift;$g->expect_multiedged;my@i=$g->_add_edge(@_);my$id=$g->[_E ]->set_path_by_multi_id(@i,_GEN_ID);$g->_union_find_add_edge(@i)if$g->has_union_find;$g->[_G ]++;return$id}sub has_edge_by_id {my$g=shift;$g->expect_multiedged;my$id=pop;my@i=$g->_vertex_ids(@_);return 0 if@i==0 && @_;$g->[_E ]->has_path_by_multi_id(@i,$id)}sub delete_edge_by_id {my$g=shift;$g->expect_multiedged;$g->expect_non_unionfind;my$V=$g->[_E ];my$id=pop;my@i=$g->_vertex_ids(@_);return unless$V->has_path_by_multi_id(@i,$id);$V->del_path_by_multi_id(@i,$id);$g->[_G ]++;return$g}sub get_multiedge_ids {my$g=shift;$g->expect_multiedged;my@id=$g->_vertex_ids(@_);return unless@id;$g->[_E ]->get_multi_ids(@id)}sub vertices_at {my$g=shift;my$V=$g->[_V ];return @_ unless ($V->[_f ]& _HYPER);my%v;my@i;for my$v (@_){my$i=$V->_get_path_id($v);return unless defined$i;push@i,($v{$v }=$i)}my$Vi=$V->_ids;my@v;while (my ($i,$v)=each %{$Vi}){my%i;my$h=$V->[_f ]& _HYPER;@i{@i }=@i if@i;for my$u (ref$v eq 'ARRAY' && $h ? @$v : $v){my$j=exists$v{$u }? $v{$u }: ($v{$u }=$i);if (defined$j && exists$i{$j }){delete$i{$j };unless (keys%i){push@v,$v;last}}}}return@v}sub _edges_at {my$g=shift;my$V=$g->[_V ];my$E=$g->[_E ];my@e;my$en=0;my%ev;my$h=$V->[_f ]& _HYPER;for my$v ($h ? $g->vertices_at(@_): @_){my$vi=$V->_get_path_id(ref$v eq 'ARRAY' && $h ? @$v : $v);next unless defined$vi;my$Ei=$E->_ids;while (my ($ei,$ev)=each %{$Ei}){if (wantarray){for my$j (@$ev){push@e,[$ei,$ev ]if$j==$vi &&!$ev{$ei}++}}else {for my$j (@$ev){$en++ if$j==$vi}}}}return wantarray ? @e : $en}sub _edges {my$g=shift;my$n=pop;my$i=$n==_S ? 0 : -1;my$V=$g->[_V ];my$E=$g->[_E ];my$N=$g->[$n ];my$h=$V->[_f ]& _HYPER;unless (defined$N && $N->[0 ]==$g->[_G ]){$g->[$n ]->[1 ]={};$N=$g->[$n ];my$u=$E->[_f ]& _UNORD;my$Ei=$E->_ids;while (my ($ei,$ev)=each %{$Ei}){next unless @$ev;my$e=[$ei,$ev ];if ($u){push @{$N->[1 ]->{$ev->[0]}},$e;push @{$N->[1 ]->{$ev->[-1]}},$e}else {my$e=[$ei,$ev ];push @{$N->[1 ]->{$ev->[$i]}},$e}}$N->[0 ]=$g->[_G ]}my@e;my@at=$h ? $g->vertices_at(@_): @_;my%at;@at{@at}=();for my$v (@at){my$vi=$V->_get_path_id(ref$v eq 'ARRAY' && $h ? @$v : $v);next unless defined$vi && exists$N->[1 ]->{$vi };push@e,@{$N->[1 ]->{$vi }}}if (wantarray && $g->is_undirected){my@i=map {$V->_get_path_id($_)}@_;for my$e (@e){unless ($e->[1 ]->[$i ]==$i[$i ]){$e=[$e->[0 ],[reverse @{$e->[1 ]}]]}}}return@e}sub _edges_from {push @_,_S;goto&_edges}sub _edges_to {push @_,_P;goto&_edges}sub _edges_id_path {my$g=shift;my$V=$g->[_V ];[map {my@v=$V->_get_id_path($_);@v==1 ? $v[0]: [@v ]}@{$_[0]->[1]}]}sub edges_at {my$g=shift;map {$g->_edges_id_path($_)}$g->_edges_at(@_)}sub edges_from {my$g=shift;map {$g->_edges_id_path($_)}$g->_edges_from(@_)}sub edges_to {my$g=shift;map {$g->_edges_id_path($_)}$g->_edges_to(@_)}sub successors {my$g=shift;my$E=$g->[_E ];($E->[_f ]& _LIGHT)? $E->_successors($g,@_): Graph::AdjacencyMap::_successors($E,$g,@_)}sub predecessors {my$g=shift;my$E=$g->[_E ];($E->[_f ]& _LIGHT)? $E->_predecessors($g,@_): Graph::AdjacencyMap::_predecessors($E,$g,@_)}sub _all_successors {my$g=shift;my@init=@_;my%todo;@todo{@init}=@init;my%seen;my%init=%todo;my%self;while (keys%todo){my@todo=values%todo;for my$t (@todo){$seen{$t}=delete$todo{$t};for my$s ($g->successors($t)){$self{$s}=$s if exists$init{$s};$todo{$s}=$s unless exists$seen{$s}}}}for my$v (@init){delete$seen{$v}unless$g->has_edge($v,$v)|| $self{$v}}return values%seen}sub all_successors {my$g=shift;$g->expect_directed;return$g->_all_successors(@_)}sub _all_predecessors {my$g=shift;my@init=@_;my%todo;@todo{@init}=@init;my%seen;my%init=%todo;my%self;while (keys%todo){my@todo=values%todo;for my$t (@todo){$seen{$t}=delete$todo{$t};for my$p ($g->predecessors($t)){$self{$p}=$p if exists$init{$p};$todo{$p}=$p unless exists$seen{$p}}}}for my$v (@init){delete$seen{$v}unless$g->has_edge($v,$v)|| $self{$v}}return values%seen}sub all_predecessors {my$g=shift;$g->expect_directed;return$g->_all_predecessors(@_)}sub neighbours {my$g=shift;my$V=$g->[_V ];my@s=map {my@v=@{$_->[1 ]};shift@v;@v}$g->_edges_from(@_);my@p=map {my@v=@{$_->[1 ]};pop@v;@v}$g->_edges_to (@_);my%n;@n{@s }=@s;@n{@p }=@p;map {$V->_get_id_path($_)}keys%n}*neighbors=\&neighbours;sub all_neighbours {my$g=shift;my@init=@_;my@v=@init;my%n;my$o=0;while (1){my@p=$g->_all_predecessors(@v);my@s=$g->_all_successors(@v);@n{@p}=@p;@n{@s}=@s;@v=values%n;last if@v==$o;$o=@v}for my$v (@init){delete$n{$v}unless$g->has_edge($v,$v)}return values%n}*all_neighbors=\&all_neighbours;sub all_reachable {my$g=shift;$g->directed ? $g->all_successors(@_): $g->all_neighbors(@_)}sub delete_edge {my$g=shift;$g->expect_non_unionfind;my@i=$g->_vertex_ids(@_);return$g unless@i;my$i=$g->[_E ]->_get_path_id(@i);return$g unless defined$i;$g->[_E ]->_del_id($i);$g->[_G ]++;return$g}sub delete_vertex {my$g=shift;$g->expect_non_unionfind;my$V=$g->[_V ];return$g unless$V->has_path(@_);if (@_==1 &&!($g->[_f ]& (_HYPER|_REF|_UNIQ))){$g->delete_edge($_[0],$_)for$g->successors($_[0]);$g->delete_edge($_,$_[0])for$g->predecessors($_[0])}else {my$E=$g->[_E ];for my$e ($g->_edges_at(@_)){$E->_del_id($e->[0 ])}}$V->del_path(@_);$g->[_G ]++;return$g}sub get_vertex_count {my$g=shift;$g->[_V ]->_get_path_count(@_)|| 0}sub get_edge_count {my$g=shift;my@e=$g->_vertex_ids(@_);return 0 unless@e;$g->[_E ]->_get_path_count(@e)|| 0}sub delete_vertices {my$g=shift;$g->expect_non_unionfind;while (@_){my$v=shift @_;$g->delete_vertex($v)}return$g}sub delete_edges {my$g=shift;$g->expect_non_unionfind;while (@_){my ($u,$v)=splice @_,0,2;$g->delete_edge($u,$v)}return$g}sub _in_degree {my$g=shift;return undef unless @_ && $g->has_vertex(@_);my$in=0;$in += $g->get_edge_count(@$_)for$g->edges_to(@_);return$in}sub in_degree {my$g=shift;$g->_in_degree(@_)}sub _out_degree {my$g=shift;return undef unless @_ && $g->has_vertex(@_);my$out=0;$out += $g->get_edge_count(@$_)for$g->edges_from(@_);return$out}sub out_degree {my$g=shift;$g->_out_degree(@_)}sub _total_degree {my$g=shift;return undef unless @_ && $g->has_vertex(@_);$g->is_undirected ? $g->_in_degree(@_): $g-> in_degree(@_)- $g-> out_degree(@_)}sub degree {my$g=shift;if (@_){$g->_total_degree(@_)}elsif ($g->is_undirected){my$total=0;$total += $g->_total_degree($_)for$g->vertices05;return$total}else {return 0}}*vertex_degree=\°ree;sub is_sink_vertex {my$g=shift;return 0 unless @_;$g->successors(@_)==0 && $g->predecessors(@_)> 0}sub is_source_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)==0 && $g->successors(@_)> 0}sub is_successorless_vertex {my$g=shift;return 0 unless @_;$g->successors(@_)==0}sub is_predecessorless_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)==0}sub is_successorful_vertex {my$g=shift;return 0 unless @_;$g->successors(@_)> 0}sub is_predecessorful_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)> 0}sub is_isolated_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)==0 && $g->successors(@_)==0}sub is_interior_vertex {my$g=shift;return 0 unless @_;my$p=$g->predecessors(@_);my$s=$g->successors(@_);if ($g->is_self_loop_vertex(@_)){$p--;$s--}$p > 0 && $s > 0}sub is_exterior_vertex {my$g=shift;return 0 unless @_;$g->predecessors(@_)==0 || $g->successors(@_)==0}sub is_self_loop_vertex {my$g=shift;return 0 unless @_;for my$s ($g->successors(@_)){return 1 if$s eq $_[0]}return 0}sub sink_vertices {my$g=shift;grep {$g->is_sink_vertex($_)}$g->vertices05}sub source_vertices {my$g=shift;grep {$g->is_source_vertex($_)}$g->vertices05}sub successorless_vertices {my$g=shift;grep {$g->is_successorless_vertex($_)}$g->vertices05}sub predecessorless_vertices {my$g=shift;grep {$g->is_predecessorless_vertex($_)}$g->vertices05}sub successorful_vertices {my$g=shift;grep {$g->is_successorful_vertex($_)}$g->vertices05}sub predecessorful_vertices {my$g=shift;grep {$g->is_predecessorful_vertex($_)}$g->vertices05}sub isolated_vertices {my$g=shift;grep {$g->is_isolated_vertex($_)}$g->vertices05}sub interior_vertices {my$g=shift;grep {$g->is_interior_vertex($_)}$g->vertices05}sub exterior_vertices {my$g=shift;grep {$g->is_exterior_vertex($_)}$g->vertices05}sub self_loop_vertices {my$g=shift;grep {$g->is_self_loop_vertex($_)}$g->vertices05}sub add_path {my$g=shift;my$u=shift;while (@_){my$v=shift;$g->add_edge($u,$v);$u=$v}return$g}sub delete_path {my$g=shift;$g->expect_non_unionfind;my$u=shift;while (@_){my$v=shift;$g->delete_edge($u,$v);$u=$v}return$g}sub has_path {my$g=shift;my$u=shift;while (@_){my$v=shift;return 0 unless$g->has_edge($u,$v);$u=$v}return$g}sub add_cycle {my$g=shift;$g->add_path(@_,$_[0])}sub delete_cycle {my$g=shift;$g->expect_non_unionfind;$g->delete_path(@_,$_[0])}sub has_cycle {my$g=shift;@_ ? ($g->has_path(@_,$_[0])? 1 : 0): 0}*has_this_cycle=\&has_cycle;sub has_a_cycle {my$g=shift;my@r=(back_edge=>\&Graph::Traversal::has_a_cycle);push@r,down_edge=>\&Graph::Traversal::has_a_cycle if$g->is_undirected;my$t=Graph::Traversal::DFS->new($g,@r,@_);$t->dfs;return$t->get_state('has_a_cycle')}sub find_a_cycle {my$g=shift;my@r=(back_edge=>\&Graph::Traversal::find_a_cycle);push@r,down_edge=>\&Graph::Traversal::find_a_cycle if$g->is_undirected;my$t=Graph::Traversal::DFS->new($g,@r,@_);$t->dfs;$t->has_state('a_cycle')? @{$t->get_state('a_cycle')}: ()}sub set_vertex_attribute {my$g=shift;$g->expect_non_multivertexed;my$value=pop;my$attr=pop;$g->add_vertex(@_)unless$g->has_vertex(@_);$g->[_V ]->_set_path_attr(@_,$attr,$value)}sub set_vertex_attribute_by_id {my$g=shift;$g->expect_multivertexed;my$value=pop;my$attr=pop;$g->add_vertex_by_id(@_)unless$g->has_vertex_by_id(@_);$g->[_V ]->_set_path_attr(@_,$attr,$value)}sub set_vertex_attributes {my$g=shift;$g->expect_non_multivertexed;my$attr=pop;$g->add_vertex(@_)unless$g->has_vertex(@_);$g->[_V ]->_set_path_attrs(@_,$attr)}sub set_vertex_attributes_by_id {my$g=shift;$g->expect_multivertexed;my$attr=pop;$g->add_vertex_by_id(@_)unless$g->has_vertex_by_id(@_);$g->[_V ]->_set_path_attrs(@_,$attr)}sub has_vertex_attributes {my$g=shift;$g->expect_non_multivertexed;return 0 unless$g->has_vertex(@_);$g->[_V ]->_has_path_attrs(@_)}sub has_vertex_attributes_by_id {my$g=shift;$g->expect_multivertexed;return 0 unless$g->has_vertex_by_id(@_);$g->[_V ]->_has_path_attrs(@_)}sub has_vertex_attribute {my$g=shift;$g->expect_non_multivertexed;my$attr=pop;return 0 unless$g->has_vertex(@_);$g->[_V ]->_has_path_attr(@_,$attr)}sub has_vertex_attribute_by_id {my$g=shift;$g->expect_multivertexed;my$attr=pop;return 0 unless$g->has_vertex_by_id(@_);$g->[_V ]->_has_path_attr(@_,$attr)}sub get_vertex_attributes {my$g=shift;$g->expect_non_multivertexed;return unless$g->has_vertex(@_);my$a=$g->[_V ]->_get_path_attrs(@_);($g->is_compat02)? (defined$a ? %{$a}: ()): $a}sub get_vertex_attributes_by_id {my$g=shift;$g->expect_multivertexed;return unless$g->has_vertex_by_id(@_);$g->[_V ]->_get_path_attrs(@_)}sub get_vertex_attribute {my$g=shift;$g->expect_non_multivertexed;my$attr=pop;return unless$g->has_vertex(@_);$g->[_V ]->_get_path_attr(@_,$attr)}sub get_vertex_attribute_by_id {my$g=shift;$g->expect_multivertexed;my$attr=pop;return unless$g->has_vertex_by_id(@_);$g->[_V ]->_get_path_attr(@_,$attr)}sub get_vertex_attribute_names {my$g=shift;$g->expect_non_multivertexed;return unless$g->has_vertex(@_);$g->[_V ]->_get_path_attr_names(@_)}sub get_vertex_attribute_names_by_id {my$g=shift;$g->expect_multivertexed;return unless$g->has_vertex_by_id(@_);$g->[_V ]->_get_path_attr_names(@_)}sub get_vertex_attribute_values {my$g=shift;$g->expect_non_multivertexed;return unless$g->has_vertex(@_);$g->[_V ]->_get_path_attr_values(@_)}sub get_vertex_attribute_values_by_id {my$g=shift;$g->expect_multivertexed;return unless$g->has_vertex_by_id(@_);$g->[_V ]->_get_path_attr_values(@_)}sub delete_vertex_attributes {my$g=shift;$g->expect_non_multivertexed;return undef unless$g->has_vertex(@_);$g->[_V ]->_del_path_attrs(@_)}sub delete_vertex_attributes_by_id {my$g=shift;$g->expect_multivertexed;return undef unless$g->has_vertex_by_id(@_);$g->[_V ]->_del_path_attrs(@_)}sub delete_vertex_attribute {my$g=shift;$g->expect_non_multivertexed;my$attr=pop;return undef unless$g->has_vertex(@_);$g->[_V ]->_del_path_attr(@_,$attr)}sub delete_vertex_attribute_by_id {my$g=shift;$g->expect_multivertexed;my$attr=pop;return undef unless$g->has_vertex_by_id(@_);$g->[_V ]->_del_path_attr(@_,$attr)}sub _set_edge_attribute {my$g=shift;my$value=pop;my$attr=pop;my$E=$g->[_E ];my$f=$E->[_f ];my@i;if ($E->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){@_=sort @_ if ($f & _UNORD);my$s=$E->[_s ];$g->add_edge(@_)unless exists$s->{$_[0]}&& exists$s->{$_[0]}->{$_[1]};@i=@{$g->[_V ]->[_s ]}{@_ }}else {$g->add_edge(@_)unless$g->has_edge(@_);@i=$g->_vertex_ids(@_)}$g->[_E ]->_set_path_attr(@i,$attr,$value)}sub set_edge_attribute {my$g=shift;$g->expect_non_multiedged;my$value=pop;my$attr=pop;my$E=$g->[_E ];$g->add_edge(@_)unless$g->has_edge(@_);$E->_set_path_attr($g->_vertex_ids(@_),$attr,$value)}sub set_edge_attribute_by_id {my$g=shift;$g->expect_multiedged;my$value=pop;my$attr=pop;my$id=pop;$g->[_E ]->_set_path_attr($g->_vertex_ids(@_),$id,$attr,$value)}sub set_edge_attributes {my$g=shift;$g->expect_non_multiedged;my$attr=pop;$g->add_edge(@_)unless$g->has_edge(@_);$g->[_E ]->_set_path_attrs($g->_vertex_ids(@_),$attr)}sub set_edge_attributes_by_id {my$g=shift;$g->expect_multiedged;my$attr=pop;$g->add_edge_by_id(@_)unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_set_path_attrs($g->_vertex_ids(@_),$id,$attr)}sub has_edge_attributes {my$g=shift;$g->expect_non_multiedged;return 0 unless$g->has_edge(@_);$g->[_E ]->_has_path_attrs($g->_vertex_ids(@_))}sub has_edge_attributes_by_id {my$g=shift;$g->expect_multiedged;return 0 unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_has_path_attrs($g->_vertex_ids(@_),$id)}sub has_edge_attribute {my$g=shift;$g->expect_non_multiedged;my$attr=pop;return 0 unless$g->has_edge(@_);$g->[_E ]->_has_path_attr($g->_vertex_ids(@_),$attr)}sub has_edge_attribute_by_id {my$g=shift;$g->expect_multiedged;my$attr=pop;return 0 unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_has_path_attr($g->_vertex_ids(@_),$id,$attr)}sub get_edge_attributes {my$g=shift;$g->expect_non_multiedged;return unless$g->has_edge(@_);my$a=$g->[_E ]->_get_path_attrs($g->_vertex_ids(@_));($g->is_compat02)? (defined$a ? %{$a}: ()): $a}sub get_edge_attributes_by_id {my$g=shift;$g->expect_multiedged;return unless$g->has_edge_by_id(@_);my$id=pop;return$g->[_E ]->_get_path_attrs($g->_vertex_ids(@_),$id)}sub _get_edge_attribute {my$g=shift;my$attr=pop;my$E=$g->[_E ];my$f=$E->[_f ];if ($E->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){@_=sort @_ if ($f & _UNORD);my$s=$E->[_s ];return unless exists$s->{$_[0]}&& exists$s->{$_[0]}->{$_[1]}}else {return unless$g->has_edge(@_)}my@i=$g->_vertex_ids(@_);$E->_get_path_attr(@i,$attr)}sub get_edge_attribute {my$g=shift;$g->expect_non_multiedged;my$attr=pop;return undef unless$g->has_edge(@_);my@i=$g->_vertex_ids(@_);return undef if@i==0 && @_;my$E=$g->[_E ];$E->_get_path_attr(@i,$attr)}sub get_edge_attribute_by_id {my$g=shift;$g->expect_multiedged;my$attr=pop;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_get_path_attr($g->_vertex_ids(@_),$id,$attr)}sub get_edge_attribute_names {my$g=shift;$g->expect_non_multiedged;return unless$g->has_edge(@_);$g->[_E ]->_get_path_attr_names($g->_vertex_ids(@_))}sub get_edge_attribute_names_by_id {my$g=shift;$g->expect_multiedged;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_get_path_attr_names($g->_vertex_ids(@_),$id)}sub get_edge_attribute_values {my$g=shift;$g->expect_non_multiedged;return unless$g->has_edge(@_);$g->[_E ]->_get_path_attr_values($g->_vertex_ids(@_))}sub get_edge_attribute_values_by_id {my$g=shift;$g->expect_multiedged;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_get_path_attr_values($g->_vertex_ids(@_),$id)}sub delete_edge_attributes {my$g=shift;$g->expect_non_multiedged;return unless$g->has_edge(@_);$g->[_E ]->_del_path_attrs($g->_vertex_ids(@_))}sub delete_edge_attributes_by_id {my$g=shift;$g->expect_multiedged;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_del_path_attrs($g->_vertex_ids(@_),$id)}sub delete_edge_attribute {my$g=shift;$g->expect_non_multiedged;my$attr=pop;return unless$g->has_edge(@_);$g->[_E ]->_del_path_attr($g->_vertex_ids(@_),$attr)}sub delete_edge_attribute_by_id {my$g=shift;$g->expect_multiedged;my$attr=pop;return unless$g->has_edge_by_id(@_);my$id=pop;$g->[_E ]->_del_path_attr($g->_vertex_ids(@_),$id,$attr)}sub vertex {my$g=shift;$g->has_vertex(@_)? @_ : undef}sub out_edges {my$g=shift;return unless @_ && $g->has_vertex(@_);my@e=$g->edges_from(@_);wantarray ? map {@$_}@e : @e}sub in_edges {my$g=shift;return unless @_ && $g->has_vertex(@_);my@e=$g->edges_to(@_);wantarray ? map {@$_}@e : @e}sub add_vertices {my$g=shift;$g->add_vertex($_)for @_;return$g}sub add_edges {my$g=shift;while (@_){my$u=shift @_;if (ref$u eq 'ARRAY'){$g->add_edge(@$u)}else {if (@_){my$v=shift @_;$g->add_edge($u,$v)}else {require Carp;Carp::croak("Graph::add_edges: missing end vertex")}}}return$g}sub copy {my$g=shift;my%opt=_get_options(\@_);my$c=(ref$g)->new(map {$_=>$g->$_ ? 1 : 0}qw(directed compat02 refvertexed hypervertexed countvertexed multivertexed hyperedged countedged multiedged omniedged __stringified));for my$v ($g->isolated_vertices){$c->add_vertex($v)}for my$e ($g->edges05){$c->add_edge(@$e)}return$c}*copy_graph=\©sub _deep_copy_Storable {my$g=shift;my$safe=new Safe;local$Storable::Deparse=1;local$Storable::Eval=sub {$safe->reval($_[0])};return Storable::thaw(Storable::freeze($g))}sub _deep_copy_DataDumper {my$g=shift;my$d=Data::Dumper->new([$g]);use vars qw($VAR1);$d->Purity(1)->Terse(1)->Deepcopy(1);$d->Deparse(1)if $] >= 5.008;eval$d->Dump}sub deep_copy {if (_can_deep_copy_Storable()){return _deep_copy_Storable(@_)}else {return _deep_copy_DataDumper(@_)}}*deep_copy_graph=\&deep_copy;sub transpose_edge {my$g=shift;if ($g->is_directed){return undef unless$g->has_edge(@_);my$c=$g->get_edge_count(@_);my$a=$g->get_edge_attributes(@_);my@e=reverse @_;$g->delete_edge(@_)unless$g->has_edge(@e);$g->add_edge(@e)for 1..$c;$g->set_edge_attributes(@e,$a)if$a}return$g}sub transpose_graph {my$g=shift;my$t=$g->copy;if ($t->directed){for my$e ($t->edges05){$t->transpose_edge(@$e)}}return$t}*transpose=\&transpose_graph;sub complete_graph {my$g=shift;my$c=$g->new(directed=>$g->directed);my@v=$g->vertices05;for (my$i=0;$i <= $#v;$i++ ){for (my$j=0;$j <= $#v;$j++ ){next if$i >= $j;if ($g->is_undirected){$c->add_edge($v[$i],$v[$j])}else {$c->add_edge($v[$i],$v[$j]);$c->add_edge($v[$j],$v[$i])}}}return$c}*complement=\&complement_graph;sub complement_graph {my$g=shift;my$c=$g->new(directed=>$g->directed);my@v=$g->vertices05;for (my$i=0;$i <= $#v;$i++ ){for (my$j=0;$j <= $#v;$j++ ){next if$i >= $j;if ($g->is_undirected){$c->add_edge($v[$i],$v[$j])unless$g->has_edge($v[$i],$v[$j])}else {$c->add_edge($v[$i],$v[$j])unless$g->has_edge($v[$i],$v[$j]);$c->add_edge($v[$j],$v[$i])unless$g->has_edge($v[$j],$v[$i])}}}return$c}*complete=\&complete_graph;sub subgraph {my ($g,$src,$dst)=@_;$dst=$src unless defined$dst;unless (ref$src eq 'ARRAY' && ref$dst eq 'ARRAY'){Carp::croak("Graph::subgraph: need src and dst array references")}my$s=$g->new;my@u=grep {$g->has_vertex($_)}@$src;my@v=grep {$g->has_vertex($_)}@$dst;$s->add_vertices(@u,@v);for my$u (@u){my@e;for my$v (@v){if ($g->has_edge($u,$v)){push@e,[$u,$v]}}$s->add_edges(@e)}return$s}sub is_transitive {my$g=shift;Graph::TransitiveClosure::is_transitive($g)}my$defattr='weight';sub _defattr {return$defattr}sub add_weighted_vertex {my$g=shift;$g->expect_non_multivertexed;my$w=pop;$g->add_vertex(@_);$g->set_vertex_attribute(@_,$defattr,$w)}sub add_weighted_vertices {my$g=shift;$g->expect_non_multivertexed;while (@_){my ($v,$w)=splice @_,0,2;$g->add_vertex($v);$g->set_vertex_attribute($v,$defattr,$w)}}sub get_vertex_weight {my$g=shift;$g->expect_non_multivertexed;$g->get_vertex_attribute(@_,$defattr)}sub has_vertex_weight {my$g=shift;$g->expect_non_multivertexed;$g->has_vertex_attribute(@_,$defattr)}sub set_vertex_weight {my$g=shift;$g->expect_non_multivertexed;my$w=pop;$g->set_vertex_attribute(@_,$defattr,$w)}sub delete_vertex_weight {my$g=shift;$g->expect_non_multivertexed;$g->delete_vertex_attribute(@_,$defattr)}sub add_weighted_vertex_by_id {my$g=shift;$g->expect_multivertexed;my$w=pop;$g->add_vertex_by_id(@_);$g->set_vertex_attribute_by_id(@_,$defattr,$w)}sub add_weighted_vertices_by_id {my$g=shift;$g->expect_multivertexed;my$id=pop;while (@_){my ($v,$w)=splice @_,0,2;$g->add_vertex_by_id($v,$id);$g->set_vertex_attribute_by_id($v,$id,$defattr,$w)}}sub get_vertex_weight_by_id {my$g=shift;$g->expect_multivertexed;$g->get_vertex_attribute_by_id(@_,$defattr)}sub has_vertex_weight_by_id {my$g=shift;$g->expect_multivertexed;$g->has_vertex_attribute_by_id(@_,$defattr)}sub set_vertex_weight_by_id {my$g=shift;$g->expect_multivertexed;my$w=pop;$g->set_vertex_attribute_by_id(@_,$defattr,$w)}sub delete_vertex_weight_by_id {my$g=shift;$g->expect_multivertexed;$g->delete_vertex_attribute_by_id(@_,$defattr)}sub add_weighted_edge {my$g=shift;$g->expect_non_multiedged;if ($g->is_compat02){my$w=splice @_,1,1;$g->add_edge(@_);$g->set_edge_attribute(@_,$defattr,$w)}else {my$w=pop;$g->add_edge(@_);$g->set_edge_attribute(@_,$defattr,$w)}}sub add_weighted_edges {my$g=shift;$g->expect_non_multiedged;if ($g->is_compat02){while (@_){my ($u,$w,$v)=splice @_,0,3;$g->add_edge($u,$v);$g->set_edge_attribute($u,$v,$defattr,$w)}}else {while (@_){my ($u,$v,$w)=splice @_,0,3;$g->add_edge($u,$v);$g->set_edge_attribute($u,$v,$defattr,$w)}}}sub add_weighted_edges_by_id {my$g=shift;$g->expect_multiedged;my$id=pop;while (@_){my ($u,$v,$w)=splice @_,0,3;$g->add_edge_by_id($u,$v,$id);$g->set_edge_attribute_by_id($u,$v,$id,$defattr,$w)}}sub add_weighted_path {my$g=shift;$g->expect_non_multiedged;my$u=shift;while (@_){my ($w,$v)=splice @_,0,2;$g->add_edge($u,$v);$g->set_edge_attribute($u,$v,$defattr,$w);$u=$v}}sub get_edge_weight {my$g=shift;$g->expect_non_multiedged;$g->get_edge_attribute(@_,$defattr)}sub has_edge_weight {my$g=shift;$g->expect_non_multiedged;$g->has_edge_attribute(@_,$defattr)}sub set_edge_weight {my$g=shift;$g->expect_non_multiedged;my$w=pop;$g->set_edge_attribute(@_,$defattr,$w)}sub delete_edge_weight {my$g=shift;$g->expect_non_multiedged;$g->delete_edge_attribute(@_,$defattr)}sub add_weighted_edge_by_id {my$g=shift;$g->expect_multiedged;if ($g->is_compat02){my$w=splice @_,1,1;$g->add_edge_by_id(@_);$g->set_edge_attribute_by_id(@_,$defattr,$w)}else {my$w=pop;$g->add_edge_by_id(@_);$g->set_edge_attribute_by_id(@_,$defattr,$w)}}sub add_weighted_path_by_id {my$g=shift;$g->expect_multiedged;my$id=pop;my$u=shift;while (@_){my ($w,$v)=splice @_,0,2;$g->add_edge_by_id($u,$v,$id);$g->set_edge_attribute_by_id($u,$v,$id,$defattr,$w);$u=$v}}sub get_edge_weight_by_id {my$g=shift;$g->expect_multiedged;$g->get_edge_attribute_by_id(@_,$defattr)}sub has_edge_weight_by_id {my$g=shift;$g->expect_multiedged;$g->has_edge_attribute_by_id(@_,$defattr)}sub set_edge_weight_by_id {my$g=shift;$g->expect_multiedged;my$w=pop;$g->set_edge_attribute_by_id(@_,$defattr,$w)}sub delete_edge_weight_by_id {my$g=shift;$g->expect_multiedged;$g->delete_edge_attribute_by_id(@_,$defattr)}my%expected;@expected{qw(directed undirected acyclic)}=qw(undirected directed cyclic);sub _expected {my$exp=shift;my$got=@_ ? shift : $expected{$exp};$got=defined$got ? ", got $got" : "";if (my@caller2=caller(2)){die "$caller2[3]: expected $exp graph$got, at $caller2[1] line $caller2[2].\n"}else {my@caller1=caller(1);die "$caller1[3]: expected $exp graph$got, at $caller1[1] line $caller1[2].\n"}}sub expect_no_args {my$g=shift;return unless @_;my@caller1=caller(1);die "$caller1[3]: expected no arguments, got " .scalar @_ .", at $caller1[1] line $caller1[2]\n"}sub expect_undirected {my$g=shift;_expected('undirected')unless$g->is_undirected}sub expect_directed {my$g=shift;_expected('directed')unless$g->is_directed}sub expect_acyclic {my$g=shift;_expected('acyclic')unless$g->is_acyclic}sub expect_dag {my$g=shift;my@got;push@got,'undirected' unless$g->is_directed;push@got,'cyclic' unless$g->is_acyclic;_expected('directed acyclic',"@got")if@got}sub expect_hypervertexed {my$g=shift;_expected('hypervertexed')unless$g->is_hypervertexed}sub expect_hyperedged {my$g=shift;_expected('hyperedged')unless$g->is_hyperedged}sub expect_multivertexed {my$g=shift;_expected('multivertexed')unless$g->is_multivertexed}sub expect_non_multivertexed {my$g=shift;_expected('non-multivertexed')if$g->is_multivertexed}sub expect_non_multiedged {my$g=shift;_expected('non-multiedged')if$g->is_multiedged}sub expect_multiedged {my$g=shift;_expected('multiedged')unless$g->is_multiedged}sub expect_non_unionfind {my$g=shift;_expected('non-unionfind')if$g->has_union_find}sub _get_options {my@caller=caller(1);unless (@_==1 && ref $_[0]eq 'ARRAY'){die "$caller[3]: internal error: should be called with only one array ref argument, at $caller[1] line $caller[2].\n"}my@opt=@{$_[0]};unless (@opt % 2==0){die "$caller[3]: expected an options hash, got a non-even number of arguments, at $caller[1] line $caller[2].\n"}return@opt}sub __fisher_yates_shuffle (@) {my@a=@_;my$i=@a;while ($i--){my$j=int rand ($i+1);@a[$i,$j]=@a[$j,$i]}return@a}BEGIN {sub _shuffle(@);*_shuffle=$^P && $] < 5.009003 ? \&__fisher_yates_shuffle : \&List::Util::shuffle}sub random_graph {my$class=(@_ % 2)==0 ? 'Graph' : shift;my%opt=_get_options(\@_);my$random_edge;unless (exists$opt{vertices}&& defined$opt{vertices}){require Carp;Carp::croak("Graph::random_graph: argument 'vertices' missing or undef")}if (exists$opt{random_seed}){srand($opt{random_seed});delete$opt{random_seed}}if (exists$opt{random_edge}){$random_edge=$opt{random_edge};delete$opt{random_edge}}my@V;if (my$ref=ref$opt{vertices}){if ($ref eq 'ARRAY'){@V=@{$opt{vertices}}}else {Carp::croak("Graph::random_graph: argument 'vertices' illegal")}}else {@V=0..($opt{vertices}- 1)}delete$opt{vertices};my$V=@V;my$C=$V * ($V - 1)/ 2;my$E;if (exists$opt{edges}&& exists$opt{edges_fill}){Carp::croak("Graph::random_graph: both arguments 'edges' and 'edges_fill' specified")}$E=exists$opt{edges_fill}? $opt{edges_fill}* $C : $opt{edges};delete$opt{edges};delete$opt{edges_fill};my$g=$class->new(%opt);$g->add_vertices(@V);return$g if$V < 2;$C *= 2 if$g->directed;$E=$C / 2 unless defined$E;$E=int($E + 0.5);my$p=$E / $C;$random_edge=sub {$p}unless defined$random_edge;if ($p > 1.0 &&!($g->countedged || $g->multiedged)){require Carp;Carp::croak("Graph::random_graph: needs to be countedged or multiedged ($E > $C)")}my@V1=@V;my@V2=@V;@V1=_shuffle@V1;@V2=_shuffle@V2;LOOP: while ($E){for my$v1 (@V1){for my$v2 (@V2){next if$v1 eq $v2;my$q=$random_edge->($g,$v1,$v2,$p);if ($q && ($q==1 || rand()<= $q)&& !$g->has_edge($v1,$v2)){$g->add_edge($v1,$v2);$E--;last LOOP unless$E}}}}return$g}sub random_vertex {my$g=shift;my@V=$g->vertices05;@V[rand@V]}sub random_edge {my$g=shift;my@E=$g->edges05;@E[rand@E]}sub random_successor {my ($g,$v)=@_;my@S=$g->successors($v);@S[rand@S]}sub random_predecessor {my ($g,$v)=@_;my@P=$g->predecessors($v);@P[rand@P]}my$MST_comparator=sub {($_[0]|| 0)<=> ($_[1]|| 0)};sub _MST_attr {my$attr=shift;my$attribute=exists$attr->{attribute}? $attr->{attribute}: $defattr;my$comparator=exists$attr->{comparator}? $attr->{comparator}: $MST_comparator;return ($attribute,$comparator)}sub _MST_edges {my ($g,$attr)=@_;my ($attribute,$comparator)=_MST_attr($attr);map {$_->[1]}sort {$comparator->($a->[0],$b->[0],$a->[1],$b->[1])}map {[$g->get_edge_attribute(@$_,$attribute),$_ ]}$g->edges05}sub MST_Kruskal {my ($g,%attr)=@_;$g->expect_undirected;my$MST=Graph::Undirected->new;my$UF=Graph::UnionFind->new;for my$v ($g->vertices05){$UF->add($v)}for my$e ($g->_MST_edges(\%attr)){my ($u,$v)=@$e;my$t0=$UF->find($u);my$t1=$UF->find($v);unless ($t0 eq $t1){$UF->union($u,$v);$MST->add_edge($u,$v)}}return$MST}sub _MST_add {my ($g,$h,$HF,$r,$attr,$unseen)=@_;for my$s (grep {exists$unseen->{$_ }}$g->successors($r)){$HF->add(Graph::MSTHeapElem->new($r,$s,$g->get_edge_attribute($r,$s,$attr)))}}sub _next_alphabetic {shift;(sort keys %{$_[0]})[0]}sub _next_numeric {shift;(sort {$a <=> $b}keys %{$_[0]})[0]}sub _next_random {shift;(values %{$_[0]})[rand keys %{$_[0]}]}sub _root_opt {my$g=shift;my%opt=@_==1 ? (first_root=>$_[0]): _get_options(\@_);my%unseen;my@unseen=$g->vertices05;@unseen{@unseen }=@unseen;@unseen=_shuffle@unseen;my$r;if (exists$opt{start }){$opt{first_root }=$opt{start };$opt{next_root }=undef}if (exists$opt{get_next_root }){$opt{next_root }=$opt{get_next_root }}if (exists$opt{first_root }){if (ref$opt{first_root }eq 'CODE'){$r=$opt{first_root }->($g,\%unseen)}else {$r=$opt{first_root }}}else {$r=shift@unseen}my$next=exists$opt{next_root }? $opt{next_root }: $opt{next_alphabetic }? \&_next_alphabetic : $opt{next_numeric }? \&_next_numeric : \&_next_random;my$code=ref$next eq 'CODE';my$attr=exists$opt{attribute }? $opt{attribute }: $defattr;return (\%opt,\%unseen,\@unseen,$r,$next,$code,$attr)}sub _heap_walk {my ($g,$h,$add,$etc)=splice @_,0,4;my ($opt,$unseenh,$unseena,$r,$next,$code,$attr)=$g->_root_opt(@_);my$HF=Heap071::Fibonacci->new;while (defined$r){$add->($g,$h,$HF,$r,$attr,$unseenh,$etc);delete$unseenh->{$r };while (defined$HF->top){my$t=$HF->extract_top;if (defined$t){my ($u,$v,$w)=$t->val;if (exists$unseenh->{$v }){$h->set_edge_attribute($u,$v,$attr,$w);delete$unseenh->{$v };$add->($g,$h,$HF,$v,$attr,$unseenh,$etc)}}}return$h unless defined$next;$r=$code ? $next->($g,$unseenh): shift @$unseena;last unless defined$r}return$h}sub MST_Prim {my$g=shift;$g->expect_undirected;$g->_heap_walk(Graph::Undirected->new(),\&_MST_add,undef,@_)}*MST_Dijkstra=\&MST_Prim;*minimum_spanning_tree=\&MST_Prim;*is_cyclic=\&has_a_cycle;sub is_acyclic {my$g=shift;return!$g->is_cyclic}sub is_dag {my$g=shift;return$g->is_directed && $g->is_acyclic ? 1 : 0}*is_directed_acyclic_graph=\&is_dag;sub average_degree {my$g=shift;my$V=$g->vertices05;return$V ? $g->degree / $V : 0}sub density_limits {my$g=shift;my$V=$g->vertices05;my$M=$V * ($V - 1);$M /= 2 if$g->is_undirected;return (0.25 * $M,0.75 * $M,$M)}sub density {my$g=shift;my ($sparse,$dense,$complete)=$g->density_limits;return$complete ? $g->edges / $complete : 0}sub _attr02_012 {my ($g,$op,$ga,$va,$ea)=splice @_,0,5;if ($g->is_compat02){if (@_==0){return$ga->($g)}elsif (@_==1){return$va->($g,@_)}elsif (@_==2){return$ea->($g,@_)}else {die sprintf "$op: wrong number of arguments (%d)",scalar @_}}else {die "$op: not a compat02 graph"}}sub _attr02_123 {my ($g,$op,$ga,$va,$ea)=splice @_,0,5;if ($g->is_compat02){if (@_==1){return$ga->($g,@_)}elsif (@_==2){return$va->($g,@_[1,0])}elsif (@_==3){return$ea->($g,@_[1,2,0])}else {die sprintf "$op: wrong number of arguments (%d)",scalar @_}}else {die "$op: not a compat02 graph"}}sub _attr02_234 {my ($g,$op,$ga,$va,$ea)=splice @_,0,5;if ($g->is_compat02){if (@_==2){return$ga->($g,@_)}elsif (@_==3){return$va->($g,@_[1,0,2])}elsif (@_==4){return$ea->($g,@_[1,2,0,3])}else {die sprintf "$op: wrong number of arguments (%d)",scalar @_}}else {die "$op: not a compat02 graph"}}sub set_attribute {my$g=shift;$g->_attr02_234('set_attribute',\&Graph::set_graph_attribute,\&Graph::set_vertex_attribute,\&Graph::set_edge_attribute,@_)}sub set_attributes {my$g=shift;my$a=pop;$g->_attr02_123('set_attributes',\&Graph::set_graph_attributes,\&Graph::set_vertex_attributes,\&Graph::set_edge_attributes,$a,@_)}sub get_attribute {my$g=shift;$g->_attr02_123('get_attribute',\&Graph::get_graph_attribute,\&Graph::get_vertex_attribute,\&Graph::get_edge_attribute,@_)}sub get_attributes {my$g=shift;$g->_attr02_012('get_attributes',\&Graph::get_graph_attributes,\&Graph::get_vertex_attributes,\&Graph::get_edge_attributes,@_)}sub has_attribute {my$g=shift;return 0 unless @_;$g->_attr02_123('has_attribute',\&Graph::has_graph_attribute,\&Graph::has_vertex_attribute,\&Graph::get_edge_attribute,@_)}sub has_attributes {my$g=shift;$g->_attr02_012('has_attributes',\&Graph::has_graph_attributes,\&Graph::has_vertex_attributes,\&Graph::has_edge_attributes,@_)}sub delete_attribute {my$g=shift;$g->_attr02_123('delete_attribute',\&Graph::delete_graph_attribute,\&Graph::delete_vertex_attribute,\&Graph::delete_edge_attribute,@_)}sub delete_attributes {my$g=shift;$g->_attr02_012('delete_attributes',\&Graph::delete_graph_attributes,\&Graph::delete_vertex_attributes,\&Graph::delete_edge_attributes,@_)}sub topological_sort {my$g=shift;my%opt=_get_options(\@_);my$eic=$opt{empty_if_cyclic };my$hac;if ($eic){$hac=$g->has_a_cycle}else {$g->expect_dag}delete$opt{empty_if_cyclic };my$t=Graph::Traversal::DFS->new($g,%opt);my@s=$t->dfs;$hac ? (): reverse@s}*toposort=\&topological_sort;sub _undirected_copy_compute {my$g=shift;my$c=Graph::Undirected->new;for my$v ($g->isolated_vertices){$c->add_vertex($v)}for my$e ($g->edges05){$c->add_edge(@$e)}return$c}sub undirected_copy {my$g=shift;$g->expect_directed;return _check_cache($g,'undirected',\&_undirected_copy_compute)}*undirected_copy_graph=\&undirected_copy;sub directed_copy {my$g=shift;$g->expect_undirected;my$c=Graph::Directed->new;for my$v ($g->isolated_vertices){$c->add_vertex($v)}for my$e ($g->edges05){my@e=@$e;$c->add_edge(@e);$c->add_edge(reverse@e)}return$c}*directed_copy_graph=\&directed_copy;my%_cache_type=('connectivity'=>'_ccc','strong_connectivity'=>'_scc','biconnectivity'=>'_bcc','SPT_Dijkstra'=>'_spt_di','SPT_Bellman_Ford'=>'_spt_bf','undirected'=>'_undirected',);sub _check_cache {my ($g,$type,$code)=splice @_,0,3;my$c=$_cache_type{$type};if (defined$c){my$a=$g->get_graph_attribute($c);unless (defined$a && $a->[0 ]==$g->[_G ]){$a->[0 ]=$g->[_G ];$a->[1 ]=$code->($g,@_);$g->set_graph_attribute($c,$a)}return$a->[1 ]}else {Carp::croak("Graph: unknown cache type '$type'")}}sub _clear_cache {my ($g,$type)=@_;my$c=$_cache_type{$type};if (defined$c){$g->delete_graph_attribute($c)}else {Carp::croak("Graph: unknown cache type '$type'")}}sub connectivity_clear_cache {my$g=shift;_clear_cache($g,'connectivity')}sub strong_connectivity_clear_cache {my$g=shift;_clear_cache($g,'strong_connectivity')}sub biconnectivity_clear_cache {my$g=shift;_clear_cache($g,'biconnectivity')}sub SPT_Dijkstra_clear_cache {my$g=shift;_clear_cache($g,'SPT_Dijkstra');$g->delete_graph_attribute('SPT_Dijkstra_first_root')}sub SPT_Bellman_Ford_clear_cache {my$g=shift;_clear_cache($g,'SPT_Bellman_Ford')}sub undirected_copy_clear_cache {my$g=shift;_clear_cache($g,'undirected_copy')}sub _connected_components_compute {my$g=shift;my%cce;my%cci;my$cc=0;if ($g->has_union_find){my$UF=$g->_get_union_find();my$V=$g->[_V ];my%icce;my%icci;my$icc=0;for my$v ($g->unique_vertices){$cc=$UF->find($V->_get_path_id($v));if (defined$cc){$cce{$v }=$cc;push @{$cci{$cc }},$v}else {$icce{$v }=$icc;push @{$icci{$icc }},$v;$icc++}}if ($icc){@cce{keys%icce }=values%icce;@cci{keys%icci }=values%icci}}else {my@u=$g->unique_vertices;my%r;@r{@u }=@u;my$froot=sub {(each%r)[1]};my$nroot=sub {$cc++ if keys%r;(each%r)[1]};my$t=Graph::Traversal::DFS->new($g,first_root=>$froot,next_root=>$nroot,pre=>sub {my ($v,$t)=@_;$cce{$v }=$cc;push @{$cci{$cc }},$v;delete$r{$v }},@_);$t->dfs}return [\%cce,\%cci ]}sub _connected_components {my$g=shift;my$ccc=_check_cache($g,'connectivity',\&_connected_components_compute,@_);return @{$ccc}}sub connected_component_by_vertex {my ($g,$v)=@_;$g->expect_undirected;my ($CCE,$CCI)=$g->_connected_components();return$CCE->{$v }}sub connected_component_by_index {my ($g,$i)=@_;$g->expect_undirected;my ($CCE,$CCI)=$g->_connected_components();return defined$CCI->{$i }? @{$CCI->{$i }}: ()}sub connected_components {my$g=shift;$g->expect_undirected;my ($CCE,$CCI)=$g->_connected_components();return values %{$CCI}}sub same_connected_components {my$g=shift;$g->expect_undirected;if ($g->has_union_find){my$UF=$g->_get_union_find();my$V=$g->[_V ];my$u=shift;my$c=$UF->find($V->_get_path_id ($u));my$d;for my$v (@_){return 0 unless defined($d=$UF->find($V->_get_path_id($v)))&& $d eq $c}return 1}else {my ($CCE,$CCI)=$g->_connected_components();my$u=shift;my$c=$CCE->{$u };for my$v (@_){return 0 unless defined$CCE->{$v }&& $CCE->{$v }eq $c}return 1}}my$super_component=sub {join("+",sort @_)};sub connected_graph {my ($g,%opt)=@_;$g->expect_undirected;my$cg=Graph->new(undirected=>1);if ($g->has_union_find && $g->vertices==1){$cg->add_vertices($g->vertices)}else {my$sc_cb=exists$opt{super_component}? $opt{super_component}: $super_component;for my$cc ($g->connected_components()){my$sc=$sc_cb->(@$cc);$cg->add_vertex($sc);$cg->set_vertex_attribute($sc,'subvertices',[@$cc ])}}return$cg}sub is_connected {my$g=shift;$g->expect_undirected;my ($CCE,$CCI)=$g->_connected_components();return keys %{$CCI}==1}sub is_weakly_connected {my$g=shift;$g->expect_directed;$g->undirected_copy->is_connected(@_)}*weakly_connected=\&is_weakly_connected;sub weakly_connected_components {my$g=shift;$g->expect_directed;$g->undirected_copy->connected_components(@_)}sub weakly_connected_component_by_vertex {my$g=shift;$g->expect_directed;$g->undirected_copy->connected_component_by_vertex(@_)}sub weakly_connected_component_by_index {my$g=shift;$g->expect_directed;$g->undirected_copy->connected_component_by_index(@_)}sub same_weakly_connected_components {my$g=shift;$g->expect_directed;$g->undirected_copy->same_connected_components(@_)}sub weakly_connected_graph {my$g=shift;$g->expect_directed;$g->undirected_copy->connected_graph(@_)}sub _strongly_connected_components_compute {my$g=shift;my$t=Graph::Traversal::DFS->new($g);my@d=reverse$t->dfs;my@c;my$h=$g->transpose_graph;my$u=Graph::Traversal::DFS->new($h,next_root=>sub {my ($t,$u)=@_;my$root;while (defined($root=shift@d)){last if exists$u->{$root }}if (defined$root){push@c,[];return$root}else {return}},pre=>sub {my ($v,$t)=@_;push @{$c[-1]},$v},@_);$u->dfs;return \@c}sub _strongly_connected_components {my$g=shift;my$type='strong_connectivity';my$scc=_check_cache($g,$type,\&_strongly_connected_components_compute,@_);return defined$scc ? @$scc : ()}sub strongly_connected_components {my$g=shift;$g->expect_directed;$g->_strongly_connected_components(@_)}sub strongly_connected_component_by_vertex {my$g=shift;my$v=shift;$g->expect_directed;my@scc=$g->_strongly_connected_components(next_alphabetic=>1,@_);for (my$i=0;$i <= $#scc;$i++){for (my$j=0;$j <= $#{$scc[$i]};$j++){return$i if$scc[$i]->[$j]eq $v}}return}sub strongly_connected_component_by_index {my$g=shift;my$i=shift;$g->expect_directed;my$c=($g->_strongly_connected_components(@_))[$i ];return defined$c ? @{$c}: ()}sub same_strongly_connected_components {my$g=shift;$g->expect_directed;my@scc=$g->_strongly_connected_components(next_alphabetic=>1,@_);my@i;while (@_){my$v=shift;for (my$i=0;$i <= $#scc;$i++){for (my$j=0;$j <= $#{$scc[$i]};$j++){if ($scc[$i]->[$j]eq $v){push@i,$i;return 0 if@i > 1 && $i[-1]ne $i[0]}}}}return 1}sub is_strongly_connected {my$g=shift;$g->expect_directed;my$t=Graph::Traversal::DFS->new($g);my@d=reverse$t->dfs;my@c;my$h=$g->transpose;my$u=Graph::Traversal::DFS->new($h,next_root=>sub {my ($t,$u)=@_;my$root;while (defined($root=shift@d)){last if exists$u->{$root }}if (defined$root){unless (@{$t->{roots }}){push@c,[];return$root}else {$t->terminate;return}}else {return}},pre=>sub {my ($v,$t)=@_;push @{$c[-1]},$v},@_);$u->dfs;return @{$u->{roots }}==1 && keys %{$u->{unseen }}==0}*strongly_connected=\&is_strongly_connected;sub strongly_connected_graph {my$g=shift;my%attr=@_;$g->expect_directed;my$t=Graph::Traversal::DFS->new($g);my@d=reverse$t->dfs;my@c;my$h=$g->transpose;my$u=Graph::Traversal::DFS->new($h,next_root=>sub {my ($t,$u)=@_;my$root;while (defined($root=shift@d)){last if exists$u->{$root }}if (defined$root){push@c,[];return$root}else {return}},pre=>sub {my ($v,$t)=@_;push @{$c[-1]},$v});$u->dfs;my$sc_cb;my$hv_cb;_opt_get(\%attr,super_component=>\$sc_cb);_opt_get(\%attr,hypervertex=>\$hv_cb);_opt_unknown(\%attr);if (defined$hv_cb &&!defined$sc_cb){$sc_cb=sub {$hv_cb->([@_ ])}}unless (defined$sc_cb){$sc_cb=$super_component}my$s=Graph->new;my%c;my@s;for (my$i=0;$i < @c;$i++){my$c=$c[$i];$s->add_vertex($s[$i]=$sc_cb->(@$c));$s->set_vertex_attribute($s[$i],'subvertices',[@$c ]);for my$v (@$c){$c{$v}=$i}}my$n=@c;for my$v ($g->vertices){unless (exists$c{$v}){$c{$v}=$n;$s[$n]=$v;$n++}}for my$e ($g->edges05){my ($u,$v)=@$e;unless ($c{$u}==$c{$v}){my ($p,$q)=($s[$c{$u }],$s[$c{$v }]);$s->add_edge($p,$q)unless$s->has_edge($p,$q)}}if (my@i=$g->isolated_vertices){$s->add_vertices(map {$s[$c{$_ }]}@i)}return$s}sub _biconnectivity_out {my ($state,$u,$v)=@_;if (exists$state->{stack}){my@BC;while (@{$state->{stack}}){my$e=pop @{$state->{stack}};push@BC,$e;last if defined$u && $e->[0]eq $u && $e->[1]eq $v}if (@BC){push @{$state->{BC}},\@BC}}}sub _biconnectivity_dfs {my ($g,$u,$state)=@_;$state->{num}->{$u}=$state->{dfs}++;$state->{low}->{$u}=$state->{num}->{$u};for my$v ($g->successors($u)){unless (exists$state->{num}->{$v}){push @{$state->{stack}},[$u,$v];$state->{pred}->{$v}=$u;$state->{succ}->{$u}->{$v}++;_biconnectivity_dfs($g,$v,$state);if ($state->{low}->{$v}< $state->{low}->{$u}){$state->{low}->{$u}=$state->{low}->{$v}}if ($state->{low}->{$v}>= $state->{num}->{$u}){_biconnectivity_out($state,$u,$v)}}elsif (defined$state->{pred}->{$u}&& $state->{pred}->{$u}ne $v && $state->{num}->{$v}< $state->{num}->{$u}){push @{$state->{stack}},[$u,$v];if ($state->{num}->{$v}< $state->{low}->{$u}){$state->{low}->{$u}=$state->{num}->{$v}}}}}sub _biconnectivity_compute {my ($g)=@_;my%state;@{$state{BC}}=();@{$state{BR}}=();%{$state{V2BC}}=();%{$state{BC2V}}=();@{$state{AP}}=();$state{dfs}=0;my@u=_shuffle$g->vertices;for my$u (@u){unless (exists$state{num}->{$u}){_biconnectivity_dfs($g,$u,\%state);_biconnectivity_out(\%state);delete$state{stack}}}my$bci=0;for my$bc (@{$state{BC}}){for my$e (@$bc){for my$v (@$e){$state{V2BC}->{$v}->{$bci}++}}$bci++}for my$v ($g->vertices){unless (exists$state{V2BC}->{$v}){$state{V2BC}->{$v}->{$bci++}++}}for my$v ($g->vertices){for my$bc (keys %{$state{V2BC}->{$v}}){$state{BC2V}->{$bc}->{$v}->{$bc}++}}for my$v (keys %{$state{V2BC}}){if (keys %{$state{V2BC}->{$v}}> 1){push @{$state{AP}},$v}}for my$v (keys %{$state{BC2V}}){my@v=keys %{$state{BC2V}->{$v}};if (@v==2){push @{$state{BR}},\@v}}my@sg;for my$bc (@{$state{BC}}){my%v;my$w=Graph::Undirected->new();for my$e (@$bc){my ($u,$v)=@$e;$v{$u}++;$v{$v}++;$w->add_edge($u,$v)}push@sg,[keys%v ]}return [$state{AP},\@sg,$state{BR},$state{V2BC},]}sub biconnectivity {my$g=shift;$g->expect_undirected;my$bcc=_check_cache($g,'biconnectivity',\&_biconnectivity_compute,@_);return defined$bcc ? @$bcc : ()}sub is_biconnected {my$g=shift;my ($ap)=($g->biconnectivity(@_))[0];return$g->edges >= 2 ? @$ap==0 : undef }sub is_edge_connected {my$g=shift;my ($br)=($g->biconnectivity(@_))[2];return$g->edges >= 2 ? @$br==0 : undef}sub is_edge_separable {my$g=shift;my ($br)=($g->biconnectivity(@_))[2];return$g->edges >= 2 ? @$br > 0 : undef}sub articulation_points {my$g=shift;my ($ap)=($g->biconnectivity(@_))[0];return @$ap}*cut_vertices=\&articulation_points;sub biconnected_components {my$g=shift;my ($bc)=($g->biconnectivity(@_))[1];return @$bc}sub biconnected_component_by_index {my$g=shift;my$i=shift;my ($bc)=($g->biconnectivity(@_))[1];return$bc->[$i ]}sub biconnected_component_by_vertex {my$g=shift;my$v=shift;my ($v2bc)=($g->biconnectivity(@_))[3];return defined$v2bc->{$v }? keys %{$v2bc->{$v }}: ()}sub same_biconnected_components {my$g=shift;my$u=shift;my@u=$g->biconnected_component_by_vertex($u,@_);return 0 unless@u;my%ubc;@ubc{@u }=();while (@_){my$v=shift;my@v=$g->biconnected_component_by_vertex($v);if (@v){my%vbc;@vbc{@v }=();my$vi;for my$ui (keys%ubc){if (exists$vbc{$ui }){$vi=$ui;last}}return 0 unless defined$vi}}return 1}sub biconnected_graph {my ($g,%opt)=@_;my ($bc,$v2bc)=($g->biconnectivity,%opt)[1,3];my$bcg=Graph::Undirected->new;my$sc_cb=exists$opt{super_component}? $opt{super_component}: $super_component;for my$c (@$bc){$bcg->add_vertex(my$s=$sc_cb->(@$c));$bcg->set_vertex_attribute($s,'subvertices',[@$c ])}my%k;for my$i (0..$#$bc){my@u=@{$bc->[$i ]};my%i;@i{@u }=();for my$j (0..$#$bc){if ($i > $j){my@v=@{$bc->[$j ]};my%j;@j{@v }=();for my$u (@u){if (exists$j{$u }){unless ($k{$i }{$j }++){$bcg->add_edge($sc_cb->(@{$bc->[$i]}),$sc_cb->(@{$bc->[$j]}))}last}}}}}return$bcg}sub bridges {my$g=shift;my ($br)=($g->biconnectivity(@_))[2];return defined$br ? @$br : ()}sub _SPT_add {my ($g,$h,$HF,$r,$attr,$unseen,$etc)=@_;my$etc_r=$etc->{$r }|| 0;for my$s (grep {exists$unseen->{$_ }}$g->successors($r)){my$t=$g->get_edge_attribute($r,$s,$attr);$t=1 unless defined$t;if ($t < 0){require Carp;Carp::croak("Graph::SPT_Dijkstra: edge $r-$s is negative ($t)")}if (!defined($etc->{$s })|| ($etc_r + $t)< $etc->{$s }){my$etc_s=$etc->{$s }|| 0;$etc->{$s }=$etc_r + $t;$h->set_vertex_attribute($s,$attr,$etc->{$s });$h->set_vertex_attribute($s,'p',$r);$HF->add(Graph::SPTHeapElem->new($r,$s,$etc->{$s }))}}}sub _SPT_Dijkstra_compute {}sub SPT_Dijkstra {my$g=shift;my%opt=@_==1 ? (first_root=>$_[0]): @_;my$first_root=$opt{first_root };unless (defined$first_root){$opt{first_root }=$first_root=$g->random_vertex()}my$spt_di=$g->get_graph_attribute('_spt_di');unless (defined$spt_di && exists$spt_di->{$first_root }&& $spt_di->{$first_root }->[0 ]==$g->[_G ]){my%etc;my$sptg=$g->_heap_walk($g->new,\&_SPT_add,\%etc,%opt);$spt_di->{$first_root }=[$g->[_G ],$sptg ];$g->set_graph_attribute('_spt_di',$spt_di)}my$spt=$spt_di->{$first_root }->[1 ];$spt->set_graph_attribute('SPT_Dijkstra_root',$first_root);return$spt}*SSSP_Dijkstra=\&SPT_Dijkstra;*single_source_shortest_paths=\&SPT_Dijkstra;sub SP_Dijkstra {my ($g,$u,$v)=@_;my$sptg=$g->SPT_Dijkstra(first_root=>$u);my@path=($v);my%seen;my$V=$g->vertices;my$p;while (defined($p=$sptg->get_vertex_attribute($v,'p'))){last if exists$seen{$p};push@path,$p;$v=$p;$seen{$p}++;last if keys%seen==$V || $u eq $v}@path=()if@path && $path[-1]ne $u;return reverse@path}sub __SPT_Bellman_Ford {my ($g,$u,$v,$attr,$d,$p,$c0,$c1)=@_;return unless$c0->{$u };my$w=$g->get_edge_attribute($u,$v,$attr);$w=1 unless defined$w;if (defined$d->{$v }){if (defined$d->{$u }){if ($d->{$v }> $d->{$u }+ $w){$d->{$v }=$d->{$u }+ $w;$p->{$v }=$u;$c1->{$v }++}}}else {if (defined$d->{$u }){$d->{$v }=$d->{$u }+ $w;$p->{$v }=$u;$c1->{$v }++}}}sub _SPT_Bellman_Ford {my ($g,$opt,$unseenh,$unseena,$r,$next,$code,$attr)=@_;my%d;return unless defined$r;$d{$r }=0;my%p;my$V=$g->vertices;my%c0;$c0{$r }++;for (my$i=0;$i < $V;$i++){my%c1;for my$e ($g->edges){my ($u,$v)=@$e;__SPT_Bellman_Ford($g,$u,$v,$attr,\%d,\%p,\%c0,\%c1);if ($g->undirected){__SPT_Bellman_Ford($g,$v,$u,$attr,\%d,\%p,\%c0,\%c1)}}%c0=%c1 unless$i==$V - 1}for my$e ($g->edges){my ($u,$v)=@$e;if (defined$d{$u }&& defined$d{$v }){my$d=$g->get_edge_attribute($u,$v,$attr);if (defined$d && $d{$v }> $d{$u }+ $d){require Carp;Carp::croak("Graph::SPT_Bellman_Ford: negative cycle exists")}}}return (\%p,\%d)}sub _SPT_Bellman_Ford_compute {}sub SPT_Bellman_Ford {my$g=shift;my ($opt,$unseenh,$unseena,$r,$next,$code,$attr)=$g->_root_opt(@_);unless (defined$r){$r=$g->random_vertex();return unless defined$r}my$spt_bf=$g->get_graph_attribute('_spt_bf');unless (defined$spt_bf && exists$spt_bf->{$r }&& $spt_bf->{$r }->[0 ]==$g->[_G ]){my ($p,$d)=$g->_SPT_Bellman_Ford($opt,$unseenh,$unseena,$r,$next,$code,$attr);my$h=$g->new;for my$v (keys %$p){my$u=$p->{$v };$h->add_edge($u,$v);$h->set_edge_attribute($u,$v,$attr,$g->get_edge_attribute($u,$v,$attr));$h->set_vertex_attribute($v,$attr,$d->{$v });$h->set_vertex_attribute($v,'p',$u)}$spt_bf->{$r }=[$g->[_G ],$h ];$g->set_graph_attribute('_spt_bf',$spt_bf)}my$spt=$spt_bf->{$r }->[1 ];$spt->set_graph_attribute('SPT_Bellman_Ford_root',$r);return$spt}*SSSP_Bellman_Ford=\&SPT_Bellman_Ford;sub SP_Bellman_Ford {my ($g,$u,$v)=@_;my$sptg=$g->SPT_Bellman_Ford(first_root=>$u);my@path=($v);my%seen;my$V=$g->vertices;my$p;while (defined($p=$sptg->get_vertex_attribute($v,'p'))){last if exists$seen{$p};push@path,$p;$v=$p;$seen{$p}++;last if keys%seen==$V}return reverse@path}sub TransitiveClosure_Floyd_Warshall {my$self=shift;my$class=ref$self || $self;$self=shift unless ref$self;bless Graph::TransitiveClosure->new($self,@_),$class}*transitive_closure=\&TransitiveClosure_Floyd_Warshall;sub APSP_Floyd_Warshall {my$self=shift;my$class=ref$self || $self;$self=shift unless ref$self;bless Graph::TransitiveClosure->new($self,path=>1,@_),$class}*all_pairs_shortest_paths=\&APSP_Floyd_Warshall;sub _transitive_closure_matrix_compute {}sub transitive_closure_matrix {my$g=shift;my$tcm=$g->get_graph_attribute('_tcm');if (defined$tcm){if (ref$tcm eq 'ARRAY'){if ($tcm->[0 ]==$g->[_G ]){$tcm=$tcm->[1 ]}else {undef$tcm}}}unless (defined$tcm){my$apsp=$g->APSP_Floyd_Warshall(@_);$tcm=$apsp->get_graph_attribute('_tcm');$g->set_graph_attribute('_tcm',[$g->[_G ],$tcm ])}return$tcm}sub path_length {my$g=shift;my$tcm=$g->transitive_closure_matrix;$tcm->path_length(@_)}sub path_predecessor {my$g=shift;my$tcm=$g->transitive_closure_matrix;$tcm->path_predecessor(@_)}sub path_vertices {my$g=shift;my$tcm=$g->transitive_closure_matrix;$tcm->path_vertices(@_)}sub is_reachable {my$g=shift;my$tcm=$g->transitive_closure_matrix;$tcm->is_reachable(@_)}sub for_shortest_paths {my$g=shift;my$c=shift;my$t=$g->transitive_closure_matrix;my@v=$g->vertices;my$n=0;for my$u (@v){for my$v (@v){next unless$t->is_reachable($u,$v);$n++;$c->($t,$u,$v,$n)}}return$n}sub _minmax_path {my$g=shift;my$min;my$max;my$minp;my$maxp;$g->for_shortest_paths(sub {my ($t,$u,$v,$n)=@_;my$l=$t->path_length($u,$v);return unless defined$l;my$p;if ($u ne $v && (!defined$max || $l > $max)){$max=$l;$maxp=$p=[$t->path_vertices($u,$v)]}if ($u ne $v && (!defined$min || $l < $min)){$min=$l;$minp=$p || [$t->path_vertices($u,$v)]}});return ($min,$max,$minp,$maxp)}sub diameter {my$g=shift;my ($min,$max,$minp,$maxp)=$g->_minmax_path(@_);return defined$maxp ? (wantarray ? @$maxp : $max): undef}*graph_diameter=\&diameter;sub longest_path {my ($g,$u,$v)=@_;my$t=$g->transitive_closure_matrix;if (defined$u){if (defined$v){return wantarray ? $t->path_vertices($u,$v): $t->path_length($u,$v)}else {my$max;my@max;for my$v ($g->vertices){next if$u eq $v;my$l=$t->path_length($u,$v);if (defined$l && (!defined$max || $l > $max)){$max=$l;@max=$t->path_vertices($u,$v)}}return wantarray ? @max : $max}}else {if (defined$v){my$max;my@max;for my$u ($g->vertices){next if$u eq $v;my$l=$t->path_length($u,$v);if (defined$l && (!defined$max || $l > $max)){$max=$l;@max=$t->path_vertices($u,$v)}}return wantarray ? @max : @max - 1}else {my ($min,$max,$minp,$maxp)=$g->_minmax_path(@_);return defined$maxp ? (wantarray ? @$maxp : $max): undef}}}sub vertex_eccentricity {my ($g,$u)=@_;$g->expect_undirected;if ($g->is_connected){my$max;for my$v ($g->vertices){next if$u eq $v;my$l=$g->path_length($u,$v);if (defined$l && (!defined$max || $l > $max)){$max=$l}}return defined$max ? $max : Infinity()}else {return Infinity()}}sub shortest_path {my ($g,$u,$v)=@_;$g->expect_undirected;my$t=$g->transitive_closure_matrix;if (defined$u){if (defined$v){return wantarray ? $t->path_vertices($u,$v): $t->path_length($u,$v)}else {my$min;my@min;for my$v ($g->vertices){next if$u eq $v;my$l=$t->path_length($u,$v);if (defined$l && (!defined$min || $l < $min)){$min=$l;@min=$t->path_vertices($u,$v)}}print "min/1 = @min\n";return wantarray ? @min : $min}}else {if (defined$v){my$min;my@min;for my$u ($g->vertices){next if$u eq $v;my$l=$t->path_length($u,$v);if (defined$l && (!defined$min || $l < $min)){$min=$l;@min=$t->path_vertices($u,$v)}}print "min/2 = @min\n";return wantarray ? @min : $min}else {my ($min,$max,$minp,$maxp)=$g->_minmax_path(@_);return defined$minp ? (wantarray ? @$minp : $min): wantarray ? (): undef}}}sub radius {my$g=shift;$g->expect_undirected;my ($center,$radius)=(undef,Infinity());for my$v ($g->vertices){my$x=$g->vertex_eccentricity($v);($center,$radius)=($v,$x)if defined$x && $x < $radius}return$radius}sub center_vertices {my ($g,$delta)=@_;$g->expect_undirected;$delta=0 unless defined$delta;$delta=abs($delta);my@c;my$Inf=Infinity();my$r=$g->radius;if (defined$r && $r!=$Inf){for my$v ($g->vertices){my$e=$g->vertex_eccentricity($v);next unless defined$e && $e!=$Inf;push@c,$v if abs($e - $r)<= $delta}}return@c}*centre_vertices=\¢er_vertices;sub average_path_length {my$g=shift;my@A=@_;my$d=0;my$m=0;my$n=$g->for_shortest_paths(sub {my ($t,$u,$v,$n)=@_;my$l=$t->path_length($u,$v);if ($l){my$c=@A==0 || (@A==1 && $u eq $A[0])|| ((@A==2)&& (defined$A[0]&& $u eq $A[0])|| (defined$A[1]&& $v eq $A[1]));if ($c){$d += $l;$m++}}});return$m ? $d / $m : undef}sub is_multi_graph {my$g=shift;return 0 unless$g->is_multiedged || $g->is_countedged;my$multiedges=0;for my$e ($g->edges05){my ($u,@v)=@$e;for my$v (@v){return 0 if$u eq $v}$multiedges++ if$g->get_edge_count(@$e)> 1}return$multiedges}sub is_simple_graph {my$g=shift;return 1 unless$g->is_countedged || $g->is_multiedged;for my$e ($g->edges05){return 0 if$g->get_edge_count(@$e)> 1}return 1}sub is_pseudo_graph {my$g=shift;my$m=$g->is_countedged || $g->is_multiedged;for my$e ($g->edges05){my ($u,@v)=@$e;for my$v (@v){return 1 if$u eq $v}return 1 if$m && $g->get_edge_count($u,@v)> 1}return 0}my%_factorial=(0=>1,1=>1);sub __factorial {my$n=shift;for (my$i=2;$i <= $n;$i++){next if exists$_factorial{$i};$_factorial{$i}=$i * $_factorial{$i - 1}}$_factorial{$n}}sub _factorial {my$n=int(shift);if ($n < 0){require Carp;Carp::croak("factorial of a negative number")}__factorial($n)unless exists$_factorial{$n};return$_factorial{$n}}sub could_be_isomorphic {my ($g0,$g1)=@_;return 0 unless$g0->vertices==$g1->vertices;return 0 unless$g0->edges05==$g1->edges05;my%d0;for my$v0 ($g0->vertices){$d0{$g0->in_degree($v0)}{$g0->out_degree($v0)}++}my%d1;for my$v1 ($g1->vertices){$d1{$g1->in_degree($v1)}{$g1->out_degree($v1)}++}return 0 unless keys%d0==keys%d1;for my$da (keys%d0){return 0 unless exists$d1{$da}&& keys %{$d0{$da}}==keys %{$d1{$da}};for my$db (keys %{$d0{$da}}){return 0 unless exists$d1{$da}{$db}&& $d0{$da}{$db}==$d1{$da}{$db}}}for my$da (keys%d0){for my$db (keys %{$d0{$da}}){return 0 unless$d1{$da}{$db}==$d0{$da}{$db}}delete$d1{$da}}return 0 unless keys%d1==0;my$f=1;for my$da (keys%d0){for my$db (keys %{$d0{$da}}){$f *= _factorial(abs($d0{$da}{$db}))}}return$f}sub subgraph_by_radius {my ($g,$n,$rad)=@_;return unless defined$n && defined$rad && $rad >= 0;my$r=(ref$g)->new;if ($rad==0){return$r->add_vertex($n)}my%h;$h{1}=[[$n,$g->successors($n)]];for my$i (1..$rad){$h{$i+1}=[];for my$arr (@{$h{$i}}){my ($p,@succ)=@{$arr};for my$s (@succ){$r->add_edge($p,$s);push(@{$h{$i+1}},[$s,$g->successors($s)])if$i < $rad}}}return$r}sub clustering_coefficient {my ($g)=@_;my%clustering;my$gamma=0;for my$n ($g->vertices()){my$gamma_v=0;my@neigh=$g->successors($n);my%c;for my$u (@neigh){for my$v (@neigh){if (!$c{"$u-$v"}&& $g->has_edge($u,$v)){$gamma_v++;$c{"$u-$v"}=1;$c{"$v-$u"}=1}}}if (@neigh > 1){$clustering{$n}=$gamma_v/(@neigh * (@neigh - 1)/ 2);$gamma += $gamma_v/(@neigh * (@neigh - 1)/ 2)}else {$clustering{$n}=0}}$gamma /= $g->vertices();return wantarray ? ($gamma,%clustering): $gamma}sub betweenness {my$g=shift;my@V=$g->vertices();my%Cb;$Cb{$_}=0 for@V;for my$s (@V){my@S;my%P;$P{$_}=[]for@V;my%sigma;$sigma{$_}=0 for@V;$sigma{$s}=1;my%d;$d{$_}=-1 for@V;$d{$s}=0;my@Q;push@Q,$s;while (@Q){my$v=shift@Q;unshift@S,$v;for my$w ($g->successors($v)){if ($d{$w}< 0){push@Q,$w;$d{$w}=$d{$v}+ 1}if ($d{$w}==$d{$v}+ 1){$sigma{$w}+= $sigma{$v};push @{$P{$w}},$v}}}my%delta;$delta{$_}=0 for@V;while (@S){my$w=shift@S;for my$v (@{$P{$w}}){$delta{$v}+= $sigma{$v}/$sigma{$w}* (1 + $delta{$w})}if ($w ne $s){$Cb{$w}+= $delta{$w}}}}return%Cb}sub _dump {require Data::Dumper;my$d=Data::Dumper->new([$_[0]],[ref $_[0]]);defined wantarray ? $d->Dump : print$d->Dump}1; +GRAPH + +$fatpacked{"Graph/AdjacencyMap.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMAP'; + package Graph::AdjacencyMap;use strict;require Exporter;use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);@ISA=qw(Exporter);@EXPORT_OK=qw(_COUNT _MULTI _COUNTMULTI _GEN_ID _HYPER _UNORD _UNIQ _REF _UNORDUNIQ _UNIONFIND _LIGHT _STR _REFSTR _n _f _a _i _s _p _g _u _ni _nc _na _nm);%EXPORT_TAGS=(flags=>[qw(_COUNT _MULTI _COUNTMULTI _GEN_ID _HYPER _UNORD _UNIQ _REF _UNORDUNIQ _UNIONFIND _LIGHT _STR _REFSTR)],fields=>[qw(_n _f _a _i _s _p _g _u _ni _nc _na _nm)]);sub _COUNT () {0x00000001}sub _MULTI () {0x00000002}sub _COUNTMULTI () {_COUNT|_MULTI}sub _HYPER () {0x00000004}sub _UNORD () {0x00000008}sub _UNIQ () {0x00000010}sub _REF () {0x00000020}sub _UNORDUNIQ () {_UNORD|_UNIQ}sub _UNIONFIND () {0x00000040}sub _LIGHT () {0x00000080}sub _STR () {0x00000100}sub _REFSTR () {_REF|_STR}my$_GEN_ID=0;sub _GEN_ID () {\$_GEN_ID}sub _ni () {0}sub _nc () {1}sub _na () {2}sub _nm () {3}sub _n () {0}sub _f () {1}sub _a () {2}sub _i () {3}sub _s () {4}sub _p () {5}sub _g () {6}sub _V () {2}sub _new {my$class=shift;my$map=bless [0,@_ ],$class;return$map}sub _ids {my$m=shift;return$m->[_i ]}sub has_paths {my$m=shift;return defined$m->[_i ]&& keys %{$m->[_i ]}}sub _dump {my$d=Data::Dumper->new([$_[0]],[ref $_[0]]);defined wantarray ? $d->Dump : print$d->Dump}sub _del_id {my ($m,$i)=@_;my@p=$m->_get_id_path($i);$m->del_path(@p)if@p}sub _new_node {my ($m,$n,$id)=@_;my$f=$m->[_f ];my$i=$m->[_n ]++;if (($f & _MULTI)){$id=0 if$id eq _GEN_ID;$$n=[$i,0,undef,{$id=>{}}]}elsif (($f & _COUNT)){$$n=[$i,1 ]}else {$$n=$i}return$i}sub _inc_node {my ($m,$n,$id)=@_;my$f=$m->[_f ];if (($f & _MULTI)){if ($id eq _GEN_ID){$$n->[_nc ]++ while exists $$n->[_nm ]->{$$n->[_nc ]};$id=$$n->[_nc ]}$$n->[_nm ]->{$id }={}}elsif (($f & _COUNT)){$$n->[_nc ]++}return$id}sub __get_path_node {my$m=shift;my ($p,$k);my$f=$m->[_f ];@_=sort @_ if ($f & _UNORD);if ($m->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){return unless exists$m->[_s ]->{$_[0]};$p=[$m->[_s ],$m->[_s ]->{$_[0]}];$k=[$_[0],$_[1]]}else {($p,$k)=$m->__has_path(@_)}return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return (exists$p->[-1]->{$l },$p->[-1]->{$l },$p,$k,$l)}sub set_path_by_multi_id {my$m=shift;my ($p,$k)=$m->__set_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return$m->__set_path_node($p,$l,@_)}sub get_multi_ids {my$m=shift;my$f=$m->[_f ];return ()unless ($f & _MULTI);my ($e,$n)=$m->__get_path_node(@_);return$e ? keys %{$n->[_nm ]}: ()}sub _has_path_attrs {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return keys %{$p->[-1]->{$l }->[_nm ]->{$id }}? 1 : 0}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return ref$n && $#$n==_na && keys %{$n->[_na ]}? 1 : 0}}sub _set_path_attrs {my$m=shift;my$f=$m->[_f ];my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(@_);push @_,$id if ($f & _MULTI);my ($p,$k)=$m->__set_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";$m->__set_path_node($p,$l,@_)unless exists$p->[-1]->{$l };if (($f & _MULTI)){$p->[-1]->{$l }->[_nm ]->{$id }=$attr}else {$p->[-1]->{$l }=[$p->[-1]->{$l },1 ]unless ref$p->[-1]->{$l };$p->[-1]->{$l }->[_na ]=$attr}}sub _has_path_attr {my$m=shift;my$f=$m->[_f ];my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";exists$p->[-1]->{$l }->[_nm ]->{$id }->{$attr }}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return ref$n && $#$n==_na ? exists$n->[_na ]->{$attr }: undef}}sub _set_path_attr {my$m=shift;my$f=$m->[_f ];my$val=pop;my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);my ($p,$k);$m->__attr(\@_);push @_,$id if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);if ($m->[_a ]==2 && @_==2 &&!($f & (_REF|_UNIQ|_HYPER|_UNIQ))){$m->[_s ]->{$_[0]}||= {};$p=[$m->[_s ],$m->[_s ]->{$_[0]}];$k=[$_[0],$_[1]]}else {($p,$k)=$m->__set_path(@_)}return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";$m->__set_path_node($p,$l,@_)unless exists$p->[-1]->{$l };if (($f & _MULTI)){$p->[-1]->{$l }->[_nm ]->{$id }->{$attr }=$val}else {$p->[-1]->{$l }=[$p->[-1]->{$l },1 ]unless ref$p->[-1]->{$l };$p->[-1]->{$l }->[_na ]->{$attr }=$val}return$val}sub _get_path_attrs {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";$p->[-1]->{$l }->[_nm ]->{$id }}else {my ($e,$n)=$m->__get_path_node(@_);return unless$e;return$n->[_na ]if ref$n && $#$n==_na;return}}sub _get_path_attr {my$m=shift;my$f=$m->[_f ];my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return$p->[-1]->{$l }->[_nm ]->{$id }->{$attr }}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return ref$n && $#$n==_na ? $n->[_na ]->{$attr }: undef}}sub _get_path_attr_names {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";keys %{$p->[-1]->{$l }->[_nm ]->{$id }}}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return keys %{$n->[_na ]}if ref$n && $#$n==_na;return}}sub _get_path_attr_values {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";values %{$p->[-1]->{$l }->[_nm ]->{$id }}}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return values %{$n->[_na ]}if ref$n && $#$n==_na;return}}sub _del_path_attrs {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";delete$p->[-1]->{$l }->[_nm ]->{$id };unless (keys %{$p->[-1]->{$l }->[_nm ]}|| (defined$p->[-1]->{$l }->[_na ]&& keys %{$p->[-1]->{$l }->[_na ]})){delete$p->[-1]->{$l }}}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;if (ref$n){$e=_na==$#$n && keys %{$n->[_na ]}? 1 : 0;$#$n=_na - 1;return$e}else {return 0}}}sub _del_path_attr {my$m=shift;my$f=$m->[_f ];my$attr=pop;my$id=pop if ($f & _MULTI);@_=sort @_ if ($f & _UNORD);$m->__attr(\@_);if (($f & _MULTI)){my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";delete$p->[-1]->{$l }->[_nm ]->{$id }->{$attr };$m->_del_path_attrs(@_,$id)unless keys %{$p->[-1]->{$l }->[_nm ]->{$id }}}else {my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;if (ref$n && $#$n==_na && exists$n->[_na ]->{$attr }){delete$n->[_na ]->{$attr };return 1}else {return 0}}}sub _is_COUNT {$_[0]->[_f ]& _COUNT}sub _is_MULTI {$_[0]->[_f ]& _MULTI}sub _is_HYPER {$_[0]->[_f ]& _HYPER}sub _is_UNORD {$_[0]->[_f ]& _UNORD}sub _is_UNIQ {$_[0]->[_f ]& _UNIQ}sub _is_REF {$_[0]->[_f ]& _REF}sub _is_STR {$_[0]->[_f ]& _STR}sub __arg {my$m=shift;my$f=$m->[_f ];my@a=@{$_[0]};if ($f & _UNIQ){my%u;if ($f & _UNORD){@u{@a }=@a;@a=values%u}else {my@u;for my$e (@a){push@u,$e if$u{$e}++==0}@a=@u}}@{$_[0]}=($f & _UNORD)? sort@a : @a}sub _successors {my$E=shift;my$g=shift;my$V=$g->[_V ];map {my@v=@{$_->[1 ]};shift@v;map {$V->_get_id_path($_)}@v}$g->_edges_from(@_)}sub _predecessors {my$E=shift;my$g=shift;my$V=$g->[_V ];if (wantarray){map {my@v=@{$_->[1 ]};pop@v;map {$V->_get_id_path($_)}@v}$g->_edges_to(@_)}else {return$g->_edges_to(@_)}}1; +GRAPH_ADJACENCYMAP + +$fatpacked{"Graph/AdjacencyMap/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMAP_HEAVY'; + package Graph::AdjacencyMap::Heavy;use strict;use Graph::AdjacencyMap qw(:flags :fields);use base 'Graph::AdjacencyMap';require overload;require Data::Dumper;sub __set_path {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);if (@_!=$m->[_a ]&&!($f & _HYPER)){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Heavy: arguments %d expected %d",scalar @_,$m->[_a ])}my$p;$p=($f & _HYPER)? (($m->[_s ]||= [])->[@_ ]||= {}): ($m->[_s ]||= {});my@p=$p;my@k;@_=sort @_ if ($m->[_f ]& _UNORD);while (@_){my$k=shift;my$q=ref$k && ($f & _REF)&& overload::Method($k,'""')? overload::StrVal($k): $k;if (@_){$p=$p->{$q }||= {};return unless$p;push@p,$p}push@k,$q}return (\@p,\@k)}sub __set_path_node {my ($m,$p,$l)=splice @_,0,3;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);unless (exists$p->[-1]->{$l }){my$i=$m->_new_node(\$p->[-1]->{$l },$id);$m->[_i ]->{defined$i ? $i : "" }=[@_ ];return defined$id ? ($id eq _GEN_ID ? $$id : $id): $i}else {return$m->_inc_node(\$p->[-1]->{$l },$id)}}sub set_path {my$m=shift;my$f=$m->[_f ];return if @_==0 &&!($f & _HYPER);if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($p,$k)=$m->__set_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";return$m->__set_path_node($p,$l,@_)}sub __has_path {my$m=shift;my$f=$m->[_f ];if (@_!=$m->[_a ]&&!($f & _HYPER)){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Heavy: arguments %d expected %d",scalar @_,$m->[_a ])}if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my$p=$m->[_s ];return unless defined$p;$p=$p->[@_ ]if ($f & _HYPER);return unless defined$p;my@p=$p;my@k;while (@_){my$k=shift;my$q=ref$k && ($f & _REF)&& overload::Method($k,'""')? overload::StrVal($k): $k;if (@_){$p=$p->{$q };return unless defined$p;push@p,$p}push@k,$q}return (\@p,\@k)}sub has_path {my$m=shift;my$f=$m->[_f ];if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;return exists$p->[-1]->{defined$k->[-1]? $k->[-1]: "" }}sub has_path_by_multi_id {my$m=shift;my$f=$m->[_f ];my$id=pop;if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return exists$n->[_nm ]->{$id }}sub _get_path_node {my$m=shift;my$f=$m->[_f ];if ($m->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){@_=sort @_ if ($f & _UNORD);return unless exists$m->[_s ]->{$_[0]};my$p=[$m->[_s ],$m->[_s ]->{$_[0]}];my$k=[$_[0],$_[1]];my$l=$_[1];return (exists$p->[-1]->{$l },$p->[-1]->{$l },$p,$k,$l)}else {if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}$m->__get_path_node(@_)}}sub _get_path_id {my$m=shift;my$f=$m->[_f ];my ($e,$n);if ($m->[_a ]==2 && @_==2 &&!($f & (_HYPER|_REF|_UNIQ))){@_=sort @_ if ($f & _UNORD);return unless exists$m->[_s ]->{$_[0]};my$p=$m->[_s ]->{$_[0]};$e=exists$p->{$_[1]};$n=$p->{$_[1]}}else {($e,$n)=$m->_get_path_node(@_)}return undef unless$e;return ref$n ? $n->[_ni ]: $n}sub _get_path_count {my$m=shift;my$f=$m->[_f ];my ($e,$n)=$m->_get_path_node(@_);return undef unless$e && defined$n;return ($f & _COUNT)? $n->[_nc ]: ($f & _MULTI)? scalar keys %{$n->[_nm ]}: 1}sub __attr {my$m=shift;if (@_){if (ref $_[0]&& @{$_[0]}){if (@{$_[0]}!=$m->[_a ]){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Heavy: arguments %d expected %d\n",scalar @{$_[0]},$m->[_a ])}my$f=$m->[_f ];if (@{$_[0]}> 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @{$_[0]}==2){@{$_[0]}=sort @{$_[0]}}else {$m->__arg(\@_)}}}}}sub _get_id_path {my ($m,$i)=@_;my$p=defined$i ? $m->[_i ]->{$i }: undef;return defined$p ? @$p : ()}sub del_path {my$m=shift;my$f=$m->[_f ];if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($e,$n,$p,$k,$l)=$m->__get_path_node(@_);return unless$e;my$c=($f & _COUNT)? --$n->[_nc ]: 0;if ($c==0){delete$m->[_i ]->{ref$n ? $n->[_ni ]: $n };delete$p->[-1]->{$l };while (@$p && @$k && keys %{$p->[-1]->{$k->[-1]}}==0){delete$p->[-1]->{$k->[-1]};pop @$p;pop @$k}}return 1}sub del_path_by_multi_id {my$m=shift;my$f=$m->[_f ];my$id=pop;if (@_ > 1 && ($f & _UNORDUNIQ)){if (($f & _UNORDUNIQ)==_UNORD && @_==2){@_=sort @_}else {$m->__arg(\@_)}}my ($e,$n,$p,$k,$l)=$m->__get_path_node(@_);return unless$e;delete$n->[_nm ]->{$id };unless (keys %{$n->[_nm ]}){delete$m->[_i ]->{$n->[_ni ]};delete$p->[-1]->{$l };while (@$p && @$k && keys %{$p->[-1]->{$k->[-1]}}==0){delete$p->[-1]->{$k->[-1]};pop @$p;pop @$k}}return 1}sub paths {my$m=shift;return values %{$m->[_i ]}if defined$m->[_i ];wantarray ? (): 0}1; +GRAPH_ADJACENCYMAP_HEAVY + +$fatpacked{"Graph/AdjacencyMap/Light.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMAP_LIGHT'; + package Graph::AdjacencyMap::Light;use strict;use Graph::AdjacencyMap qw(:flags :fields);use base 'Graph::AdjacencyMap';use Scalar::Util qw(weaken);use Graph::AdjacencyMap::Heavy;use Graph::AdjacencyMap::Vertex;sub _V () {2}sub _E () {3}sub _F () {0}sub _new {my ($class,$graph,$flags,$arity)=@_;my$m=bless [],$class;$m->[_n ]=0;$m->[_f ]=$flags | _LIGHT;$m->[_a ]=$arity;$m->[_i ]={};$m->[_s ]={};$m->[_p ]={};$m->[_g ]=$graph;weaken$m->[_g ];return$m}sub set_path {my$m=shift;return if @_==0 &&!($m->[_f ]& _HYPER);my ($n,$f,$a,$i,$s,$p)=@$m;if ($a==2){@_=sort @_ if ($f & _UNORD)}my$e0=shift;if ($a==2){my$e1=shift;unless (exists$s->{$e0 }&& exists$s->{$e0 }->{$e1 }){$n=$m->[_n ]++;$i->{$n }=[$e0,$e1 ];$s->{$e0 }->{$e1 }=$n;$p->{$e1 }->{$e0 }=$n}}else {unless (exists$s->{$e0 }){$n=$m->[_n ]++;$s->{$e0 }=$n;$i->{$n }=$e0}}}sub has_path {my$m=shift;my ($n,$f,$a,$i,$s)=@$m;return 0 unless$a==@_;my$e;if ($a==2){@_=sort @_ if ($f & _UNORD);$e=shift;return 0 unless exists$s->{$e };$s=$s->{$e }}$e=shift;exists$s->{$e }}sub _get_path_id {my$m=shift;my ($n,$f,$a,$i,$s)=@$m;return undef unless$a==@_;my$e;if ($a==2){@_=sort @_ if ($f & _UNORD);$e=shift;return undef unless exists$s->{$e };$s=$s->{$e }}$e=shift;$s->{$e }}sub _get_path_count {my$m=shift;my ($n,$f,$a,$i,$s)=@$m;my$e;if (@_==2){@_=sort @_ if ($f & _UNORD);$e=shift;return undef unless exists$s->{$e };$s=$s->{$e }}$e=shift;return exists$s->{$e }? 1 : 0}sub has_paths {my$m=shift;my ($n,$f,$a,$i,$s)=@$m;keys %$s}sub paths {my$m=shift;my ($n,$f,$a,$i)=@$m;if (defined$i){my ($k,$v)=each %$i;if (ref$v){return values %{$i}}else {return map {[$_ ]}values %{$i}}}else {return ()}}sub _get_id_path {my$m=shift;my ($n,$f,$a,$i)=@$m;my$p=$i->{$_[0 ]};defined$p ? (ref$p eq 'ARRAY' ? @$p : $p): ()}sub del_path {my$m=shift;my ($n,$f,$a,$i,$s,$p)=@$m;if (@_==2){@_=sort @_ if ($f & _UNORD);my$e0=shift;return 0 unless exists$s->{$e0 };my$e1=shift;if (defined($n=$s->{$e0 }->{$e1 })){delete$i->{$n };delete$s->{$e0 }->{$e1 };delete$p->{$e1 }->{$e0 };delete$s->{$e0 }unless keys %{$s->{$e0 }};delete$p->{$e1 }unless keys %{$p->{$e1 }};return 1}}else {my$e=shift;if (defined($n=$s->{$e })){delete$i->{$n };delete$s->{$e };return 1}}return 0}sub __successors {my$E=shift;return wantarray ? (): 0 unless defined$E->[_s ];my$g=shift;my$V=$g->[_V ];return wantarray ? (): 0 unless defined$V && defined$V->[_s ];my$i=($V->[_f ]& _LIGHT)? $V->[_s ]->{$_[0]}: $V->_get_path_id($_[0]);return wantarray ? (): 0 unless defined$i && defined$E->[_s ]->{$i };return keys %{$E->[_s ]->{$i }}}sub _successors {my$E=shift;my$g=shift;my@s=$E->__successors($g,@_);if (($E->[_f ]& _UNORD)){push@s,$E->__predecessors($g,@_);my%s;@s{@s }=();@s=keys%s}my$V=$g->[_V ];return wantarray ? map {$V->[_i ]->{$_ }}@s : @s}sub __predecessors {my$E=shift;return wantarray ? (): 0 unless defined$E->[_p ];my$g=shift;my$V=$g->[_V ];return wantarray ? (): 0 unless defined$V && defined$V->[_s ];my$i=($V->[_f ]& _LIGHT)? $V->[_s ]->{$_[0]}: $V->_get_path_id($_[0]);return wantarray ? (): 0 unless defined$i && defined$E->[_p ]->{$i };return keys %{$E->[_p ]->{$i }}}sub _predecessors {my$E=shift;my$g=shift;my@p=$E->__predecessors($g,@_);if ($E->[_f ]& _UNORD){push@p,$E->__successors($g,@_);my%p;@p{@p }=();@p=keys%p}my$V=$g->[_V ];return wantarray ? map {$V->[_i ]->{$_ }}@p : @p}sub __attr {my$m=$_[0];my ($n,$f,$a,$i,$s,$p,$g)=@$m;my ($k,$v)=each %$i;my@V=@{$g->[_V ]};my@E=$g->edges;if (ref$v eq 'ARRAY'){@E=$g->edges;$g->[_E ]=$m=Graph::AdjacencyMap::Heavy->_new($f,2);$g->add_edges(@E)}else {$m=Graph::AdjacencyMap::Vertex->_new(($f & ~_LIGHT),1);$m->[_n ]=$V[_n ];$m->[_i ]=$V[_i ];$m->[_s ]=$V[_s ];$m->[_p ]=$V[_p ];$g->[_V ]=$m}$_[0]=$m;goto &{ref($m)."::__attr"}}sub _is_COUNT () {0}sub _is_MULTI () {0}sub _is_HYPER () {0}sub _is_UNIQ () {0}sub _is_REF () {0}1; +GRAPH_ADJACENCYMAP_LIGHT + +$fatpacked{"Graph/AdjacencyMap/Vertex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMAP_VERTEX'; + package Graph::AdjacencyMap::Vertex;use strict;use Graph::AdjacencyMap qw(:flags :fields);use base 'Graph::AdjacencyMap';use Scalar::Util qw(weaken);sub _new {my ($class,$flags,$arity)=@_;bless [0,$flags,$arity ],$class}require overload;sub __strval {my ($k,$f)=@_;ref$k && ($f & _REF)&& (($f & _STR)?!overload::Method($k,'""'): overload::Method($k,'""'))? overload::StrVal($k): $k}sub __set_path {my$m=shift;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);if (@_!=1){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Vertex: arguments %d expected 1",scalar @_)}my$p;$p=$m->[_s ]||= {};my@p=$p;my@k;my$k=shift;my$q=__strval($k,$f);push@k,$q;return (\@p,\@k)}sub __set_path_node {my ($m,$p,$l)=splice @_,0,3;my$f=$m->[_f ];my$id=pop if ($f & _MULTI);unless (exists$p->[-1]->{$l }){my$i=$m->_new_node(\$p->[-1]->{$l },$id);$m->[_i ]->{defined$i ? $i : "" }=$_[0]}else {$m->_inc_node(\$p->[-1]->{$l },$id)}}sub set_path {my$m=shift;my$f=$m->[_f ];my ($p,$k)=$m->__set_path(@_);return unless defined$p && defined$k;my$l=defined$k->[-1]? $k->[-1]: "";my$set=$m->__set_path_node($p,$l,@_);return$set}sub __has_path {my$m=shift;my$f=$m->[_f ];if (@_!=1){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap: arguments %d expected 1\n",scalar @_)}my$p=$m->[_s ];return unless defined$p;my@p=$p;my@k;my$k=shift;my$q=__strval($k,$f);push@k,$q;return (\@p,\@k)}sub has_path {my$m=shift;my ($p,$k)=$m->__has_path(@_);return unless defined$p && defined$k;return exists$p->[-1]->{defined$k->[-1]? $k->[-1]: "" }}sub has_path_by_multi_id {my$m=shift;my$id=pop;my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return exists$n->[_nm ]->{$id }}sub _get_path_id {my$m=shift;my$f=$m->[_f ];my ($e,$n)=$m->__get_path_node(@_);return undef unless$e;return ref$n ? $n->[_ni ]: $n}sub _get_path_count {my$m=shift;my$f=$m->[_f ];my ($e,$n)=$m->__get_path_node(@_);return 0 unless$e && defined$n;return ($f & _COUNT)? $n->[_nc ]: ($f & _MULTI)? scalar keys %{$n->[_nm ]}: 1}sub __attr {my$m=shift;if (@_ && ref $_[0]&& @{$_[0]}!=$m->[_a ]){require Carp;Carp::confess(sprintf "Graph::AdjacencyMap::Vertex: arguments %d expected %d",scalar @{$_[0]},$m->[_a ])}}sub _get_id_path {my ($m,$i)=@_;return defined$m->[_i ]? $m->[_i ]->{$i }: undef}sub del_path {my$m=shift;my$f=$m->[_f ];my ($e,$n,$p,$k,$l)=$m->__get_path_node(@_);return unless$e;my$c=($f & _COUNT)? --$n->[_nc ]: 0;if ($c==0){delete$m->[_i ]->{ref$n ? $n->[_ni ]: $n };delete$p->[-1 ]->{$l }}return 1}sub del_path_by_multi_id {my$m=shift;my$f=$m->[_f ];my$id=pop;my ($e,$n,$p,$k,$l)=$m->__get_path_node(@_);return unless$e;delete$n->[_nm ]->{$id };unless (keys %{$n->[_nm ]}){delete$m->[_i ]->{$n->[_ni ]};delete$p->[-1]->{$l }}return 1}sub paths {my$m=shift;return map {[$_ ]}values %{$m->[_i ]}if defined$m->[_i ];wantarray ? (): 0}1; +GRAPH_ADJACENCYMAP_VERTEX + +$fatpacked{"Graph/AdjacencyMatrix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ADJACENCYMATRIX'; + package Graph::AdjacencyMatrix;use strict;use Graph::BitMatrix;use Graph::Matrix;use base 'Graph::BitMatrix';use Graph::AdjacencyMap qw(:flags :fields);sub _V () {2}sub _E () {3}sub new {my ($class,$g,%opt)=@_;my$n;my@V=$g->vertices;my$want_distance;if (exists$opt{distance_matrix}){$want_distance=$opt{distance_matrix};delete$opt{distance_matrix}}my$d=Graph::_defattr();if (exists$opt{attribute_name}){$d=$opt{attribute_name};$want_distance++}delete$opt{attribute_name};my$want_transitive=0;if (exists$opt{is_transitive}){$want_transitive=$opt{is_transitive};delete$opt{is_transitive}}Graph::_opt_unknown(\%opt);if ($want_distance){$n=Graph::Matrix->new($g);for my$v (@V){$n->set($v,$v,0)}}my$m=Graph::BitMatrix->new($g,connect_edges=>$want_distance);if ($want_distance){my$Vi=$g->[_V]->[_i];my$Ei=$g->[_E]->[_i];my%V;@V{@V }=0 .. $#V;my$n0=$n->[0];my$n1=$n->[1];if ($g->is_undirected){for my$e (keys %{$Ei}){my ($i0,$j0)=@{$Ei->{$e }};my$i1=$V{$Vi->{$i0 }};my$j1=$V{$Vi->{$j0 }};my$u=$V[$i1 ];my$v=$V[$j1 ];$n0->[$i1 ]->[$j1 ]=$g->get_edge_attribute($u,$v,$d);$n0->[$j1 ]->[$i1 ]=$g->get_edge_attribute($v,$u,$d)}}else {for my$e (keys %{$Ei}){my ($i0,$j0)=@{$Ei->{$e }};my$i1=$V{$Vi->{$i0 }};my$j1=$V{$Vi->{$j0 }};my$u=$V[$i1 ];my$v=$V[$j1 ];$n0->[$i1 ]->[$j1 ]=$g->get_edge_attribute($u,$v,$d)}}}bless [$m,$n,[@V ]],$class}sub adjacency_matrix {my$am=shift;$am->[0]}sub distance_matrix {my$am=shift;$am->[1]}sub vertices {my$am=shift;@{$am->[2]}}sub is_adjacent {my ($m,$u,$v)=@_;$m->[0]->get($u,$v)? 1 : 0}sub distance {my ($m,$u,$v)=@_;defined$m->[1]? $m->[1]->get($u,$v): undef}1; +GRAPH_ADJACENCYMATRIX + +$fatpacked{"Graph/Attribute.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_ATTRIBUTE'; + package Graph::Attribute;use strict;sub _F () {0}sub _COMPAT02 () {0x00000001}sub import {my$package=shift;my%attr=@_;my$caller=caller(0);if (exists$attr{array}){my$i=$attr{array};no strict 'refs';*{"${caller}::_get_attributes"}=sub {$_[0]->[$i ]};*{"${caller}::_set_attributes"}=sub {$_[0]->[$i ]||= {};$_[0]->[$i ]=$_[1]if @_==2;$_[0]->[$i ]};*{"${caller}::_has_attributes"}=sub {defined $_[0]->[$i ]};*{"${caller}::_delete_attributes"}=sub {undef $_[0]->[$i ];1}}elsif (exists$attr{hash}){my$k=$attr{hash};no strict 'refs';*{"${caller}::_get_attributes"}=sub {$_[0]->{$k }};*{"${caller}::_set_attributes"}=sub {$_[0]->{$k }||= {};$_[0]->{$k }=$_[1]if @_==2;$_[0]->{$k }};*{"${caller}::_has_attributes"}=sub {defined $_[0]->{$k }};*{"${caller}::_delete_attributes"}=sub {delete $_[0]->{$k }}}else {die "Graph::Attribute::import($package @_) caller $caller\n"}my@api=qw(get_attribute get_attributes set_attribute set_attributes has_attribute has_attributes delete_attribute delete_attributes get_attribute_names get_attribute_values);if (exists$attr{map}){my$map=$attr{map};for my$api (@api){my ($first,$rest)=($api =~ /^(\w+?)_(.+)/);no strict 'refs';*{"${caller}::${first}_${map}_${rest}"}=\&$api}}}sub set_attribute {my$g=shift;my$v=pop;my$a=pop;my$p=$g->_set_attributes;$p->{$a }=$v;return 1}sub set_attributes {my$g=shift;my$a=pop;my$p=$g->_set_attributes($a);return 1}sub has_attribute {my$g=shift;my$a=pop;my$p=$g->_get_attributes;$p ? exists$p->{$a }: 0}sub has_attributes {my$g=shift;$g->_get_attributes ? 1 : 0}sub get_attribute {my$g=shift;my$a=pop;my$p=$g->_get_attributes;$p ? $p->{$a }: undef}sub delete_attribute {my$g=shift;my$a=pop;my$p=$g->_get_attributes;if (defined$p){delete$p->{$a };return 1}else {return 0}}sub delete_attributes {my$g=shift;if ($g->_has_attributes){$g->_delete_attributes;return 1}else {return 0}}sub get_attribute_names {my$g=shift;my$p=$g->_get_attributes;defined$p ? keys %{$p}: ()}sub get_attribute_values {my$g=shift;my$p=$g->_get_attributes;defined$p ? values %{$p}: ()}sub get_attributes {my$g=shift;my$a=$g->_get_attributes;($g->[_F ]& _COMPAT02)? (defined$a ? %{$a}: ()): $a}1; +GRAPH_ATTRIBUTE + +$fatpacked{"Graph/BitMatrix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_BITMATRIX'; + package Graph::BitMatrix;use strict;sub _V () {2}sub _E () {3}sub _i () {3}sub _s () {4}sub new {my ($class,$g,%opt)=@_;my@V=$g->vertices;my$V=@V;my$Z="\0" x (($V + 7)/ 8);my%V;@V{@V }=0 .. $#V;my$bm=bless [[($Z)x $V ],\%V ],$class;my$bm0=$bm->[0];my$connect_edges;if (exists$opt{connect_edges}){$connect_edges=$opt{connect_edges};delete$opt{connect_edges}}$connect_edges=1 unless defined$connect_edges;Graph::_opt_unknown(\%opt);if ($connect_edges){my$Vi=$g->[_V]->[_i];my$Ei=$g->[_E]->[_i];if ($g->is_undirected){for my$e (keys %{$Ei}){my ($i0,$j0)=@{$Ei->{$e }};my$i1=$V{$Vi->{$i0 }};my$j1=$V{$Vi->{$j0 }};vec($bm0->[$i1],$j1,1)=1;vec($bm0->[$j1],$i1,1)=1}}else {for my$e (keys %{$Ei}){my ($i0,$j0)=@{$Ei->{$e }};vec($bm0->[$V{$Vi->{$i0 }}],$V{$Vi->{$j0 }},1)=1}}}return$bm}sub set {my ($m,$u,$v)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);vec($m->[0]->[$i],$j,1)=1 if defined$i && defined$j}sub unset {my ($m,$u,$v)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);vec($m->[0]->[$i],$j,1)=0 if defined$i && defined$j}sub get {my ($m,$u,$v)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);defined$i && defined$j ? vec($m->[0]->[$i],$j,1): undef}sub set_row {my ($m,$u)=splice @_,0,2;my$m0=$m->[0];my$m1=$m->[1];my$i=$m1->{$u };return unless defined$i;for my$v (@_){my$j=$m1->{$v };vec($m0->[$i],$j,1)=1 if defined$j}}sub unset_row {my ($m,$u)=splice @_,0,2;my$m0=$m->[0];my$m1=$m->[1];my$i=$m1->{$u };return unless defined$i;for my$v (@_){my$j=$m1->{$v };vec($m0->[$i],$j,1)=0 if defined$j}}sub get_row {my ($m,$u)=splice @_,0,2;my$m0=$m->[0];my$m1=$m->[1];my$i=$m1->{$u };return ()x @_ unless defined$i;my@r;for my$v (@_){my$j=$m1->{$v };push@r,defined$j ? (vec($m0->[$i],$j,1)? 1 : 0): undef}return@r}sub vertices {my ($m,$u,$v)=@_;keys %{$m->[1]}}1; +GRAPH_BITMATRIX + +$fatpacked{"Graph/Directed.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_DIRECTED'; + package Graph::Directed;use Graph;use base 'Graph';use strict;1; +GRAPH_DIRECTED + +$fatpacked{"Graph/MSTHeapElem.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_MSTHEAPELEM'; + package Graph::MSTHeapElem;use strict;use vars qw($VERSION @ISA);use Heap071::Elem;use base 'Heap071::Elem';sub new {my$class=shift;bless {u=>$_[0],v=>$_[1],w=>$_[2]},$class}sub cmp {($_[0]->{w }|| 0)<=> ($_[1]->{w }|| 0)}sub val {@{$_[0]}{qw(u v w) }}1; +GRAPH_MSTHEAPELEM + +$fatpacked{"Graph/Matrix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_MATRIX'; + package Graph::Matrix;use strict;sub new {my ($class,$g)=@_;my@V=$g->vertices;my$V=@V;my%V;@V{@V }=0 .. $#V;bless [[map {[]}0 .. $#V ],\%V ],$class}sub set {my ($m,$u,$v,$val)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);$m->[0]->[$i]->[$j]=$val}sub get {my ($m,$u,$v)=@_;my ($i,$j)=map {$m->[1]->{$_ }}($u,$v);$m->[0]->[$i]->[$j]}1; +GRAPH_MATRIX + +$fatpacked{"Graph/SPTHeapElem.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_SPTHEAPELEM'; + package Graph::SPTHeapElem;use strict;use vars qw($VERSION @ISA);use Heap071::Elem;use base 'Heap071::Elem';sub new {my$class=shift;bless {u=>$_[0],v=>$_[1],w=>$_[2]},$class}sub cmp {($_[0]->{w }|| 0)<=> ($_[1]->{w }|| 0)|| ($_[0]->{u }cmp $_[1]->{u })|| ($_[0]->{u }cmp $_[1]->{v })}sub val {@{$_[0]}{qw(u v w) }}1; +GRAPH_SPTHEAPELEM + +$fatpacked{"Graph/TransitiveClosure.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRANSITIVECLOSURE'; + package Graph::TransitiveClosure;use strict;use base 'Graph';use Graph::TransitiveClosure::Matrix;sub _G () {Graph::_G()}sub new {my ($class,$g,%opt)=@_;$g->expect_non_multiedged;%opt=(path_vertices=>1)unless%opt;my$attr=Graph::_defattr();if (exists$opt{attribute_name }){$attr=$opt{attribute_name }}$opt{reflexive }=1 unless exists$opt{reflexive };my$tcm=$g->new($opt{reflexive }? (vertices=>[$g->vertices ]): ());my$tcg=$g->get_graph_attribute('_tcg');if (defined$tcg && $tcg->[0 ]==$g->[_G ]){$tcg=$tcg->[1 ]}else {$tcg=Graph::TransitiveClosure::Matrix->new($g,%opt);$g->set_graph_attribute('_tcg',[$g->[_G ],$tcg ])}my$tcg00=$tcg->[0]->[0];my$tcg11=$tcg->[1]->[1];for my$u ($tcg->vertices){my$tcg00i=$tcg00->[$tcg11->{$u }];for my$v ($tcg->vertices){next if$u eq $v &&!$opt{reflexive };my$j=$tcg11->{$v };if (vec($tcg00i,$j,1)){my$val=$g->_get_edge_attribute($u,$v,$attr);$tcm->_set_edge_attribute($u,$v,$attr,defined$val ? $val : $u eq $v ? 0 : 1)}}}$tcm->set_graph_attribute('_tcm',$tcg);bless$tcm,$class}sub is_transitive {my$g=shift;$g->expect_no_args(@_);Graph::TransitiveClosure::Matrix::is_transitive($g)}1; +GRAPH_TRANSITIVECLOSURE + +$fatpacked{"Graph/TransitiveClosure/Matrix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRANSITIVECLOSURE_MATRIX'; + package Graph::TransitiveClosure::Matrix;use strict;use Graph::AdjacencyMatrix;use Graph::Matrix;sub _new {my ($g,$class,$opt,$want_transitive,$want_reflexive,$want_path,$want_path_vertices)=@_;my$m=Graph::AdjacencyMatrix->new($g,%$opt);my@V=$g->vertices;my$am=$m->adjacency_matrix;my$dm;my$pm;my@di;my%di;@di{@V }=0..$#V;my@ai=@{$am->[0]};my%ai=%{$am->[1]};my@pi;my%pi;unless ($want_transitive){$dm=$m->distance_matrix;@di=@{$dm->[0]};%di=%{$dm->[1]};$pm=Graph::Matrix->new($g);@pi=@{$pm->[0]};%pi=%{$pm->[1]};for my$u (@V){my$diu=$di{$u};my$aiu=$ai{$u};for my$v (@V){my$div=$di{$v};my$aiv=$ai{$v};next unless vec($ai[$aiu],$aiv,1);$di[$diu]->[$div]=$u eq $v ? 0 : 1 unless defined $di[$diu]->[$div];$pi[$diu]->[$div]=$v unless$u eq $v}}}for my$u (@V){my$diu=$di{$u};my$aiu=$ai{$u};my$didiu=$di[$diu];my$aiaiu=$ai[$aiu];for my$v (@V){my$div=$di{$v};my$aiv=$ai{$v};my$didiv=$di[$div];my$aiaiv=$ai[$aiv];if (vec($aiaiv,$aiu,1)|| ($want_reflexive && $u eq $v)){my$aivivo=$aiaiv;if ($want_transitive){if ($want_reflexive){for my$w (@V){next if$w eq $u;my$aiw=$ai{$w};return 0 if vec($aiaiu,$aiw,1)&& !vec($aiaiv,$aiw,1)}}else {$aiaiv |= $aiaiu}}else {if ($want_reflexive){$aiaiv |= $aiaiu;vec($aiaiv,$aiu,1)=1}else {$aiaiv |= $aiaiu}}if ($aiaiv ne $aivivo){$ai[$aiv]=$aiaiv;$aiaiu=$aiaiv if$u eq $v}}if ($want_path &&!$want_transitive){for my$w (@V){my$aiw=$ai{$w};next unless vec($aiaiv,$aiu,1)&& vec($aiaiu,$aiw,1);my$diw=$di{$w};my ($d0,$d1a,$d1b);if (defined$dm){$d0=$didiv->[$diw];$d1a=$didiv->[$diu]|| 1;$d1b=$didiu->[$diw]|| 1}else {$d1a=1;$d1b=1}my$d1=$d1a + $d1b;if (!defined$d0 || ($d1 < $d0)){$didiv->[$diw]=$d1;$pi[$div]->[$diw]=$pi[$div]->[$diu]if$want_path_vertices}}$didiu->[$div]=1 if$u ne $v && vec($aiaiu,$aiv,1)&& !defined$didiu->[$div]}}}return 1 if$want_transitive;my%V;@V{@V }=@V;$am->[0]=\@ai;$am->[1]=\%ai;if (defined$dm){$dm->[0]=\@di;$dm->[1]=\%di}if (defined$pm){$pm->[0]=\@pi;$pm->[1]=\%pi}bless [$am,$dm,$pm,\%V ],$class}sub new {my ($class,$g,%opt)=@_;my%am_opt=(distance_matrix=>1);if (exists$opt{attribute_name}){$am_opt{attribute_name}=$opt{attribute_name};delete$opt{attribute_name}}if ($opt{distance_matrix}){$am_opt{distance_matrix}=$opt{distance_matrix}}delete$opt{distance_matrix};if (exists$opt{path}){$opt{path_length}=$opt{path};$opt{path_vertices}=$opt{path};delete$opt{path}}my$want_path_length;if (exists$opt{path_length}){$want_path_length=$opt{path_length};delete$opt{path_length}}my$want_path_vertices;if (exists$opt{path_vertices}){$want_path_vertices=$opt{path_vertices};delete$opt{path_vertices}}my$want_reflexive;if (exists$opt{reflexive}){$want_reflexive=$opt{reflexive};delete$opt{reflexive}}my$want_transitive;if (exists$opt{is_transitive}){$want_transitive=$opt{is_transitive};$am_opt{is_transitive}=$want_transitive;delete$opt{is_transitive}}die "Graph::TransitiveClosure::Matrix::new: Unknown options: @{[map { qq['$_' => $opt{$_}]} keys %opt]}" if keys%opt;$want_reflexive=1 unless defined$want_reflexive;my$want_path=$want_path_length || $want_path_vertices;_new($g,$class,\%am_opt,$want_transitive,$want_reflexive,$want_path,$want_path_vertices)}sub has_vertices {my$tc=shift;for my$v (@_){return 0 unless exists$tc->[3]->{$v }}return 1}sub is_reachable {my ($tc,$u,$v)=@_;return undef unless$tc->has_vertices($u,$v);return 1 if$u eq $v;$tc->[0]->get($u,$v)}sub is_transitive {if (@_==1){__PACKAGE__->new($_[0],is_transitive=>1)}else {my ($tc,$u,$v)=@_;return undef unless$tc->has_vertices($u,$v);$tc->[0]->get($u,$v)}}sub vertices {my$tc=shift;values %{$tc->[3]}}sub path_length {my ($tc,$u,$v)=@_;return undef unless$tc->has_vertices($u,$v);return 0 if$u eq $v;$tc->[1]->get($u,$v)}sub path_predecessor {my ($tc,$u,$v)=@_;return undef if$u eq $v;return undef unless$tc->has_vertices($u,$v);$tc->[2]->get($u,$v)}sub path_vertices {my ($tc,$u,$v)=@_;return unless$tc->is_reachable($u,$v);return wantarray ? (): 0 if$u eq $v;my@v=($u);while ($u ne $v){last unless defined($u=$tc->path_predecessor($u,$v));push@v,$u}$tc->[2]->set($u,$v,[@v ])if@v;return@v}1; +GRAPH_TRANSITIVECLOSURE_MATRIX + +$fatpacked{"Graph/Traversal.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRAVERSAL'; + package Graph::Traversal;use strict;sub DEBUG () {0}sub reset {my$self=shift;$self->{unseen }={map {$_=>$_}$self->{graph }->vertices };$self->{seen }={};$self->{order }=[];$self->{preorder }=[];$self->{postorder }=[];$self->{roots }=[];$self->{tree }=Graph->new(directed=>$self->{graph }->directed);delete$self->{terminate }}my$see=sub {my$self=shift;$self->see};my$see_active=sub {my$self=shift;delete @{$self->{active }}{$self->see }};sub has_a_cycle {my ($u,$v,$t,$s)=@_;$s->{has_a_cycle }=1;$t->terminate}sub find_a_cycle {my ($u,$v,$t,$s)=@_;my@cycle=($u);push@cycle,$v unless$u eq $v;my$path=$t->{order };if (@$path){my$i=$#$path;while ($i >= 0 && $path->[$i ]ne $v){$i--}if ($i >= 0){unshift@cycle,@{$path}[$i+1 .. $#$path ]}}$s->{a_cycle }=\@cycle;$t->terminate}sub configure {my ($self,%attr)=@_;$self->{pre }=$attr{pre }if exists$attr{pre };$self->{post }=$attr{post }if exists$attr{post };$self->{pre_vertex }=$attr{pre_vertex }if exists$attr{pre_vertex };$self->{post_vertex }=$attr{post_vertex }if exists$attr{post_vertex };$self->{pre_edge }=$attr{pre_edge }if exists$attr{pre_edge };$self->{post_edge }=$attr{post_edge }if exists$attr{post_edge };if (exists$attr{successor }){$self->{tree_edge }=$self->{non_tree_edge }=$attr{successor }}if (exists$attr{unseen_successor }){if (exists$self->{tree_edge }){my$old_tree_edge=$self->{tree_edge };$self->{tree_edge }=sub {$old_tree_edge->(@_);$attr{unseen_successor }->(@_)}}else {$self->{tree_edge }=$attr{unseen_successor }}}if ($self->graph->multiedged || $self->graph->countedged){$self->{seen_edge }=$attr{seen_edge }if exists$attr{seen_edge };if (exists$attr{seen_successor }){$self->{seen_edge }=$attr{seen_edge }}}$self->{non_tree_edge }=$attr{non_tree_edge }if exists$attr{non_tree_edge };$self->{pre_edge }=$attr{tree_edge }if exists$attr{tree_edge };$self->{back_edge }=$attr{back_edge }if exists$attr{back_edge };$self->{down_edge }=$attr{down_edge }if exists$attr{down_edge };$self->{cross_edge }=$attr{cross_edge }if exists$attr{cross_edge };if (exists$attr{start }){$attr{first_root }=$attr{start };$attr{next_root }=undef}if (exists$attr{get_next_root }){$attr{next_root }=$attr{get_next_root }}$self->{next_root }=exists$attr{next_root }? $attr{next_root }: $attr{next_alphabetic }? \&Graph::_next_alphabetic : $attr{next_numeric }? \&Graph::_next_numeric : \&Graph::_next_random;$self->{first_root }=exists$attr{first_root }? $attr{first_root }: exists$attr{next_root }? $attr{next_root }: $attr{next_alphabetic }? \&Graph::_next_alphabetic : $attr{next_numeric }? \&Graph::_next_numeric : \&Graph::_next_random;$self->{next_successor }=exists$attr{next_successor }? $attr{next_successor }: $attr{next_alphabetic }? \&Graph::_next_alphabetic : $attr{next_numeric }? \&Graph::_next_numeric : \&Graph::_next_random;if (exists$attr{has_a_cycle }){my$has_a_cycle=ref$attr{has_a_cycle }eq 'CODE' ? $attr{has_a_cycle }: \&has_a_cycle;$self->{back_edge }=$has_a_cycle;if ($self->{graph }->is_undirected){$self->{down_edge }=$has_a_cycle}}if (exists$attr{find_a_cycle }){my$find_a_cycle=ref$attr{find_a_cycle }eq 'CODE' ? $attr{find_a_cycle }: \&find_a_cycle;$self->{back_edge }=$find_a_cycle;if ($self->{graph }->is_undirected){$self->{down_edge }=$find_a_cycle}}$self->{add }=\&add_order;$self->{see }=$see;delete@attr{qw(pre post pre_edge post_edge successor unseen_successor seen_successor tree_edge non_tree_edge back_edge down_edge cross_edge seen_edge start get_next_root next_root next_alphabetic next_numeric next_random next_successor first_root has_a_cycle find_a_cycle) };if (keys%attr){require Carp;my@attr=sort keys%attr;Carp::croak(sprintf "Graph::Traversal: unknown attribute%s @{[map { qq['$_'] } @attr]}\n",@attr==1 ? '' : 's')}}sub new {my$class=shift;my$g=shift;unless (ref$g && $g->isa('Graph')){require Carp;Carp::croak("Graph::Traversal: first argument is not a Graph")}my$self={graph=>$g,state=>{}};bless$self,$class;$self->reset;$self->configure(@_);return$self}sub terminate {my$self=shift;$self->{terminate }=1}sub add_order {my ($self,@next)=@_;push @{$self->{order }},@next}sub visit {my ($self,@next)=@_;delete @{$self->{unseen }}{@next };print "unseen = @{[sort keys %{$self->{unseen}}]}\n" if DEBUG;@{$self->{seen }}{@next }=@next;print "seen = @{[sort keys %{$self->{seen}}]}\n" if DEBUG;$self->{add }->($self,@next);print "order = @{$self->{order}}\n" if DEBUG;if (exists$self->{pre }){my$p=$self->{pre };for my$v (@next){$p->($v,$self)}}}sub visit_preorder {my ($self,@next)=@_;push @{$self->{preorder }},@next;for my$v (@next){$self->{preordern }->{$v }=$self->{preorderi }++}print "preorder = @{$self->{preorder}}\n" if DEBUG;$self->visit(@next)}sub visit_postorder {my ($self)=@_;my@post=reverse$self->{see }->($self);push @{$self->{postorder }},@post;for my$v (@post){$self->{postordern }->{$v }=$self->{postorderi }++}print "postorder = @{$self->{postorder}}\n" if DEBUG;if (exists$self->{post }){my$p=$self->{post };for my$v (@post){$p->($v,$self)}}if (exists$self->{post_edge }){my$p=$self->{post_edge };my$u=$self->current;if (defined$u){for my$v (@post){$p->($u,$v,$self,$self->{state })}}}}sub _callbacks {my ($self,$current,@all)=@_;return unless@all;my$nontree=$self->{non_tree_edge };my$back=$self->{back_edge };my$down=$self->{down_edge };my$cross=$self->{cross_edge };my$seen=$self->{seen_edge };my$bdc=defined$back || defined$down || defined$cross;if (defined$nontree || $bdc || defined$seen){my$u=$current;my$preu=$self->{preordern }->{$u };my$postu=$self->{postordern }->{$u };for my$v (@all){my$e=$self->{tree }->has_edge($u,$v);if (!$e && (defined$nontree || $bdc)){if (exists$self->{seen }->{$v }){$nontree->($u,$v,$self,$self->{state })if$nontree;if ($bdc){my$postv=$self->{postordern }->{$v };if ($back && (!defined$postv || $postv >= $postu)){$back ->($u,$v,$self,$self->{state })}else {my$prev=$self->{preordern }->{$v };if ($down && $prev > $preu){$down ->($u,$v,$self,$self->{state })}elsif ($cross && $prev < $preu){$cross->($u,$v,$self,$self->{state })}}}}}if ($seen){my$c=$self->graph->get_edge_count($u,$v);while ($c-- > 1){$seen->($u,$v,$self,$self->{state })}}}}}sub next {my$self=shift;return undef if$self->{terminate };my@next;while ($self->seeing){my$current=$self->current;print "current = $current\n" if DEBUG;@next=$self->{graph }->successors($current);print "next.0 - @next\n" if DEBUG;my%next;@next{@next }=@next;print "next.1 - @next\n" if DEBUG;@next=values%next;my@all=@next;print "all = @all\n" if DEBUG;for my$s (keys%next){delete$next{$s}if exists$self->{seen}->{$s}}@next=values%next;print "next.2 - @next\n" if DEBUG;if (@next){@next=$self->{next_successor }->($self,\%next);print "next.3 - @next\n" if DEBUG;for my$v (@next){$self->{tree }->add_edge($current,$v)}if (exists$self->{pre_edge }){my$p=$self->{pre_edge };my$u=$self->current;for my$v (@next){$p->($u,$v,$self,$self->{state })}}last}else {$self->visit_postorder}return undef if$self->{terminate };$self->_callbacks($current,@all)}print "next.4 - @next\n" if DEBUG;unless (@next){unless (@{$self->{roots }}){my$first=$self->{first_root };if (defined$first){@next=ref$first eq 'CODE' ? $self->{first_root }->($self,$self->{unseen }): $first;return unless@next}}unless (@next){return unless defined$self->{next_root };return unless@next=$self->{next_root }->($self,$self->{unseen })}return if exists$self->{seen }->{$next[0]};print "next.5 - @next\n" if DEBUG;push @{$self->{roots }},$next[0]}print "next.6 - @next\n" if DEBUG;if (@next){$self->visit_preorder(@next)}return$next[0]}sub _order {my ($self,$order)=@_;1 while defined$self->next;my$wantarray=wantarray;if ($wantarray){@{$self->{$order }}}elsif (defined$wantarray){shift @{$self->{$order }}}}sub preorder {my$self=shift;$self->_order('preorder')}sub postorder {my$self=shift;$self->_order('postorder')}sub unseen {my$self=shift;values %{$self->{unseen }}}sub seen {my$self=shift;values %{$self->{seen }}}sub seeing {my$self=shift;@{$self->{order }}}sub roots {my$self=shift;@{$self->{roots }}}sub is_root {my ($self,$v)=@_;for my$u (@{$self->{roots }}){return 1 if$u eq $v}return 0}sub tree {my$self=shift;$self->{tree }}sub graph {my$self=shift;$self->{graph }}sub vertex_by_postorder {my ($self,$i)=@_;exists$self->{postorder }&& $self->{postorder }->[$i ]}sub postorder_by_vertex {my ($self,$v)=@_;exists$self->{postordern }&& $self->{postordern }->{$v }}sub postorder_vertices {my ($self,$v)=@_;exists$self->{postordern }? %{$self->{postordern }}: ()}sub vertex_by_preorder {my ($self,$i)=@_;exists$self->{preorder }&& $self->{preorder }->[$i ]}sub preorder_by_vertex {my ($self,$v)=@_;exists$self->{preordern }&& $self->{preordern }->{$v }}sub preorder_vertices {my ($self,$v)=@_;exists$self->{preordern }? %{$self->{preordern }}: ()}sub has_state {my ($self,$var)=@_;exists$self->{state }&& exists$self->{state }->{$var }}sub get_state {my ($self,$var)=@_;exists$self->{state }? $self->{state }->{$var }: undef}sub set_state {my ($self,$var,$val)=@_;$self->{state }->{$var }=$val;return 1}sub delete_state {my ($self,$var)=@_;delete$self->{state }->{$var };delete$self->{state }unless keys %{$self->{state }};return 1}1; +GRAPH_TRAVERSAL + +$fatpacked{"Graph/Traversal/BFS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRAVERSAL_BFS'; + package Graph::Traversal::BFS;use strict;use Graph::Traversal;use base 'Graph::Traversal';sub current {my$self=shift;$self->{order }->[0 ]}sub see {my$self=shift;shift @{$self->{order }}}*bfs=\&Graph::Traversal::postorder;1; +GRAPH_TRAVERSAL_BFS + +$fatpacked{"Graph/Traversal/DFS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_TRAVERSAL_DFS'; + package Graph::Traversal::DFS;use strict;use Graph::Traversal;use base 'Graph::Traversal';sub current {my$self=shift;$self->{order }->[-1 ]}sub see {my$self=shift;pop @{$self->{order }}}*dfs=\&Graph::Traversal::postorder;1; +GRAPH_TRAVERSAL_DFS + +$fatpacked{"Graph/Undirected.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_UNDIRECTED'; + package Graph::Undirected;use Graph;use base 'Graph';use strict;sub new {my$class=shift;bless Graph->new(undirected=>1,@_),ref$class || $class}1; +GRAPH_UNDIRECTED + +$fatpacked{"Graph/UnionFind.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPH_UNIONFIND'; + package Graph::UnionFind;use strict;sub _PARENT () {0}sub _RANK () {1}sub new {my$class=shift;bless {},$class}sub add {my ($self,$elem)=@_;$self->{$elem }=[$elem,0 ]unless defined$self->{$elem}}sub has {my ($self,$elem)=@_;exists$self->{$elem }}sub _parent {return undef unless defined $_[1];if (@_==2){exists $_[0]->{$_[1 ]}? $_[0]->{$_[1]}->[_PARENT ]: undef}elsif (@_==3){$_[0]->{$_[1]}->[_PARENT ]=$_[2]}else {require Carp;Carp::croak(__PACKAGE__ ."::_parent: bad arity")}}sub _rank {return unless defined $_[1];if (@_==2){exists $_[0]->{$_[1]}? $_[0]->{$_[1]}->[_RANK ]: undef}elsif (@_==3){$_[0]->{$_[1]}->[_RANK ]=$_[2]}else {require Carp;Carp::croak(__PACKAGE__ ."::_rank: bad arity")}}sub find {my ($self,$x)=@_;my$px=$self->_parent($x);return unless defined$px;$self->_parent($x,$self->find($px))if$px ne $x;$self->_parent($x)}sub union {my ($self,$x,$y)=@_;$self->add($x)unless$self->has($x);$self->add($y)unless$self->has($y);my$px=$self->find($x);my$py=$self->find($y);return if$px eq $py;my$rx=$self->_rank($px);my$ry=$self->_rank($py);if ($rx > $ry){$self->_parent($py,$px)}else {$self->_parent($px,$py);$self->_rank($py,$ry + 1)if$rx==$ry}}sub same {my ($uf,$u,$v)=@_;my$fu=$uf->find($u);return undef unless defined$fu;my$fv=$uf->find($v);return undef unless defined$fv;$fu eq $fv}1; +GRAPH_UNIONFIND + +$fatpacked{"Heap071/Elem.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HEAP071_ELEM'; + package Heap071::Elem;use strict;use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);require Exporter;require AutoLoader;@ISA=qw(Exporter AutoLoader);@EXPORT=();sub new {my$self=shift;my$class=ref($self)|| $self;return bless {heap=>undef,@_ },$class}sub heap {my$self=shift;@_ ? ($self->{heap}=shift): $self->{heap}}sub cmp {die "This cmp method must be superceded by one that knows how to compare elements."}1; +HEAP071_ELEM + +$fatpacked{"Heap071/Fibonacci.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HEAP071_FIBONACCI'; + package Heap071::Fibonacci;use strict;use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);require Exporter;require AutoLoader;@ISA=qw(Exporter AutoLoader);@EXPORT=();my$debug=0;my$validate=0;sub debug {@_ ? ($debug=shift): $debug}sub validate {@_ ? ($validate=shift): $validate}my$width=3;my$bar=' | ';my$corner=' +-';my$vfmt="%3d";sub set_width {$width=shift;$width=2 if$width < 2;$vfmt="%${width}d";$bar=$corner=' ' x $width;substr($bar,-2,1)='|';substr($corner,-2,2)='+-'}sub hdump;sub hdump {my$el=shift;my$l1=shift;my$b=shift;my$ch;my$ch1;unless($el){print$l1,"\n";return}hdump$ch1=$el->{child},$l1 .sprintf($vfmt,$el->{val}->val),$b .$bar;if($ch1){for($ch=$ch1->{right};$ch!=$ch1;$ch=$ch->{right}){hdump$ch,$b .$corner,$b .$bar}}}sub heapdump {my$h;while($h=shift){my$top=$$h or last;my$el=$top;do {hdump$el,sprintf("%02d: ",$el->{degree}),' ';$el=$el->{right}}until$el==$top;print "\n"}}sub bhcheck;sub bhcheck {my$el=shift;my$p=shift;my$cur=$el;my$prev;my$ch;do {$prev=$cur;$cur=$cur->{right};die "bad back link" unless$cur->{left}==$prev;die "bad parent link" unless (defined$p && defined$cur->{p}&& $cur->{p}==$p)|| (!defined$p &&!defined$cur->{p});die "bad degree( $cur->{degree} > $p->{degree} )" if$p && $p->{degree}<= $cur->{degree};die "not heap ordered" if$p && $p->{val}->cmp($cur->{val})> 0;$ch=$cur->{child}and bhcheck$ch,$cur}until$cur==$el}sub heapcheck {my$h;my$el;while($h=shift){heapdump$h if$validate >= 2;$el=$$h and bhcheck$el,undef}}sub ascending_cut;sub elem;sub elem_DESTROY;sub link_to_left_of;sub new {my$self=shift;my$class=ref($self)|| $self;my$h=undef;bless \$h,$class}sub DESTROY {my$h=shift;elem_DESTROY $$h}sub add {my$h=shift;my$v=shift;$validate && do {die "Method 'heap' required for element on heap" unless$v->can('heap');die "Method 'cmp' required for element on heap" unless$v->can('cmp')};my$el=elem$v;my$top;if(!($top=$$h)){$$h=$el}else {link_to_left_of$top->{left},$el ;link_to_left_of$el,$top;$$h=$el if$v->cmp($top->{val})< 0}}sub top {my$h=shift;$$h && $$h->{val}}*minimum=\⊤sub extract_top {my$h=shift;my$el=$$h or return undef;my$ltop=$el->{left};my$cur;my$next;if($cur=$el->{child}){my$first=$cur;do {$cur->{p}=undef}until ($cur=$cur->{right})==$first;$cur=$cur->{left};link_to_left_of$ltop,$first;link_to_left_of$cur,$el}if($el->{right}==$el){$$h=undef}else {link_to_left_of$el->{left},$$h=$el->{right};$h->consolidate}my$top=$el->{val};$top->heap(undef);$el->{left}=$el->{right}=$el->{p}=$el->{child}=$el->{val}=undef;$top}*extract_minimum=\&extract_top;sub absorb {my$h=shift;my$h2=shift;my$el=$$h;unless($el){$$h=$$h2;$$h2=undef;return$h}my$el2=$$h2 or return$h;my$el2l=$el2->{left};link_to_left_of$el->{left},$el2;link_to_left_of$el2l,$el;$$h=$el2 if$el->{val}->cmp($el2->{val})> 0;$$h2=undef;$h}sub decrease_key {my$h=shift;my$top=$$h;my$v=shift;my$el=$v->heap or return undef;my$p;$$h=$el if$top->{val}->cmp($v)> 0;if($p=$el->{p}and $v->cmp($p->{val})< 0){ascending_cut$top,$p,$el}$v}sub delete {my$h=shift;my$v=shift;my$el=$v->heap or return undef;my$p;$p=$el->{p}and ascending_cut $$h,$p,$el;$$h=$el;$h->extract_top}sub elem {my$v=shift;my$el=undef;$el={p=>undef,degree=>0,mark=>0,child=>undef,val=>$v,left=>undef,right=>undef,};$el->{left}=$el->{right}=$el;$v->heap($el);$el}sub elem_DESTROY {my$el=shift;my$ch;my$next;$el->{left}->{right}=undef;while($el){$ch=$el->{child}and elem_DESTROY$ch;$next=$el->{right};defined$el->{val}and $el->{val}->heap(undef);$el->{child}=$el->{right}=$el->{left}=$el->{p}=$el->{val}=undef;$el=$next}}sub link_to_left_of {my$l=shift;my$r=shift;$l->{right}=$r;$r->{left}=$l}sub link_as_parent_of {my$p=shift;my$c=shift;my$pc;if($pc=$p->{child}){link_to_left_of$pc->{left},$c;link_to_left_of$c,$pc}else {link_to_left_of$c,$c}$p->{child}=$c;$c->{p}=$p;$p->{degree}++;$c->{mark}=0;$p}sub consolidate {my$h=shift;my$cur;my$this;my$next=$$h;my$last=$next->{left};my@a;do {$this=$cur=$next;$next=$cur->{right};my$d=$cur->{degree};my$alt;while($alt=$a[$d]){($cur,$alt)=($alt,$cur)if$cur->{val}->cmp($alt->{val})> 0;link_to_left_of$alt->{left},$alt->{right};link_as_parent_of$cur,$alt;$$h=$cur;$a[$d]=undef;++$d}$a[$d]=$cur}until$this==$last;$cur=$$h;for$cur (grep defined,@a){$$h=$cur if $$h->{val}->cmp($cur->{val})> 0}}sub ascending_cut {my$top=shift;my$p=shift;my$el=shift;while(1){if(--$p->{degree}){my$l=$el->{left};$p->{child}=$l;link_to_left_of$l,$el->{right}}else {$p->{child}=undef}link_to_left_of$top->{left},$el;link_to_left_of$el,$top;$el->{p}=undef;$el->{mark}=0;$el=$p;last unless$p=$el->{p};$el->{mark}=1,last unless$el->{mark}}}1; +HEAP071_FIBONACCI $fatpacked{"Log/ger.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER'; package Log::ger;our$DATE='2017-08-03';our$VERSION='0.023';our$re_addr=qr/\(0x([0-9a-f]+)/o;our%Levels=(fatal=>10,error=>20,warn=>30,info=>40,debug=>50,trace=>60,);our%Level_Aliases=(off=>0,warning=>30,);our$Current_Level=30;our$Caller_Depth_Offset=0;our$_logger_is_null;our$_dumper;our%Global_Hooks;our%Package_Targets;our%Per_Package_Hooks;our%Hash_Targets;our%Per_Hash_Hooks;our%Object_Targets;our%Per_Object_Hooks;my$sub0=sub {0};my$sub1=sub {1};my$default_null_routines;sub install_routines {my ($target,$target_arg,$routines)=@_;if ($target eq 'package'){for my$r (@$routines){my ($code,$name,$lnum,$type)=@$r;next unless$type =~ /_sub\z/;*{"$target_arg\::$name"}=$code}}elsif ($target eq 'object'){my$pkg=ref$target_arg;for my$r (@$routines){my ($code,$name,$lnum,$type)=@$r;next unless$type =~ /_method\z/;*{"$pkg\::$name"}=$code}}elsif ($target eq 'hash'){for my$r (@$routines){my ($code,$name,$lnum,$type)=@$r;next unless$type =~ /_sub\z/;$target_arg->{$name}=$code}}}sub add_target {my ($target,$target_arg,$args,$replace)=@_;$replace=1 unless defined$replace;if ($target eq 'package'){unless ($replace){return if$Package_Targets{$target_arg}}$Package_Targets{$target_arg}=$args}elsif ($target eq 'object'){my ($addr)="$target_arg" =~ $re_addr;unless ($replace){return if$Object_Targets{$addr}}$Object_Targets{$addr}=[$target_arg,$args]}elsif ($target eq 'hash'){my ($addr)="$target_arg" =~ $re_addr;unless ($replace){return if$Hash_Targets{$addr}}$Hash_Targets{$addr}=[$target_arg,$args]}}sub _set_default_null_routines {$default_null_routines ||= [(map {([$sub0,"log_$_",$Levels{$_},'log_sub'],[$Levels{$_}> $Current_Level ? $sub0 : $sub1,"log_is_$_",$Levels{$_},'is_sub'],[$sub0,$_,$Levels{$_},'log_method'],[$Levels{$_}> $Current_Level ? $sub0 : $sub1,"is_$_",$Levels{$_},'is_method'],)}keys%Levels),]}sub get_logger {my ($package,%args)=@_;my$caller=caller(0);$args{category}=$caller if!defined($args{category});my$obj=[];$obj =~ $re_addr;my$pkg="Log::ger::Obj$1";bless$obj,$pkg;add_target(object=>$obj,\%args);if (keys%Global_Hooks){require Log::ger::Heavy;init_target(object=>$obj,\%args)}else {_set_default_null_routines();install_routines(object=>$obj,$default_null_routines)}$obj}sub import {my ($package,%args)=@_;my$caller=caller(0);$args{category}=$caller if!defined($args{category});add_target(package=>$caller,\%args);if (keys%Global_Hooks){require Log::ger::Heavy;init_target(package=>$caller,\%args)}else {_set_default_null_routines();install_routines(package=>$caller,$default_null_routines)}}1; @@ -2726,7 +2949,7 @@ $fatpacked{"Types/TypeTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<' TYPES_TYPETINY $fatpacked{"common/sense.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'X86_64-LINUX-THREAD-MULTI_COMMON_SENSE'; - package common::sense;our$VERSION=3.74;sub import {local $^W;${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\x0c\x3f\x33\x00\x0f\xf0\x0f\xc0\xf0\xfc\x33\x00\x00\x00\x0c\x00\x00\x00";$^H |= 0x1c820fc0;@^H{qw(feature___SUB__ feature_unicode feature_evalbytes feature_fc feature_switch feature_say feature_state)}=(1)x 7}1 + package common::sense;our$VERSION=3.74;sub import {local $^W;${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\x0c\x3f\x33\x00\x0f\xf0\x0f\xc0\xf0\xfc\x33\x00\x00\x00\x0c\x00\x00\x00\x00";$^H |= 0x1c820fc0;@^H{qw(feature_state feature_fc feature_evalbytes feature_unicode feature_switch feature_say feature___SUB__)}=(1)x 7}1 X86_64-LINUX-THREAD-MULTI_COMMON_SENSE s/^ //mg for values %fatpacked; @@ -2785,14 +3008,12 @@ unshift @INC, bless \%fatpacked, $class; use warnings; use strict; -use version; our $VERSION = version->declare("v0.1.0"); +use version; our $VERSION = version->declare("v0.2.1"); -BEGIN { unshift @INC, './lib'; } - -use Igor::CLI; +use App::Igor::CLI; # Simply dispatch, wuhu -Igor::CLI::main(@ARGV); +App::Igor::CLI::main(@ARGV); __END__ @@ -3060,7 +3281,7 @@ Please see the L<section TOML|/TOML> for a full description of the individual fields. The TOML-style package description is the preferred way of package description. -However, in some cases, a more programmatic way of specifiying package-contents +However, in some cases, a more programmatic way of specifying package-contents might be desired: For instance by omitting certain files or by automatically generating a large number of file operations to cope with hundreds of individual files inside a package. @@ -3133,7 +3354,7 @@ The above snippet configures igor to search for packages in two repositories loc at F<./repo1> and F<./repo2> I<relative to the configuration file> and installs three packages from those repositories. Repositories are named (C<repository1> and C<repository2>). -The list of packages to be installed in specified in the C<packages> list. By +The list of packages to be installed is specified in the C<packages> list. By default, igor tries to resolve packagenames in all configured repositories. However, in case the package name is ambiguous, an error will be reported and the execution is terminated. In that case, the packagename can be explicitly @@ -3162,6 +3383,55 @@ In addition to explicitly specified facts, some facts (e.g. C<hostname> above) can be automatically gathered for all hosts using L<factors|/Custom factors>. Inside templates, those automatic facts are stored in the hash C<%automatic>. +=item Vaults + +Sometimes, credentials are required within configuration files. While +it may be unproblematic to have these stored in plaintext on certain +boxes (e.g. my feedreader password on my private laptop), it is often +not desireable to have them stored in the clear on all other +(potentially less trusted) computers igor is run on. While this +problem can be mitigated by using multiple +L<repositories|/Repositories and Packages>, it is overkill for only +this paticular item. Vaults offer a way to store facts in an +encrypted fashion and decrypt them automatically when required. + + [[configurations.computer.vaults]] + path = './vaults/newsboat.gpg' + type = 'shell' + cacheable = 1 + command = 'gpg --batch --yes -o "${IGOR_OUTFILE}" -d "${IGOR_VAULT}"' + +Each configuration can store a list of vaults that will automatically +be unlocked when the configuration is activated on the host. + +A vault consists of a filepath to the vault and a type. Currently, +only the C<shell> type is implemented. It allows to run a provided +C<command> to decrypt the vault. The commandline used may refer to two +environment variables for the filepath to the vault file +(C<$IGOR_VAULT>) and the output file (C<$IGOR_OUTFILE>). + +The vault itself should decrypt to a TOML-File containing the +secrets. After decryption, the vault will be merged into the context +and available to Perl-style packages and Templates as +C<%secrets>. + +However, it is laborous to repeatedly enter the vault password for every +igor run being performed. So igor can cache unlocked faults for you. +the unlocked vaults are stored in C<defaults.cachedirectory> (defaulting +to F<./.cache>): + + [defaults] + cachedirectory = './.cache' + +B<IMPORTANT:> The cache is currently B<not> cleared by igor +itself. Old unlocked vaultfile-states will be cached indefinitly. +It is the responsiblity of the user to clean the cache (by deleting +the files within the cache directory). + +Caching has to be manually activated for the individual vaults by +setting C<cacheable> to C<1>. Setting it to C<0> (default) will +disable caching. + =item Collections Often, certain files store configuration that relates to different system @@ -3213,8 +3483,8 @@ C<mergeconfigs>, see below. =head3 Cascade However, igor does not confine itself to merely defining individual -configurations. Instead, at the core of igor is a cascading configuration -system: The basic idea is that each system's configuration actually consits of +configurations. Instead, at the core of igor is a cascading configuration +system: The basic idea is that each system's configuration actually consists of several aspects. For instance, all configurations share a common set of default values and basic @@ -3269,7 +3539,7 @@ inside the configuration block in F<config.toml>. Igor merges the set of (transitively) active configurations from top to bottom: - defaults -> cfg2 -> cfg3 -> cfg5 -> cfg5 + defaults -> cfg2 -> cfg3 -> cfg5 -> cfg6 Therefore, the above results in the following effective configuration: @@ -3324,7 +3594,7 @@ Of course, you can call utility functions from igors codebase where useful: sub { # Cheating, actually we simply call the default hash merging strategy... :) - Igor::Merge::uniq_list_merge(@_) + App::Igor::Merge::uniq_list_merge(@_) } =item 2. @@ -3465,7 +3735,8 @@ unavailable. The C<configuration.pattern> options and configuration names are matched against this guessed identifier. If the selection is unique, this configuration will be automatically used and applied. If multiple patterns -match, an error will be signaled instead. +match, an error will be signaled instead. Patterns are matched as perl-style +regexes. =head2 EXAMPLE @@ -3539,36 +3810,31 @@ page or build it yourself: # Install all dependencies locally to ./local using carton # See DEVELOPMENT SETUP below for details carton install - ./bin/fatpack.sh + ./maint/fatpack.sh -The fatpacked script can be found in F<./bin/igor.fatpacked.pl> and be executed +The fatpacked script can be found in F<./igor.fatpacked.pl> and be executed standalone. =head2 HACKING -=head3 DESGIN/CODE STRUCTURE +=head3 DESIGN/CODE STRUCTURE -C<Igor::CLI::main> in F<lib/Igor/CLI.pl> constitutes igor's entrypoint and +C<App::Igor::CLI::main> in F<lib/Igor/CLI.pl> constitutes igor's entrypoint and outlines the overall execution flow. The main steps are: =over 4 -=item 1. -Command line parsing and setup +=item 1. Command line parsing and setup -=item 2. -Parsing the config +=item 2. Parsing the config -=item 3. -Using the layering system to determine the config to apply +=item 3. Using the layering system to determine the config to apply -=item 4. -Building the package database and configuring the individual packages +=item 4. Building the package database and configuring the individual packages -=item 5. -Applying the relevant subcommand (eiter applying a configuration, diff, gc...) +=item 5. Applying the relevant subcommand (eiter applying a configuration, diff, gc...) =back @@ -3600,7 +3866,7 @@ construction in a lightweight fashion. =item C<Log::ger> Used internally for logging. Provides C<log_(trace|debug|info|warn|error)> -functions to log on different verbosity levels. C<Igor::Util::colored> can be +functions to log on different verbosity levels. C<App::Igor::Util::colored> can be used to modify the text printed to the terminal (e.g. C<log_info colored(['bold blue'] "Text")> will print C<Text> to stdout in bold blue). @@ -3629,7 +3895,7 @@ the required nonstandard libraries: Carton can then be used to execute C<igor> with those locally installed libs: - carton exec -- ./igor.pl --help + carton exec -- ./scripts/igor.pl --help =head4 Running tests @@ -3642,28 +3908,51 @@ an integration test case. B<WARNING:> Running the following command on your development machine might overwrite configuration files on the host. Only execute them in a virtual machine or container. - igor.pl apply -vv --dry-run -c ./test/test_minimal/config.toml --task computer + ./scripts/igor.pl apply -vv --dry-run -c ./test/test_minimal/config.toml --task computer To ease development, two scripts are provided to create and manage docker containers for igor development. -F<bin/builddocker.pl> will generate a set of dockerfiles in the folder +F<maint/builddocker.pl> will generate a set of dockerfiles in the folder F<./docker> for minimal configurations of various operating systems configured -in F<bin/builddocker.pl> and builds the corresponding images. -F<bin/devup.sh> will start the archlinux-image and mount the igor-folder into +in F<maint/builddocker.pl> and builds the corresponding images. +F<maint/devup.sh> will start the archlinux-image and mount the igor-folder into the container in read-only mode. There, new changes of igor can be tested. Instead of using carton, you can use the fatpacked script inside the container, which emulates the behaviour on typical hosts. (Yet, igor will prefer local modules from the F<lib/Igor> folder to those fatpacked: that way, changes -can be tested without rerunning F<bin/fatpack.sh>). +can be tested without rerunning F<maint/fatpack.sh>). # On host # Build/Prepare - ./bin/builddocker.pl # just once - ./bin/fatpack.sh # just once + ./maint/builddocker.pl # just once + ./maint/fatpack.sh # just once # Start the container - ./bin/devup.sh + ./maint/devup.sh # In the container ./igor.packed.pl --help +=head1 AUTHOR + +Simon Schuster C<perl -e 'print "git . remove stuff like this . rationality.eu" =~ s/ . remove stuff like this . /@/rg'> + +=head1 COPYRIGHT + +Copyright 2019- Simon Schuster + +=head1 LICENSE + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU Affero General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Affero General Public License for more details. + +You should have received a copy of the GNU Affero General Public License +along with this program. If not, see <http://www.gnu.org/licenses/>. + =cut |