diff options
author | yushyin <yushyin@saga> | 2019-06-11 00:55:39 +0200 |
---|---|---|
committer | yushyin <yushyin@saga> | 2019-06-11 00:55:39 +0200 |
commit | 614eb79f5271b3c2a5f1c62e57dd8a5be161d76c (patch) | |
tree | 56a65b5de1bf6a1e3886d46d162250b4973e2588 | |
download | dotfiles-igor-614eb79f5271b3c2a5f1c62e57dd8a5be161d76c.tar.gz dotfiles-igor-614eb79f5271b3c2a5f1c62e57dd8a5be161d76c.tar.xz |
first commit
-rw-r--r-- | config.toml | 12 | ||||
-rw-r--r-- | git/config | 77 | ||||
-rw-r--r-- | git/package.toml | 3 | ||||
-rwxr-xr-x | herbstluftwm/files/autostart | 169 | ||||
-rwxr-xr-x | herbstluftwm/files/panel.sh | 187 | ||||
-rw-r--r-- | herbstluftwm/package.toml | 3 | ||||
-rwxr-xr-x | igor.packed.pl | 3669 | ||||
-rw-r--r-- | vim/files/after/ftplugin/c.vim | 5 | ||||
-rw-r--r-- | vim/files/dein.toml | 117 | ||||
-rw-r--r-- | vim/files/ftplugin/c.vim | 16 | ||||
-rw-r--r-- | vim/files/ftplugin/haskell.vim | 2 | ||||
-rw-r--r-- | vim/files/ftplugin/tex.vim | 5 | ||||
-rw-r--r-- | vim/files/plugrc/vimfiler.rc.vim | 6 | ||||
-rw-r--r-- | vim/files/vimrc | 177 | ||||
-rw-r--r-- | vim/package.toml | 3 | ||||
-rw-r--r-- | zsh/.zprofile | 11 | ||||
-rw-r--r-- | zsh/.zshrc | 57 |
17 files changed, 4519 insertions, 0 deletions
diff --git a/config.toml b/config.toml new file mode 100644 index 0000000..75be80d --- /dev/null +++ b/config.toml @@ -0,0 +1,12 @@ +[defaults] +repositories = { main = { path = './' } } + +[configurations.interactive] +packages = ['git', 'vim'] + +[configurations.desktop] +dependencies = ['interactive'] +packages = ['herbstluftwm'] + +[configurations.saga] +dependencies = ['desktop'] diff --git a/git/config b/git/config new file mode 100644 index 0000000..cc473ed --- /dev/null +++ b/git/config @@ -0,0 +1,77 @@ +[pretty] + log = %C(yellow)%h%C(reset) %C(normal)%s%C(reset) %C(dim white)%an%C(reset) %C(dim blue)(%ar)%C(reset) %C(auto)%d%C(reset) + oldlog = %C(blue)%h%C(reset) - %C(white)(%ar)%C(reset) %s %C(red)%d%C(reset) %C(bold blue)— %an%C(reset) + +[alias] + lg = log --graph --abbrev-commit --color --pretty=log + + l = lg -n 15 + ll = lg --all + lf = lg --name-status + lp = lg --first-parent + + s = status -s + ss = status + a = add + ai = add -i + p = push + pu = pull + f = fetch + fa = fetch --all + c = commit + dt = difftool + dtg = difftool -g + b = branch + bv = branch -v + bva = branch -va + co = checkout + cb = checkout -b + d = diff --stat + dd = diff + m = merge --no-ff + r = remote + rv = remote -v + rb = rebase + rbi = rebase -i + fap = fetch --all -p -t + stash-all = stash save --include-untracked + + # List every branch, local and remote, in order of most recent to oldest commit, showing the branch's last commit and some last commit meta-data + br = for-each-ref --sort=-committerdate refs/heads/ refs/remotes/origin/ --format='%(HEAD) %(color:yellow)%(refname:short)%(color:reset) - %(color:red)%(objectname:short)%(color:reset) - %(contents:subject) - %(authorname) (%(color:green)%(committerdate:relative)%(color:reset))' - + + # ff [<args>] + # if no <args> are given, tries to fast-forward with the upstream branch + ff = !"perl -MGit -E' \ + push @ARGV, Git::command_oneline(qw/rev-parse --abbrev-ref --symbolic-full-name @{u}/) unless @ARGV; \ + Git::command_noisy(qw{merge --ff-only}, @ARGV); \ + '" + # ff = merge --ff-only + + # tomerge [<branch> [<regex>]] tells you which branches matching <regex> have not been merged into <branch> yet + # <branch> defaults to HEAD + # <regex> defaults to . + tomerge = !"perl -MGit -E' \ + my ($br, $rx) = (shift // q{HEAD}, shift // qr{.}); \ + say for grep { \ + /$rx/ && !/\\b(master|maint|next)/; \ + } Git::command(qw{branch -r --no-merged}, $br); \ + '" + + # topics [<regex>] + # show topics (branches) matching the ai/description format or <regex> + topics = !"perl -MGit -MList::Util=uniq -E' \ + my $rx = shift // qr{[a-z]{1,3}/.}; \ + say for uniq map { \ + $_ = (split /\\s/)[2]; \ + s!(remotes|origin)/!!g; \ + /$rx/ && !/HEAD/ ? $_ : () \ + } Git::command(qw/branch --sort=committerdate -r/) \ + '" + + # rmbranch [<repository>] <branchname> deletes local and remote branch + # <repository> defaults to origin + rmbranch = !"perl -MGit -E' \ + my ($re, $br) = (@ARGV > 1? shift : q{origin}, shift // q{}); \ + Git::command_noisy(qw{branch -d}, $br); \ + Git::command_noisy(qw{push -d}, $re, $br); \ + '" diff --git a/git/package.toml b/git/package.toml new file mode 100644 index 0000000..946ea2f --- /dev/null +++ b/git/package.toml @@ -0,0 +1,3 @@ +[[files]] +source = './config' +dest = '~/.config/git/config' diff --git a/herbstluftwm/files/autostart b/herbstluftwm/files/autostart new file mode 100755 index 0000000..31269d8 --- /dev/null +++ b/herbstluftwm/files/autostart @@ -0,0 +1,169 @@ +#!/usr/bin/env bash + +# this is a simple config for herbstluftwm + +hc() { + herbstclient "$@" +} + +hc emit_hook reload + +xsetroot -solid '#5A8E3A' + +# remove all existing keybindings +hc keyunbind --all + +# keybindings +# if you have a super key you will be much happier with Mod set to Mod4 +#Mod=Mod1 # Use alt as the main modifier +Mod=Mod4 # Use the super key as the main modifier + +hc keybind $Mod-Shift-q quit +hc keybind $Mod-Shift-r reload +hc keybind $Mod-Shift-c close +hc keybind $Mod-Return spawn ${TERMINAL:-termite} # use your $TERMINAL with xterm as fallback +hc keybind $Mod-x spawn rofi -show run + +# basic movement +# focusing clients +hc keybind $Mod-Left focus left +hc keybind $Mod-Down focus down +hc keybind $Mod-Up focus up +hc keybind $Mod-Right focus right +hc keybind $Mod-h focus left +hc keybind $Mod-j focus down +hc keybind $Mod-k focus up +hc keybind $Mod-l focus right + +# moving clients +hc keybind $Mod-Shift-Left shift left +hc keybind $Mod-Shift-Down shift down +hc keybind $Mod-Shift-Up shift up +hc keybind $Mod-Shift-Right shift right +hc keybind $Mod-Shift-h shift left +hc keybind $Mod-Shift-j shift down +hc keybind $Mod-Shift-k shift up +hc keybind $Mod-Shift-l shift right + +# splitting frames +# create an empty frame at the specified direction +hc keybind $Mod-u split bottom 0.5 +hc keybind $Mod-o split right 0.5 +# let the current frame explode into subframes +hc keybind $Mod-Control-space split explode + +# resizing frames +resizestep=0.05 +hc keybind $Mod-Control-h resize left +$resizestep +hc keybind $Mod-Control-j resize down +$resizestep +hc keybind $Mod-Control-k resize up +$resizestep +hc keybind $Mod-Control-l resize right +$resizestep +hc keybind $Mod-Control-Left resize left +$resizestep +hc keybind $Mod-Control-Down resize down +$resizestep +hc keybind $Mod-Control-Up resize up +$resizestep +hc keybind $Mod-Control-Right resize right +$resizestep + +# tags +tag_names=( {1..9} ) +tag_keys=( {1..9} 0 ) + +hc rename default "${tag_names[0]}" || true +for i in ${!tag_names[@]} ; do + hc add "${tag_names[$i]}" + key="${tag_keys[$i]}" + if ! [ -z "$key" ] ; then + hc keybind "$Mod-$key" use_index "$i" + hc keybind "$Mod-Shift-$key" move_index "$i" + fi +done + +# cycle through tags +hc keybind $Mod-period use_index +1 --skip-visible +hc keybind $Mod-comma use_index -1 --skip-visible + +# layouting +hc keybind $Mod-r remove +hc keybind $Mod-s floating toggle +hc keybind $Mod-f fullscreen toggle +hc keybind $Mod-p pseudotile toggle +# The following cycles through the available layouts within a frame, but skips +# layouts, if the layout change wouldn't affect the actual window positions. +# I.e. if there are two windows within a frame, the grid layout is skipped. +hc keybind $Mod-space \ + or , and . compare tags.focus.curframe_wcount = 2 \ + . cycle_layout +1 vertical horizontal max vertical grid \ + , cycle_layout +1 + +# mouse +hc mouseunbind --all +hc mousebind $Mod-Button1 move +hc mousebind $Mod-Button2 zoom +hc mousebind $Mod-Button3 resize + +# focus +hc keybind $Mod-BackSpace cycle_monitor +hc keybind $Mod-Tab cycle_all +1 +hc keybind $Mod-Shift-Tab cycle_all -1 +hc keybind $Mod-c cycle +hc keybind $Mod-i jumpto urgent + +# theme +hc attr theme.tiling.reset 1 +hc attr theme.floating.reset 1 +hc set frame_border_active_color '#222222' +hc set frame_border_normal_color '#101010' +hc set frame_bg_normal_color '#565656' +hc set frame_bg_active_color '#345F0C' +hc set frame_border_width 1 +hc set always_show_frame 1 +hc set frame_bg_transparent 1 +hc set frame_transparent_width 5 +hc set frame_gap 4 + +hc attr theme.active.color '#9fbc00' +hc attr theme.normal.color '#454545' +hc attr theme.urgent.color orange +hc attr theme.inner_width 1 +hc attr theme.inner_color black +hc attr theme.border_width 3 +hc attr theme.floating.border_width 4 +hc attr theme.floating.outer_width 1 +hc attr theme.floating.outer_color black +hc attr theme.active.inner_color '#3E4A00' +hc attr theme.active.outer_color '#3E4A00' +hc attr theme.background_color '#141414' + +hc set window_gap 0 +hc set frame_padding 0 +hc set smart_window_surroundings 0 +hc set smart_frame_surroundings 1 +hc set mouse_recenter_gap 0 + +# rules +hc unrule -F +#hc rule class=XTerm tag=3 # move all xterms to tag 3 +hc rule focus=on # normally focus new clients +#hc rule focus=off # normally do not focus new clients +# give focus to most common terminals +#hc rule class~'(.*[Rr]xvt.*|.*[Tt]erm|Konsole)' focus=on +hc rule windowtype~'_NET_WM_WINDOW_TYPE_(DIALOG|UTILITY|SPLASH)' pseudotile=on +hc rule windowtype='_NET_WM_WINDOW_TYPE_DIALOG' focus=on +hc rule windowtype~'_NET_WM_WINDOW_TYPE_(NOTIFICATION|DOCK|DESKTOP)' manage=off + +hc set tree_style '╾│ ├└╼─┐' + +# unlock, just to be sure +hc unlock + +# do multi monitor setup here, e.g.: +# hc set_monitors 1280x1024+0+0 1280x1024+1280+0 +# or simply: +# hc detect_monitors + +# find the panel +panel=~/.config/herbstluftwm/panel.sh +[ -x "$panel" ] || panel=/etc/xdg/herbstluftwm/panel.sh +for monitor in $(herbstclient list_monitors | cut -d: -f1) ; do + # start it on each monitor + "$panel" $monitor & +done diff --git a/herbstluftwm/files/panel.sh b/herbstluftwm/files/panel.sh new file mode 100755 index 0000000..37d6ddf --- /dev/null +++ b/herbstluftwm/files/panel.sh @@ -0,0 +1,187 @@ +#!/usr/bin/env bash + +quote() { + local q="$(printf '%q ' "$@")" + printf '%s' "${q% }" +} + +hc_quoted="$(quote "${herbstclient_command[@]:-herbstclient}")" +hc() { "${herbstclient_command[@]:-herbstclient}" "$@" ;} +monitor=${1:-0} +geometry=( $(hc monitor_rect "$monitor") ) +if [ -z "$geometry" ] ;then + echo "Invalid monitor $monitor" + exit 1 +fi +# geometry has the format W H X Y +x=${geometry[0]} +y=${geometry[1]} +panel_width=${geometry[2]} +panel_height=16 +font="-*-fixed-medium-*-*-*-13-*-*-*-*-*-*-*" +bgcolor=$(hc get frame_border_normal_color) +selbg=$(hc get window_border_active_color) +selfg='#101010' + +#### +# Try to find textwidth binary. +# In e.g. Ubuntu, this is named dzen2-textwidth. +if which textwidth &> /dev/null ; then + textwidth="textwidth"; +elif which dzen2-textwidth &> /dev/null ; then + textwidth="dzen2-textwidth"; +else + echo "This script requires the textwidth tool of the dzen2 project." + exit 1 +fi +#### +# true if we are using the svn version of dzen2 +# depending on version/distribution, this seems to have version strings like +# "dzen-" or "dzen-x.x.x-svn" +if dzen2 -v 2>&1 | head -n 1 | grep -q '^dzen-\([^,]*-svn\|\),'; then + dzen2_svn="true" +else + dzen2_svn="" +fi + +if awk -Wv 2>/dev/null | head -1 | grep -q '^mawk'; then + # mawk needs "-W interactive" to line-buffer stdout correctly + # http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=593504 + uniq_linebuffered() { + awk -W interactive '$0 != l { print ; l=$0 ; fflush(); }' "$@" + } +else + # other awk versions (e.g. gawk) issue a warning with "-W interactive", so + # we don't want to use it there. + uniq_linebuffered() { + awk '$0 != l { print ; l=$0 ; fflush(); }' "$@" + } +fi + +hc pad $monitor $panel_height + +{ + ### Event generator ### + # based on different input data (mpc, date, hlwm hooks, ...) this generates events, formed like this: + # <eventname>\t<data> [...] + # e.g. + # date ^fg(#efefef)18:33^fg(#909090), 2013-10-^fg(#efefef)29 + + #mpc idleloop player & + while true ; do + # "date" output is checked once a second, but an event is only + # generated if the output changed compared to the previous run. + date +$'date\t^fg(#efefef)%H:%M^fg(#909090), %Y-%m-^fg(#efefef)%d' + sleep 1 || break + done > >(uniq_linebuffered) & + childpid=$! + hc --idle + kill $childpid +} 2> /dev/null | { + IFS=$'\t' read -ra tags <<< "$(hc tag_status $monitor)" + visible=true + date="" + windowtitle="" + while true ; do + + ### Output ### + # This part prints dzen data based on the _previous_ data handling run, + # and then waits for the next event to happen. + + separator="^bg()^fg($selbg)|" + # draw tags + for i in "${tags[@]}" ; do + case ${i:0:1} in + '#') + echo -n "^bg($selbg)^fg($selfg)" + ;; + '+') + echo -n "^bg(#9CA668)^fg(#141414)" + ;; + ':') + echo -n "^bg()^fg(#ffffff)" + ;; + '!') + echo -n "^bg(#FF0675)^fg(#141414)" + ;; + *) + echo -n "^bg()^fg(#ababab)" + ;; + esac + if [ ! -z "$dzen2_svn" ] ; then + # clickable tags if using SVN dzen + echo -n "^ca(1,$hc_quoted focus_monitor \"$monitor\" && " + echo -n "$hc_quoted use \"${i:1}\") ${i:1} ^ca()" + else + # non-clickable tags if using older dzen + echo -n " ${i:1} " + fi + done + echo -n "$separator" + echo -n "^bg()^fg() ${windowtitle//^/^^}" + # small adjustments + right="$separator^bg() $date $separator" + right_text_only=$(echo -n "$right" | sed 's.\^[^(]*([^)]*)..g') + # get width of right aligned text.. and add some space.. + width=$($textwidth "$font" "$right_text_only ") + echo -n "^pa($(($panel_width - $width)))$right" + echo + + ### Data handling ### + # This part handles the events generated in the event loop, and sets + # internal variables based on them. The event and its arguments are + # read into the array cmd, then action is taken depending on the event + # name. + # "Special" events (quit_panel/togglehidepanel/reload) are also handled + # here. + + # wait for next event + IFS=$'\t' read -ra cmd || break + # find out event origin + case "${cmd[0]}" in + tag*) + #echo "resetting tags" >&2 + IFS=$'\t' read -ra tags <<< "$(hc tag_status $monitor)" + ;; + date) + #echo "resetting date" >&2 + date="${cmd[@]:1}" + ;; + quit_panel) + exit + ;; + togglehidepanel) + currentmonidx=$(hc list_monitors | sed -n '/\[FOCUS\]$/s/:.*//p') + if [ "${cmd[1]}" -ne "$monitor" ] ; then + continue + fi + if [ "${cmd[1]}" = "current" ] && [ "$currentmonidx" -ne "$monitor" ] ; then + continue + fi + echo "^togglehide()" + if $visible ; then + visible=false + hc pad $monitor 0 + else + visible=true + hc pad $monitor $panel_height + fi + ;; + reload) + exit + ;; + focus_changed|window_title_changed) + windowtitle="${cmd[@]:2}" + ;; + #player) + # ;; + esac + done + + ### dzen2 ### + # After the data is gathered and processed, the output of the previous block + # gets piped to dzen2. + +} 2> /dev/null | dzen2 -w $panel_width -x $x -y $y -fn "$font" -h $panel_height \ + -e "button3=;button4=exec:$hc_quoted use_index -1;button5=exec:$hc_quoted use_index +1" \ + -ta l -bg "$bgcolor" -fg '#efefef' diff --git a/herbstluftwm/package.toml b/herbstluftwm/package.toml new file mode 100644 index 0000000..7edc4ba --- /dev/null +++ b/herbstluftwm/package.toml @@ -0,0 +1,3 @@ +[[files]] +source = './files' +dest = '~/.config/herbstluftwm' diff --git a/igor.packed.pl b/igor.packed.pl new file mode 100755 index 0000000..98f0051 --- /dev/null +++ b/igor.packed.pl @@ -0,0 +1,3669 @@ +#!/usr/bin/env perl + +# This chunk of stuff was generated by App::FatPacker. To find the original +# file's code, look for the end of this BEGIN block or the string 'FATPACK' +BEGIN { +my %fatpacked; + +$fatpacked{"Algorithm/Diff.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DIFF'; + package Algorithm::Diff;use strict;use integer;use vars qw($VERSION @EXPORT_OK);$VERSION=1.19_03;require Exporter;*import=\&Exporter::import;@EXPORT_OK=qw(prepare LCS LCSidx LCS_length diff sdiff compact_diff traverse_sequences traverse_balanced);sub _withPositionsOfInInterval {my$aCollection=shift;my$start=shift;my$end=shift;my$keyGen=shift;my%d;my$index;for ($index=$start ;$index <= $end ;$index++ ){my$element=$aCollection->[$index];my$key=&$keyGen($element,@_);if (exists($d{$key})){unshift (@{$d{$key}},$index)}else {$d{$key}=[$index]}}return wantarray ? %d : \%d}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$counting=shift;my$keyGen=shift;my$compare;if (ref($a)eq 'HASH'){my$tmp=$b;$b=$a;$a=$tmp}if (!ref($a)||!ref($b)){my@callerInfo=caller(1);die 'error: must pass array or hash references to ' .$callerInfo[3]}if (!defined($keyGen)){$keyGen=sub {$_[0]};$compare=sub {my ($a,$b)=@_;$a eq $b}}else {$compare=sub {my$a=shift;my$b=shift;&$keyGen($a,@_)eq &$keyGen($b,@_)}}my ($aStart,$aFinish,$matchVector)=(0,$#$a,[]);my ($prunedCount,$bMatches)=(0,{});if (ref($b)eq 'HASH'){$bMatches=$b}else {my ($bStart,$bFinish)=(0,$#$b);while ($aStart <= $aFinish and $bStart <= $bFinish and &$compare($a->[$aStart],$b->[$bStart],@_)){$matchVector->[$aStart++ ]=$bStart++;$prunedCount++}while ($aStart <= $aFinish and $bStart <= $bFinish and &$compare($a->[$aFinish],$b->[$bFinish],@_)){$matchVector->[$aFinish-- ]=$bFinish--;$prunedCount++}$bMatches=_withPositionsOfInInterval($b,$bStart,$bFinish,$keyGen,@_)}my$thresh=[];my$links=[];my ($i,$ai,$j,$k);for ($i=$aStart ;$i <= $aFinish ;$i++ ){$ai=&$keyGen($a->[$i],@_);if (exists($bMatches->{$ai})){$k=0;for$j (@{$bMatches->{$ai}}){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){return$prunedCount + @$thresh if$counting;for (my$link=$links->[$#$thresh];$link ;$link=$link->[0]){$matchVector->[$link->[1]]=$link->[2]}}elsif ($counting){return$prunedCount}return wantarray ? @$matchVector : $matchVector}sub traverse_sequences {my$a=shift;my$b=shift;my$callbacks=shift || {};my$keyGen=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,0,$keyGen,@_);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,@_)}}while ($ai <= $lastA or $bi <= $lastB){if ($ai==$lastA + 1 and $bi <= $lastB){if (defined($finishedACallback)){&$finishedACallback($lastA,@_);$finishedACallback=undef}else {&$discardBCallback($ai,$bi++,@_)while$bi <= $lastB}}if ($bi==$lastB + 1 and $ai <= $lastA){if (defined($finishedBCallback)){&$finishedBCallback($lastB,@_);$finishedBCallback=undef}else {&$discardACallback($ai++,$bi,@_)while$ai <= $lastA}}&$discardACallback($ai++,$bi,@_)if$ai <= $lastA;&$discardBCallback($ai,$bi++,@_)if$bi <= $lastB}return 1}sub traverse_balanced {my$a=shift;my$b=shift;my$callbacks=shift || {};my$keyGen=shift;my$matchCallback=$callbacks->{'MATCH'}|| sub {};my$discardACallback=$callbacks->{'DISCARD_A'}|| sub {};my$discardBCallback=$callbacks->{'DISCARD_B'}|| sub {};my$changeCallback=$callbacks->{'CHANGE'};my$matchVector=_longestCommonSubsequence($a,$b,0,$keyGen,@_);my$lastA=$#$a;my$lastB=$#$b;my$bi=0;my$ai=0;my$ma=-1;my$mb;while (1){do {$ma++}while($ma <= $#$matchVector &&!defined$matchVector->[$ma]);last if$ma > $#$matchVector;$mb=$matchVector->[$ma];while ($ai < $ma || $bi < $mb){if ($ai < $ma && $bi < $mb){if (defined$changeCallback){&$changeCallback($ai++,$bi++,@_)}else {&$discardACallback($ai++,$bi,@_);&$discardBCallback($ai,$bi++,@_)}}elsif ($ai < $ma){&$discardACallback($ai++,$bi,@_)}else {&$discardBCallback($ai,$bi++,@_)}}&$matchCallback($ai++,$bi++,@_)}while ($ai <= $lastA || $bi <= $lastB){if ($ai <= $lastA && $bi <= $lastB){if (defined$changeCallback){&$changeCallback($ai++,$bi++,@_)}else {&$discardACallback($ai++,$bi,@_);&$discardBCallback($ai,$bi++,@_)}}elsif ($ai <= $lastA){&$discardACallback($ai++,$bi,@_)}else {&$discardBCallback($ai,$bi++,@_)}}return 1}sub prepare {my$a=shift;my$keyGen=shift;$keyGen=sub {$_[0]}unless defined($keyGen);return scalar _withPositionsOfInInterval($a,0,$#$a,$keyGen,@_)}sub LCS {my$a=shift;my$b=shift;my$matchVector=_longestCommonSubsequence($a,$b,0,@_);my@retval;my$i;for ($i=0 ;$i <= $#$matchVector ;$i++ ){if (defined($matchVector->[$i])){push (@retval,$a->[$i])}}return wantarray ? @retval : \@retval}sub LCS_length {my$a=shift;my$b=shift;return _longestCommonSubsequence($a,$b,1,@_)}sub LCSidx {my$a=shift @_;my$b=shift @_;my$match=_longestCommonSubsequence($a,$b,0,@_);my@am=grep defined$match->[$_],0..$#$match;my@bm=@{$match}[@am];return \@am,\@bm}sub compact_diff {my$a=shift @_;my$b=shift @_;my($am,$bm)=LCSidx($a,$b,@_);my@cdiff;my($ai,$bi)=(0,0);push@cdiff,$ai,$bi;while(1){while(@$am && $ai==$am->[0]&& $bi==$bm->[0]){shift @$am;shift @$bm;++$ai,++$bi}push@cdiff,$ai,$bi;last if!@$am;$ai=$am->[0];$bi=$bm->[0];push@cdiff,$ai,$bi}push@cdiff,0+@$a,0+@$b if$ai < @$a || $bi < @$b;return wantarray ? @cdiff : \@cdiff}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 0 < @$hunk;$hunk=[]};traverse_sequences($a,$b,{MATCH=>$match,DISCARD_A=>$discard,DISCARD_B=>$add },@_);&$match();return wantarray ? @$retval : $retval}sub sdiff {my$a=shift;my$b=shift;my$retval=[];my$discard=sub {push (@$retval,['-',$a->[$_[0]],"" ])};my$add=sub {push (@$retval,['+',"",$b->[$_[1]]])};my$change=sub {push (@$retval,['c',$a->[$_[0]],$b->[$_[1]]])};my$match=sub {push (@$retval,['u',$a->[$_[0]],$b->[$_[1]]])};traverse_balanced($a,$b,{MATCH=>$match,DISCARD_A=>$discard,DISCARD_B=>$add,CHANGE=>$change,},@_);return wantarray ? @$retval : $retval}my$Root=__PACKAGE__;package Algorithm::Diff::_impl;use strict;sub _Idx() {0}sub _End() {3}sub _Same() {4}sub _Base() {5}sub _Pos() {6}sub _Off() {7}sub _Min() {-2}sub Die {require Carp;Carp::confess(@_)}sub _ChkPos {my($me)=@_;return if$me->[_Pos];my$meth=(caller(1))[3];Die("Called $meth on 'reset' object")}sub _ChkSeq {my($me,$seq)=@_;return$seq + $me->[_Off]if 1==$seq || 2==$seq;my$meth=(caller(1))[3];Die("$meth: Invalid sequence number ($seq); must be 1 or 2")}sub getObjPkg {my($us)=@_;return ref$us if ref$us;return$us ."::_obj"}sub new {my($us,$seq1,$seq2,$opts)=@_;my@args;for($opts->{keyGen}){push@args,$_ if $_}for($opts->{keyGenArgs}){push@args,@$_ if $_}my$cdif=Algorithm::Diff::compact_diff($seq1,$seq2,@args);my$same=1;if(0==$cdif->[2]&& 0==$cdif->[3]){$same=0;splice @$cdif,0,2}my@obj=($cdif,$seq1,$seq2);$obj[_End]=(1+@$cdif)/2;$obj[_Same]=$same;$obj[_Base]=0;my$me=bless \@obj,$us->getObjPkg();$me->Reset(0);return$me}sub Reset {my($me,$pos)=@_;$pos=int($pos || 0);$pos += $me->[_End]if$pos < 0;$pos=0 if$pos < 0 || $me->[_End]<= $pos;$me->[_Pos]=$pos ||!1;$me->[_Off]=2*$pos - 1;return$me}sub Base {my($me,$base)=@_;my$oldBase=$me->[_Base];$me->[_Base]=0+$base if defined$base;return$oldBase}sub Copy {my($me,$pos,$base)=@_;my@obj=@$me;my$you=bless \@obj,ref($me);$you->Reset($pos)if defined$pos;$you->Base($base);return$you}sub Next {my($me,$steps)=@_;$steps=1 if!defined$steps;if($steps){my$pos=$me->[_Pos];my$new=$pos + $steps;$new=0 if$pos && $new < 0;$me->Reset($new)}return$me->[_Pos]}sub Prev {my($me,$steps)=@_;$steps=1 if!defined$steps;my$pos=$me->Next(-$steps);$pos -= $me->[_End]if$pos;return$pos}sub Diff {my($me)=@_;$me->_ChkPos();return 0 if$me->[_Same]==(1 & $me->[_Pos]);my$ret=0;my$off=$me->[_Off];for my$seq (1,2){$ret |= $seq if$me->[_Idx][$off + $seq + _Min ]< $me->[_Idx][$off + $seq ]}return$ret}sub Min {my($me,$seq,$base)=@_;$me->_ChkPos();my$off=$me->_ChkSeq($seq);$base=$me->[_Base]if!defined$base;return$base + $me->[_Idx][$off + _Min ]}sub Max {my($me,$seq,$base)=@_;$me->_ChkPos();my$off=$me->_ChkSeq($seq);$base=$me->[_Base]if!defined$base;return$base + $me->[_Idx][$off ]-1}sub Range {my($me,$seq,$base)=@_;$me->_ChkPos();my$off=$me->_ChkSeq($seq);if(!wantarray){return$me->[_Idx][$off ]- $me->[_Idx][$off + _Min ]}$base=$me->[_Base]if!defined$base;return ($base + $me->[_Idx][$off + _Min ]).. ($base + $me->[_Idx][$off ]- 1)}sub Items {my($me,$seq)=@_;$me->_ChkPos();my$off=$me->_ChkSeq($seq);if(!wantarray){return$me->[_Idx][$off ]- $me->[_Idx][$off + _Min ]}return @{$me->[$seq]}[$me->[_Idx][$off + _Min ].. ($me->[_Idx][$off ]- 1)]}sub Same {my($me)=@_;$me->_ChkPos();return wantarray ? (): 0 if$me->[_Same]!=(1 & $me->[_Pos]);return$me->Items(1)}my%getName;BEGIN {%getName=(same=>\&Same,diff=>\&Diff,base=>\&Base,min=>\&Min,max=>\&Max,range=>\&Range,items=>\&Items,)}sub Get {my$me=shift @_;$me->_ChkPos();my@value;for my$arg (@_){for my$word (split ' ',$arg){my$meth;if($word !~ /^(-?\d+)?([a-zA-Z]+)([12])?$/ || not $meth=$getName{lc $2 }){Die($Root,", Get: Invalid request ($word)")}my($base,$name,$seq)=($1,$2,$3);push@value,scalar(4==length($name)? $meth->($me): $meth->($me,$seq,$base))}}if(wantarray){return@value}elsif(1==@value){return$value[0]}Die(0+@value," values requested from ",$Root,"'s Get in scalar context")}my$Obj=getObjPkg($Root);no strict 'refs';for my$meth (qw(new getObjPkg)){*{$Root."::".$meth}=\&{$meth};*{$Obj ."::".$meth}=\&{$meth}}for my$meth (qw(Next Prev Reset Copy Base Diff Same Items Range Min Max Get _ChkPos _ChkSeq)){*{$Obj."::".$meth}=\&{$meth}}1; +ALGORITHM_DIFF + +$fatpacked{"Algorithm/DiffOld.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALGORITHM_DIFFOLD'; + 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; + + use warnings; + use strict; + + 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 Try::Tiny; + use Pod::Usage; + + use sort 'stable'; + + # Configure Logging + use Log::ger::Output Composite => ( + outputs => { + Screen => [ + { + level => ['trace', 'info'], + conf => { stderr => 0 + , use_color => 0}, + }, + { + level => 'warn', + conf => { stderr => 1 + , use_color => -t STDERR}, + }, + ], + } + ); + use Log::ger; + use Log::ger::Util; + + # Emit usage + sub usage { + # -verbosity == 99: Only print sections in -section + pod2usage( -verbose => 99 + , -exitval => 'NOEXIT' + , -sections => 'SYNOPSIS' + ); + } + + sub usage_full { + # -verbose > 2: Print all sections + pod2usage( -verbose => 42 + , -exitval => 'NOEXIT' + ); + + } + + # Find out which task to run based on the --task variable or the system hostname + sub find_task { + my ($opts, $cfgs) = @_; + + my $task = $opts->{task}; + return $task if defined $task; + + my $identifier = Igor::Util::guess_identifier; + my @tasks = grep { + my $re = $cfgs->{$_}->{pattern} // $_; + $identifier =~ /$re/ + } sort keys %$cfgs; + + die "Automatic task selection using identifier '$identifier' not unique: " . @tasks if @tasks > 1; + die "Task selection using identifier '$identifier' matched no configurations" unless @tasks; + + return $tasks[0]; + } + + sub parse_commandline { + local @ARGV = @_; + + # Setup the defaults + my %opts = ( + configfile => './config.toml', + verbositylevel => 0, + help => 0, + + ); + + my $res = GetOptions( + summary => 'Frankensteins configuration management', + + # common options recognized by all subcommands + options => { + 'help|h|?+' => { + summary => 'Display help message', + handler => \$opts{help} + }, + 'config|c=s' => { + summary => 'Specified config', + handler => \$opts{configfile} + }, + 'verbose|v+' => { + summary => 'Verbosity level', + handler => \$opts{verbositylevel} + }, + 'task=s' => { + summary => 'Task to execute', + handler => \$opts{task} + }, + }, + + subcommands => { + apply => { + summary => 'Apply a given configuration', + options => { + 'dry-run' => { + summary => 'Only simulate the operations', + handler => \$opts{dryrun} + }, + } + }, + gc => { + summary => 'List obsolete files' + }, + diff => { + summary => 'Show the difference between applied and configured states' + }, + }, + ); + + # Display help on illegal input + unless ($res->{success} && ($opts{help} || @{$res->{subcommand}})) { + print STDERR "Parsing of commandline options failed.\n"; + usage(); + exit(-1); + } + + # Emit a help message + if ($opts{help}) { + # For a specific subcommand + if (@{$res->{subcommand}}) { + pod2usage( -verbose => 99 + , -sections => "SUBCOMMANDS/@{$res->{subcommand}}" + , -exitval => 0 + ); + } else { + # General help + if ($opts{help} >= 2) { + usage_full(); + } else { + usage(); + } + exit(0); + } + } + + # Assert: only one subcommand given + if (@{$res->{subcommand}} != 1) { + die "Igor expectes just one subcommand, but received @{[scalar(@{$res->{subcommand}})]}:" + . " @{$res->{subcommand}}"; + } + + $opts{subcommand} = $res->{subcommand}; + + return \%opts; + } + + # Parse and dispatch the commands + sub main { + my $opts = parse_commandline(@_); + + # Set log level based on verbosity + # 4 = loglevel "info" + my $loglevel = 4 + $opts->{verbositylevel}; + # Log::ger is a bit weird, I found no documentation on it, but numeric + # levels seem to need a scaling factor of 10 + Log::ger::Util::set_level($loglevel * 10); + # I want log_warn to be red (also undocumented behaviour) + $Log::ger::Output::Screen::colors{20} = "\e[0;31m"; + + # Parse the configfile + my $config = Igor::Config::from_file($opts->{configfile}); + + # Determine the task to run + my $task = find_task($opts, $config->configurations); + log_info colored(['bold'], "Running task @{[colored(['bold blue'], $task)]}"); + + # Layer the dependencies of the task and merge their configurations + my $effective_configuration = $config->determine_effective_configuration($task); + log_trace "Effective configuration:\n" . Dumper($effective_configuration); + + # Determine which packages need to be installed + # FIXME: Run factors before expanding perl-based packages. + my @packages = $config->expand_packages( $effective_configuration->{repositories} + , $effective_configuration->{packages} + , $effective_configuration + ); + log_debug "Packages to be installed: @{[map {$_->qname} @packages]}"; + log_trace "Packages to be installed:\n" . Dumper(\@packages); + + # Now dispatch the subcommands + my ($subcommand) = @{$opts->{subcommand}}; + log_info colored(['bold'], "Running subcommand @{[colored(['bold blue'], $subcommand)]}"); + + # Get the transactions required for our packages + my @transactions = map { $_->to_transactions } @packages; + + if (("apply" eq $subcommand) || ("diff" eq $subcommand)) { + # We now make three passes through the transactions: + # prepare (this will run sideeffect preparations like expanding templates, etc.) + # check (this checks for file-conflicts etc as far as possible) + # And depending on dry-run mode: + # apply (acutally perform the operations) + # or + # log (only print what would be done) + # or + # diff (show differences between repository- and filesystem-state + + # Build the context and create the "EmitCollection" transactions for the collections + my ($ctx, $colltrans) = $config->build_collection_context($effective_configuration); + push @transactions, @$colltrans; + $ctx->{$_} = $effective_configuration->{$_} for qw(facts packages); + + + my @files = map { + $_->get_files() + } @packages; + my %uniq; + for my $f (@files) { + if ($uniq{$f}++) { + die "Multiple packages produce file '$f' which is not an collection"; + } + } + + + # Run the factors defined in the configuration + push @transactions, @{$config->build_factor_transactions($effective_configuration->{factors})}; + + # Make sure they are ordered correctly: + @transactions = sort {$a->order cmp $b->order} @transactions; + + # Wrapper for safely executing actions + my $run = sub { + my ($code, $transactions) = @_; + + for my $trans (@$transactions) { + try { + $code->($trans); + } catch { + my $id; + if (defined($trans->package)) { + $id = "package @{[$trans->package->qname]}"; + } else { + $id = "toplevel or automatic transaction"; + } + log_error("Error occured when processing $id:"); + log_error($_); + die "Got a terminal failure for $id"; + } + } + }; + + log_info colored(['bold'], "Running stage \"prepare\":"); + $run->(sub { $_[0]->prepare($ctx) }, \@transactions); + log_info colored(['bold'], "Running stage \"check\":"); + $run->(sub { $_[0]->check($ctx) }, \@transactions); + + if ("apply" eq $subcommand) { + if ($opts->{dryrun}) { + log_info colored(['bold'], "Running stage \"log\":"); + $run->(sub { $_[0]->log($ctx) }, \@transactions); + } else { + log_info colored(['bold'], "Running stage \"apply\":"); + $run->(sub { $_[0]->apply($ctx) }, \@transactions); + } + } elsif ("diff" eq $subcommand) { + log_info colored(['bold'], "Running stage \"diff\":"); + $run->(sub { print $_[0]->diff($ctx) }, \@transactions); + } else { + die "Internal: wrong subcommand $subcommand"; + } + } elsif ("gc" eq $subcommand) { + # Show artifacts that exist in the filesystem which stem from + # absent packages + my @blacklist = map { + $_->gc() + } $config->complement_packages(\@packages); + + # Remove duplicates + my %uniq; + $uniq{$_} = 1 for @blacklist; + + # Remove files created by installed packages + # (e.g.: two packages provide ~/config/tmux.conf, one of which is installed) + my @whitelist = map { + $_->get_files() + } @packages; + delete $uniq{$_} for @whitelist; + + # Rewrite urls to use ~ for $HOME if possible + if (defined($ENV{HOME})) { + @blacklist = map { $_ =~ s/^\Q$ENV{HOME}\E/~/; $_ } keys %uniq; + } else { + @blacklist = keys %uniq; + } + + print $_ . "\n" for sort @blacklist; + } else { + die "Internal: Unknown subcommand $subcommand"; + } + } + + 1; +IGOR_CLI + +$fatpacked{"Igor/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_CONFIG'; + package Igor::Config; + use strict; + use warnings; + + use Class::Tiny qw(file configurations), { + defaults => {}, + repositories => {}, + packagedb => undef, + }; + + use Data::Dumper; + use Data::Diver; + use Graph; + use Igor::Merge; + use Igor::Repository; + use 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 Storable qw(dclone); + + # Config file Schemata for TOML validation + my $packageschema = Str; + my $collectionschema = Dict[ + destination => Str, + merger => Optional[Str], + perm => Optional[Str], + ]; + my $repositoryschema = Dict[ + path => Str, + ]; + my $factorschema = Dict [ + path => Str, + 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], + ]; + my $configschema = Dict[ + defaults => Optional[$configurationschema], + configurations => HashRef[$configurationschema], + ]; + + sub BUILD { + my ($self, $args) = @_; + + # Merge configurations can only be applied configured in the defaults configuration + for my $key (keys %{$args->{configurations}}) { + if (exists($args->{configurations}->{$key}->{mergeconfig})) { + die "Syntax error for configuration $key: mergeconfigs may only be applied in the defaults section"; + } + } + + # Build Path::Tiny objects + for my $cfg (values %{$args->{configurations}}, $args->{defaults}) { + $cfg //= {}; + $cfg->{repositories} //= {}; + my $base = $args->{file}->parent; + my $make_abs = sub { + my $path = path($_[0]); + if ($path->is_relative) { + # Resolve relative paths in relation to the config file + $path = path("$base/$path"); + } + $path + }; + for my $factor (@{$cfg->{factors}}) { + if (exists $factor->{path}) { + $factor->{path} = $make_abs->($factor->{path}); + } + } + for my $repokey (keys %{$cfg->{repositories}}) { + my $repo = $cfg->{repositories}->{$repokey}; + if (exists $repo->{path}) { + $repo->{path} = $make_abs->($repo->{path}); + } + } + $cfg->{collections} //= {}; + for my $collkey (keys %{$cfg->{collections}}) { + my $coll = $cfg->{collections}->{$collkey}; + $coll->{destination} = path($coll->{destination}) if exists $coll->{destination}; + } + $cfg->{mergers} //= {}; + for my $merger (keys %{$cfg->{mergers}}) { + $cfg->{mergers}->{$merger} = $make_abs->($cfg->{mergers}->{$merger}); + } + } + } + + sub from_file { + my ($filepath) = @_; + + # Parse and read the config file + my $conf = Igor::Util::read_toml($filepath); + log_debug "Parsed configuration at '$filepath':\n" . Dumper($conf); + + try { + # Validate the config + $configschema->($conf); + } catch { + die "Validating $filepath failed:\n$_"; + }; + + return 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} }); + } + + sub determine_effective_configuration { + my ($self, $root) = @_; + + die "No such configuration: $root" unless defined $self->configurations->{$root}; + + my @cfgnames = expand_dependencies($self->configurations, $root); + log_debug "Topological sort of dependencies: @cfgnames"; + + # Merge in reverse topological order + my @cfgs = map { + my $cfg = $self->configurations->{$_}; + die "No such configuration: $_" unless defined ($cfg); + $cfg; + } reverse @cfgnames; + + my $configmergers = { + factors => \&Igor::Merge::list_concat, + packages => \&Igor::Merge::uniq_list_merge, + dependencies => \&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 ($name, $bc) = @_; + unless(exists $mergers->{$name}) { + die "Configured merger '$name' for path @{$bc} is not defined"; + } + Igor::Util::file_to_coderef($mergers->{$name}); + }); + $configmergers->{$_} = $cm->{$_} for (keys %$cm); + + my $merger = Igor::Merge->new( + mergers => $configmergers, + ); + + # Prepend the defaults to the cfg list + unshift @cfgs, $self->defaults; + + # Now merge the configurations, with entries of the later ones overlaying old values + my $effective = reduce { $merger->merge($a, $b) } @cfgs; + log_trace "Merged configuration: " . Dumper($effective); + + return $effective; + } + + sub resolve_package { + my ($packagename, $repositories, $packagedb) = @_; + + # Packagenames can optionally be qualified "repo/packagename" or + # unqualified "packagename" Unqualified packagenames have to be unique + # among all repositories + + # Step one: determine $repo and $pkgname + my ($reponame, $pkgname); + + my @fragments = split /\//,$packagename,2; + if (@fragments == 2) { + # Qualified name, resolve repo -> package + my ($parent, $packagename) = @fragments; + $reponame = $parent; + $pkgname = $packagename; + } elsif (@fragments == 1) { + # Unqualified name: search packagedb + my $alternatives = $packagedb->{$packagename}; + + # Do we have at least one packages? + die "No repository provides a package '$packagename': " + . "Searched repositories: @{[sort keys %$repositories]}" + unless defined($alternatives) && (@$alternatives); + + # Do we have more than one alternative -> Qualification needed + die "Ambiguous packagename '$packagename': Instances include @$alternatives" + unless (@$alternatives == 1); + + # We have exactly one instance for the package + $reponame = $alternatives->[0]; + $pkgname = $packagename; + } else { + # This should be unreachable + die "Internal: Invalid packagename $packagename\n"; + } + + # Actually lookup the package + my $repo = $repositories->{$reponame}; + die "Unable to resolve qualified packagename '$packagename':" + . " No such repository: $reponame" unless defined $repo; + + return $repo->resolve_package($pkgname); + } + + # Given a list of packages and a list repositories, first resolve all + # packages in the given repositories and build the dependency-graph + # + # Returns all packages that need to be installed + sub expand_packages { + my ($self, $repositories, $packages, $config) = @_; + + # This sets $self->repositories and $self->packagedb + $self->build_package_db($repositories, $config); + + # Resolve all packages to qnames + my @resolved = map { + resolve_package( $_ + , $self->repositories + , $self->packagedb)->qname + } @$packages; + + # Now build the dependency graph + my $g = Graph::Directed->new; + for my $reponame (sort keys %{$self->repositories}) { + my $repo = $self->repositories->{$reponame}; + # Subgraph for the repo + my $rg = $repo->dependency_graph; + # Merge it with the global graph, prefixing all vertexes + $g->add_vertex($_) for map { "$reponame/$_" } @{[$rg->vertices]}; + for my $edge (@{[$rg->edges]}) { + my ($x,$y) = @{$edge}; + $g->add_edge("$reponame/$x", "$reponame/$y"); + } + } + + # Now add a virtual 'start' and link it to all requested packages + $g->add_vertex("start"); + for my $res (@resolved) { + $g->add_edge('start', $res); + } + + my @packages = sort $g->all_reachable("start"); + return map { + resolve_package( $_ + , $self->repositories + , $self->packagedb) + } @packages; + } + + # Given a list of packages (as Igor::Package) get all inactive packages + sub complement_packages { + my ($self, $packages) = @_; + + my %blacklist; + $blacklist{$_->id} = 1 for (@$packages); + + my @complement; + my $packagedb = $self->packagedb; + my $repos = $self->repositories; + for my $name (keys %$packagedb) { + next if $blacklist{$name}; + for my $repo (@{$packagedb->{$name}}) { + $repo = $repos->{$repo}; + + push @complement, $repo->resolve_package($name); + } + } + + return @complement; + } + + sub build_package_db { + my ($self, $repositories, $config) = @_; + + log_debug "Building packagedb"; + + my %repos = (); + my %packagedb = (); + + for my $name (sort keys %$repositories) { + my $repo = Igor::Repository->new(id => $name, directory => $repositories->{$name}->{path}, config => $config); + $repos{$name} = $repo; + + for my $pkg (keys %{$repo->packagedb}) { + push(@{$packagedb{$pkg}}, $name); + } + } + + log_trace "Build packagedb:\n" . Dumper(\%packagedb); + + $self->repositories(\%repos); + $self->packagedb(\%packagedb); + + return \%packagedb; + } + + sub build_collection_context { + my ($self, $configuration) = @_; + my $collections = $configuration->{collections}; + + my @transactions; + my $ctx = { collections => {} }; + + for my $coll (keys %$collections) { + $ctx->{collections}->{$coll} = {}; + my $pkg = 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); + } catch { + die "Error while processing collection '$coll': cannot create merger from $mergerfile: $_"; + } + } else { + $merger = sub { my $hash = shift; + my @keys = sort { $a cmp $b } keys %$hash; + join('', map {$hash->{$_}} @keys) + }; + } + push @transactions, Igor::Operation::EmitCollection->new( + collection => $coll, + merger => $merger, + sink => Igor::Sink::File->new( path => $collections->{$coll}->{destination} + , id => $pkg + , perm => $collections->{$coll}->{perm} + ), + package => $pkg, + order => 50, + ); + } + + return ($ctx, \@transactions); + } + + sub build_factor_transactions { + my ($self, $factors) = @_; + + my @transactions; + for my $factor (@$factors) { + push @transactions, Igor::Operation::RunFactor->new(%$factor, order => 1); + } + + return \@transactions; + } + + 1; + + __END__ +IGOR_CONFIG + +$fatpacked{"Igor/Diff.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_DIFF'; + package Igor::Diff; + use Exporter 'import'; + @EXPORT = qw(diff); + + use warnings; + use strict; + + { package Igor::Colordiff; + use warnings; + use strict; + + use Igor::Util qw(colored); + use Text::Diff; + our @ISA = qw(Text::Diff::Unified); + + sub file_header { + my $self = shift; + colored(['bold bright_yellow'], $self->SUPER::file_header(@_)); + } + + sub hunk_header { + my $self = shift; + colored(['bold bright_magenta'], $self->SUPER::hunk_header(@_)); + } + + sub hunk { + my $self = shift; + my (undef, undef, $ops, undef) = @_; + my @lines = split /\n/, $self->SUPER::hunk(@_), -1; + my %ops2col = ( "+" => "bold bright_green" + , " " => "" + , "-" => "bold bright_red"); + use Data::Dumper; + @lines = map { + my $color = $ops2col{$ops->[$_]->[2] // " "}; + if ($color) { + colored([$color], $lines[$_]); + } else { + $lines[$_]; + } + } 0 .. $#lines; + return join "\n", @lines; + } + } + + sub diff { + my ($x, $y, $opts) = @_; + + # Set style, allowing overrides + $opts->{STYLE} //= 'Igor::Colordiff'; + + return Text::Diff::diff($x, $y, $opts); + } +IGOR_DIFF + +$fatpacked{"Igor/Merge.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_MERGE'; + package Igor::Merge; + use warnings; + use strict; + + use Class::Tiny { + mergers => {}, + clone => 1, + }; + + use Log::ger; + use Data::Diver qw(Dive); + use Storable qw(dclone); + + sub select_merger { + my ($self) = @_; + + my $merger = Dive($self->mergers, @{$self->{breadcrumb}}); + + return undef unless ref($merger) eq 'CODE'; + return $merger; + } + + # Implementation strongly influenced by Hash::Merge and Hash::Merge::Simple, + # which in turn borrowed from Catalyst::Utils... thanks! + sub _merge { + my ($self, $left, $right) = @_; + + for my $key (keys %$right) { + my ($er, $el) = map { exists $_->{$key} } $right, $left; + + # We only have to merge duplicate keys + if ($er and not $el) { + # copy keys that don't exist in $right to $left + $left->{$key} = $right->{$key}; + next; + } elsif (not $er) { + # Key only in right + next; + } + + push @{$self->{breadcrumb}}, $key; + my $merger = $self->select_merger; + + if (defined $merger) { + log_trace "Running a custom merger on @{$self->{breadcrumb}}"; + # A custom merger was defined for this value + $left->{$key} = $merger->($left->{$key}, $right->{$key}, $self->{breadcrumb}); + } else { + my ($hr, $hl) = map { ref $_->{$key} eq 'HASH' } $right, $left; + if ($hr and $hl) { + log_trace "Running hash-merge on @{$self->{breadcrumb}}"; + # Both are hashes: Recurse + $left->{$key} = $self->_merge($left->{$key}, $right->{$key}); + } else { + log_trace "Copying $key at @{$self->{breadcrumb}}"; + # Mixed types or non HASH types: Overlay wins + $left->{$key} = $right->{$key}; + } + } + pop @{$self->{breadcrumb}}; + } + + return $left; + } + + sub merge { + my ($self, $left, $right) = @_; + + # optionally deeply duplicate the hashes before merging + if ($self->clone) { + $left = dclone($left); + $right = dclone($right); + } + + return $self->_merge($left, $right); + } + + sub list_concat { + my ($lista, $listb, $breadcrumbs) = @_; + + log_trace "Running list_concat on @{$breadcrumbs}"; + + push @$lista, @$listb; + + return $lista; + } + + # Merges two lists, while eliminating duplicates in the latter list + sub uniq_list_merge { + my ($lista, $listb, $breadcrumbs) = @_; + + log_trace "Running uniq_list_merge on @{$breadcrumbs}"; + + # We want to do the removal of duplicates in a stable fashion... + my @uniqs; + for my $i (@$listb) { + push @uniqs, $i unless grep /^$i$/, @$lista; + } + push @$lista, @uniqs; + + return $lista; + } + + sub BUILD { + my ($self, $args) = @_; + + $self->{breadcrumb} //= []; + } + + 1; +IGOR_MERGE + +$fatpacked{"Igor/Operation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_OPERATION'; + package Igor::Operation; + use strict; + use warnings; + + use Class::Tiny qw(package order); + use Data::Dumper; + use Igor::Sink; + + sub prepare { die 'Not implemented'; } + sub check { die 'Not implemented'; } + sub apply { die 'Not implemented'; } + sub diff { die 'Not implemented'; } + sub log { die 'Not implemented'; } + + sub select_backend { + my ($self, $sink) = @_; + + for my $backend (@{$sink->requires}) { + return $backend if grep {$_ == $backend} @{$self->backends}; + } + + die "No matching backend between @{[ref($self)]} and sink @{[ref($sink)]}"; + } + + sub prepare_file_for_backend { + my ($self, $file, $backend) = @_; + + if ($backend == Igor::Pipeline::Type::FILE) { + # File backend: Simply pass the file + return $file->absolute; + } elsif ($backend == 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; + } + + die "Internal: Unknown backend: $backend"; + } + + + package Igor::Operation::Template; + use strict; + use warnings; + + use Igor::Sink; + + use Class::Tiny qw(template sink), { + content => undef, + delimiters => undef, + backends => [Igor::Pipeline::Type::TEXT] + }; + use parent 'Igor::Operation'; + + use Const::Fast; + use Data::Dumper; + use Log::ger; + use Safe; + use Scalar::Util qw(reftype); + use Text::Template; + use Time::localtime; + + =begin + Generate variable declarations for C<Text::Template>'s C<HASH> parameter when used in + conjunction with C<use strict>. + + Params: + datahash - the HASH parameter passed to C<Text::Template> + + Returns: + Multiple C<use> declarations that predeclare the variables that will be autogenerated + by C<Text::Template>. + + Supported Referencetypes are: + - plain strings and numbers + - HASH + - ARRAY + - SCALAR + - REF + + Exceptions: + Dies on unknown reftypes + =cut + sub gen_template_variable_declarations { + my ($datahash) = @_; + + # For use strict to work, we have predeclare the relevant variables + # and therefore mangle accordingly. + my @variables; + for my $key (sort keys %$datahash) { + my $value = $datahash->{$key}; + # Mangling is described in + # https://metacpan.org/pod/Text::Template#PREPEND-feature-and-using-strict-in-templates + + if (not defined $value) { + # "If the value is undef, then any variables named $key, @key, + # %key, etc., are undefined." + push @variables, ("\$$key", "\%$key", "\@$key"); + next; + } + + my $type = reftype($value) // ''; + if ($type eq '') { + # If the value is a string or a number, then $key is set to + # that value in the template. For anything else, you must pass a + # reference." + push @variables, "\$$key"; + } elsif ($type eq 'ARRAY') { + # If the value is a reference to an array, then @key is set to that + # array. + push @variables, "\@$key"; + } elsif ($type eq 'HASH') { + # If the value is a reference to a hash, then %key is set to that + # hash. + push @variables, "\%$key"; + } elsif ($type eq 'SCALAR' || $type eq 'REF') { + # Similarly if value is any other kind of reference. This means that + # + # var => "foo" and var => \"foo" + # + # have almost exactly the same effect. (The difference is that in + # the former case, the value is copied, and in the latter case it is + # aliased.) + push @variables, "\$$key"; + } else { + log_error "Unexpected reference type '$type' passed to template"; + die "Unexpected reference type '$type' passed to template"; + } + } + my $decl = join('', map { "our $_;" } @variables); + log_trace "gen_template_variable_declaration: $decl"; + return $decl; + } + + sub prepare { + my ($self, $ctx) = @_; + + my $facts = $ctx->{facts}; + my $packages = $ctx->{packages}; + my $automatic = $ctx->{automatic}; + my $srcfile = $self->template; + + die "Template $srcfile is not a regular file" unless -f $srcfile; + + log_debug "Preparing Template: $srcfile"; + + # Hash for passing gathered facts and installed packages into templates + const my $data => { + facts => $facts, + packages => $packages, + automatic => $automatic, + }; + + # Use stricts requires that we predeclare those variables + my $decls = gen_template_variable_declarations($data); + + # Create a Safe compartment for evaluation, with the opcodes + # in :default being whitelisted: + # https://metacpan.org/pod/Opcode#Predefined-Opcode-Tags + my $compartment = Safe->new(); + + my %templateconfig = ( + TYPE => 'FILE', + SOURCE => $srcfile, + PREPEND => q{use warnings; use strict;} . $decls, + SAFE => $compartment, + BROKEN => sub { my %data = @_; + die "Error encountered for $srcfile:$data{lineno}: $data{error}"; + }, + ); + + # Optionally enable custom delimiters + if (defined($self->delimiters)) { + $templateconfig{DELIMITERS} = [$self->delimiters->{open}, $self->delimiters->{close}]; + } + + # Build the actual template + my $template = Text::Template->new( + %templateconfig + ) or die "Couldn't create template from '$srcfile': $Text::Template::ERROR"; + + log_trace "Evaluating Template: $srcfile over:\n" . Dumper($data); + my $content = $template->fill_in(HASH => $data); + unless (defined $content) { + die "Error while filling in template '$srcfile': $Text::Template::ERROR"; + } + $self->content($content); + + log_trace "Result:\n" . Dumper($self->content); + + return $self->content; + } + + sub apply { + my ($self, $ctx) = @_; + + # Write $content to outfile or collection... + unless (defined $self->content) { + log_warn "@{[ref($self)]}: prepare not called for template @{[$self->template]} when applying"; + $self->prepare($ctx); + } + + return $self->sink->emit(Igor::Pipeline::Type::TEXT, $self->content, $ctx); + } + + sub log { + my ($self) = @_; + + log_info "Applying @{[$self->template]} to '@{[$self->sink->stringify]}'"; + } + + sub check { + my ($self, $ctx) = @_; + + unless (defined $self->content) { + 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); + } + + sub diff { + my ($self, $ctx) = @_; + + unless (defined $self->content) { + 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 + , FILENAME_A => $self->template + , MTIME_A => $self->template->stat->mtime()); + } + + package Igor::Operation::FileTransfer; + use strict; + use warnings; + + use Igor::Sink; + + use Class::Tiny qw(source sink), { + backends => [Igor::Pipeline::Type::FILE, Igor::Pipeline::Type::TEXT], + data => undef, + backend => undef, + }; + use parent 'Igor::Operation'; + + use Log::ger; + use Time::localtime; + + sub prepare { + my ($self) = @_; + + my $backend = $self->select_backend($self->sink); + $self->backend($backend); + $self->data($self->prepare_file_for_backend($self->source, $backend)); + } + + sub check { + my ($self, $ctx) = @_; + + return $self->sink->check($self->backend, $self->data, $ctx); + } + + sub apply { + my ($self, $ctx) = @_; + + my $backend = $self->backend; + my $data = $self->data; + + log_trace "Filetransfer: @{[$self->sink->stringify]} with $data"; + # Symlink the two files... + return $self->sink->emit($backend, $data, $ctx); + } + + sub diff { + my ($self, $ctx) = @_; + + my $backend = $self->backend; + my $data = $self->data; + + return $self->sink->diff( $backend, $data, $ctx + , FILENAME_A => $self->source + , MTIME_A => $self->source->stat->mtime); + } + + sub log { + my ($self) = @_; + + log_info "Linking '@{[$self->source]}' to '@{[$self->sink->stringify]}'"; + } + + + package Igor::Operation::EmitCollection; + use strict; + use warnings; + + use parent 'Igor::Operation'; + use Class::Tiny qw(collection merger sink), { + data => undef, + }; + + use Log::ger; + use Data::Dumper; + + sub prepare { + my ($self, $ctx) = @_; + + my $collection = $ctx->{collections}->{$self->collection}; + die "Unknown collection '@{[$self->collection]}'" unless defined $collection; + + return 1; + } + + sub check { + my ($self, $ctx) = @_; + + my $collection = $ctx->{collections}->{$self->collection}; + my $data = $self->merger->($collection, $self->collection); + log_trace "Merged collection '@{[$self->collection]}': $data"; + $self->data($data); + + return $self->sink->check(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); + } + + sub diff { + my ($self, $ctx) = @_; + + return $self->sink->diff( Igor::Pipeline::Type::TEXT, $self->data, $ctx + , FILENAME_A => "Collection " . $self->collection + , MTIME_A => time()); + } + + sub log { + my ($self) = @_; + + log_info "Emitting collection '@{[$self->sink->stringify]}'"; + } + + package Igor::Operation::RunCommand; + use strict; + use warnings; + + use Igor::Sink; + + use Class::Tiny qw(command), { + basedir => "", + backends => [], + }; + use parent 'Igor::Operation'; + + use Cwd; + use Log::ger; + use File::pushd; + use File::Which; + + sub prepare { 1; } # No preparation needed + + sub check { + my ($self) = @_; + + # If we execute a proper command (vs relying on sh), + # we can actually check whether the binary exists... + if (ref($self->command) eq 'ARRAY') { + my $cmd = $self->command->[0]; + my $binary; + if (-x $cmd) { + $binary = $cmd; + } elsif (-x "@{[$self->basedir]}/$cmd") { + $binary = "@{[$self->basedir]}/$cmd"; + }else { + $binary = File::Which::which($cmd); + } + log_debug "Resolved $cmd to @{[$binary // 'undef']}"; + return defined($binary); + } + + log_trace "Cannot check shell expression @{[$self->command]}"; + 1; + } + + sub apply { + my ($self) = @_; + + # If possible, we run the commands from the package directory + my $basedir = $self->basedir; + unless ($basedir) { + $basedir = getcwd; + } + my $dir = pushd($basedir); + + # Execute + my $retval; + my $strcmd; + if (ref($self->command) eq 'ARRAY') { + $retval = system(@{$self->command}); + $strcmd = join(' ', @{$self->command}); + } else { + $retval = system($self->command); + $strcmd = $self->command; + } + + $retval == 0 or die "system($strcmd) in @{[$self->basedir]} failed with exitcode: $?"; + 1; + } + + sub log { + my ($self) = @_; + + if (ref($self->command) eq 'ARRAY') { + log_info "Executing (safe) system('@{[@{$self->command}]}')" + } else { + log_info "Executing (unsafe) system('@{[$self->command]}')" + } + 1; + } + + sub diff { + my ($self) = @_; + + return ''; + } + + package Igor::Operation::RunFactor; + use strict; + use warnings; + + use Class::Tiny qw(path), { + type => "perl", + }; + use parent 'Igor::Operation'; + + use Igor::Merge; + use String::ShellQuote; + use TOML; + use TOML::Parser; + use Try::Tiny; + use Log::ger; + + sub prepare { + my ($self, $ctx) = @_; + + 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); + $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'"; + } + + try { + $facts = from_toml($output); + } catch { + die "Factor '$cmd' failed: Invalid TOML produces:\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(); + $ctx->{automatic} = $merger->merge($auto, $facts); + 1; + } + + sub check { + 1; + } + + sub apply { + 1; + } + + sub log { + my ($self) = @_; + log_info "Already executed factor '@{[$self->path]}' of type @{[$self->type]}"; + 1; + } + + sub diff { + my ($self) = @_; + return ''; + } + + 1; + __END__ +IGOR_OPERATION + +$fatpacked{"Igor/Package.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_PACKAGE'; + package Igor::Package; + use strict; + use warnings; + + use Class::Tiny qw(basedir repository id), { + dependencies => [], + files => [], + precmds => [], + postcmds => [], + templates => [], + artifacts => [], + }; + + use Data::Dumper; + use File::pushd; + use Path::Tiny; + use Try::Tiny; + use Type::Tiny; + use Types::Standard qw(Any ArrayRef Dict HashRef Optional Str); + + use Igor::Operation; + use Igor::Util; + + # Config file Schemata for TOML validation + my $commandschema = Str | ArrayRef[Str]; + my $fileschema = Dict[ + source => Str, + collection => Str, + ] | Dict[ + source => Str, + dest => Str, + perm => Optional[Str], + operation => Optional[Str] + ]; + # Dependencies are files with a special preprocessingstep... + my $templatedelimiter = Dict[ + open => Str, + close => Str, + ]; + my $templateschema = Dict[ + source => Str, + collection => Str, + delimiters => Optional[$templatedelimiter], + ] | Dict[ + source => Str, + dest => Str, + delimiters => Optional[$templatedelimiter], + perm => Optional[Str], + ]; + my $dependencyschema = Str; + my $globschema = Str; + + my $packageschema = Dict[ + dependencies => Optional[ArrayRef[$dependencyschema]], + files => Optional[ArrayRef[$fileschema]], + templates => Optional[ArrayRef[$templateschema]], + precmds => Optional[ArrayRef[$commandschema]], + postcmds => Optional[ArrayRef[$commandschema]], + artifacts => Optional[ArrayRef[$globschema]], + ]; + + sub BUILD { + my ($self, $args) = @_; + + # Build Path::Tiny objects for all filepaths + for my $ent (@{$args->{templates}}, @{$args->{files}}) { + for my $key (qw(source dest)) { + $ent->{$key} = path($ent->{$key}) if exists $ent->{$key}; + } + } + } + + sub from_file { + my ($filepath, $repository) = @_; + + # Parse and read the config file + my $conf = Igor::Util::read_toml($filepath); + my $packagedir = path($filepath)->parent; + + return from_hash($conf, $packagedir, $repository); + } + + sub from_perl_file { + my ($filepath, $repository, $config) = @_; + + my $packagedir = path($filepath)->parent; + my $packagesub = Igor::Util::file_to_coderef($filepath); + my $conf; + { # execute this from the packageidr + my $dir = pushd($packagedir); + $conf = $packagesub->($config); + } + + return from_hash($conf, $packagedir, $repository); + } + + sub from_hash { + my ($conf, $basedir, $repository) = @_; + try { + # Validate the config + $packageschema->($conf); + } catch { + die "Validating package-configuration at $basedir failed:\n$_"; + }; + + return Igor::Package->new(basedir => $basedir + , repository => $repository + , id => $basedir->basename + , %{$conf}); + } + + sub qname { + my ($self) = @_; + + my @segments; + if (defined $self->repository) { + push @segments, $self->repository->id; + } + push @segments, $self->id; + + return join('/', @segments); + } + + sub determine_sink { + my ($file, $id) = @_; + + if (defined($file->{dest})) { + return 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); + } else { + die "Failed to determine sink for file: " . Dumper($file); + } + } + + sub to_transactions { + my ($self) = @_; + my @transactions; + + # Run precommands + for my $cmd (@{$self->precmds}) { + push @transactions, Igor::Operation::RunCommand->new( + package => $self, + command => $cmd, + basedir => $self->basedir, + order => 10, + ); + } + + # Symlink and create files + for my $file (@{$self->files}) { + 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( + package => $self, + source => $source, + sink => determine_sink($file, $self->qname), + order => 20, + ); + } + + # Run the templates + for my $tmpl (@{$self->templates}) { + push @transactions, Igor::Operation::Template->new( + package => $self, + template => path("@{[$self->basedir]}/$tmpl->{source}"), + sink => determine_sink($tmpl, $self->qname), + delimiters => $tmpl->{delimiters}, + order => 30, + ); + } + + # Now run the postcommands + for my $cmd (@{$self->postcmds}) { + push @transactions, Igor::Operation::RunCommand->new( + package => $self, + command => $cmd, + basedir => $self->basedir, + order => 90, + ); + } + + @transactions; + } + + sub get_files { + my ($self) = @_; + + my @files = map { $_->{dest} } @{$self->files}, @{$self->templates}; + return map { + my $file = $_; + try { + $file = path($file)->realpath->stringify + } catch { + # Nonexistent file -> realpath does not work + $file = path($file)->absolute->stringify + }; + $file + } grep { defined($_) } @files; + } + + sub gc { + my ($self) = @_; + + my @files = map { $_->{dest} } @{$self->files}, @{$self->templates}; + my @artifacts = map { Igor::Util::glob($_) } @{$self->artifacts}; + + return map { + path($_)->realpath->stringify + } grep { defined($_) } @files, @artifacts; + } + + 1; + + __END__ +IGOR_PACKAGE + +$fatpacked{"Igor/Repository.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_REPOSITORY'; + package Igor::Repository; + use strict; + use warnings; + + use Class::Tiny qw(id directory), { + packagedb => {} + }; + + use Igor::Package; + use Igor::Util; + use Path::Tiny; + use Data::Dumper; + use Log::ger; + + # Collect the packages contained in this repository from the filesystem at + # C<dir> with effective configuration C<conf> + sub collect_packages { + my ($self, $dir, $conf) = @_; + + # Sanity check + die "Configured Repository at $dir is not an directory" unless $dir->is_dir; + + # Visit all subdirectories, and create a package for it if there is a package.toml file + my $packages = $dir->visit( + sub { + my ($path, $state) = @_; + + my $package; + if ((my $packagedesc = $path->child("package.toml"))->is_file) { + $package = Igor::Package::from_file($packagedesc, $self); + } elsif ((my $packagedescpl = $path->child("package.pl"))->is_file) { + $package = Igor::Package::from_perl_file($packagedescpl, $self, $conf); + log_debug ("Evaluated @{[$packagedescpl->stringify]}: " . Dumper($package)); + } + return unless defined($package); + + $state->{$path->basename} = $package; + } + ); + + return $packages; + } + + sub dependency_graph { + my ($self) = @_; + + my $g = Igor::Util::build_graph($self->packagedb, sub { + $_[0]->dependencies; + }); + + return $g; + } + + sub resolve_package { + my ($self, $package) = @_; + + my $resolved = $self->packagedb->{$package}; + + die "No such package '$package' in repository '$self->id'" unless defined $resolved; + + return $resolved; + } + + sub BUILD { + my ($self, $args) = @_; + + # Make sure we've got a Path::Tiny object + # Dynamic typing IS funny :D + unless (ref($self->directory) eq 'Path::Tiny') { + $self->directory(path($self->directory)); + } + + $self->packagedb($self->collect_packages($self->directory, $args->{config})); + } + + 1; + + __END__ +IGOR_REPOSITORY + +$fatpacked{"Igor/Sink.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_SINK'; + use strict; + + package Igor::Sink { + use strict; + use warnings; + + use Class::Tiny; + + sub requires { die "Not implemented"; } + sub check { die "Not implemented"; } + sub emit { die "Not implemented"; } + sub diff { die "Not implemented"; } + + } + + + package Igor::Pipeline::Type { + use strict; + + use constant { + TEXT => 0, + FILE => 1, + }; + + use constant { + CHANGED => 0, + UNCHANGED => 1, + }; + } + + package Igor::Sink::File { + use strict; + use warnings; + + use parent 'Igor::Sink'; + use Class::Tiny qw(path), { + perm => undef, + operation => undef, + }; + + use Const::Fast; + use Data::Dumper; + use Log::ger; + use Igor::Diff (); + use Try::Tiny; + use Fcntl ':mode'; + + const my @REQUIRES => (Igor::Pipeline::Type::FILE, Igor::Pipeline::Type::TEXT); + + sub BUILD { + my ($self, $args) = @_; + $args->{operation} //= 'symlink'; + + unless (grep { /^\Q$args->{operation}\E$/ } qw(symlink copy)) { + die "Illegal file operation specified for @{[$args->{path}]}: $args->{operation}"; + } + } + + sub requires { return \@REQUIRES; } + + sub prepare_for_copy { + my ($self, $typeref, $dataref) = @_; + + if (defined $self->operation && $self->operation eq "copy") { + $$typeref = 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(); + } + } + + sub check { + my ($self, $type, $data) = @_; + + my $changeneeded = 0; + + prepare_for_copy($self, \$type, \$data); + + if ($type == Igor::Pipeline::Type::TEXT) { + try { + $changeneeded = $self->path->slurp_utf8() ne $data; + } catch { + $changeneeded = 1; + }; + } elsif ($type == Igor::Pipeline::Type::FILE) { + try { + $changeneeded = not (S_ISLNK($self->path->lstat->mode) && ($self->path->realpath eq $data->realpath)); + } catch { + $changeneeded = 1; + }; + if (-e $self->path && not S_ISLNK($self->path->lstat->mode)) { + die ("File @{[$self->path]} already exists and is not a symlink"); + } + } else { + die "Unsupported type \"$type\" at \"@{[ __PACKAGE__ ]}\" when checking file @{[$self->path]}"; + } + + return $changeneeded; + } + + sub emit { + my ($self, $type, $data) = @_; + + return Igor::Pipeline::Type::UNCHANGED unless $self->check($type, $data); + + prepare_for_copy($self, \$type, \$data); + + # Create directory if the target directory does not exist + unless ($self->path->parent->is_dir) { + $self->path->parent->mkpath; + } + + if ($type == Igor::Pipeline::Type::TEXT) { + log_trace "spew(@{[$self->path]}, " . Dumper($data) . ")"; + + # write the data + $self->path->spew_utf8($data); + + # Fix permissions if requested + if (defined $self->perm) { + $self->path->chmod($self->perm); + } + } elsif ($type == Igor::Pipeline::Type::FILE) { + my $dest = $self->path->absolute; + + # Remove the link if it exists + unlink $dest if -l $dest; + + # symlink + symlink $data,$dest or die "Failed to symlink: $dest -> $data: $!"; + } else { + die "Unsupported type \"$type\" at \"" . __PACKAGE__ . "\" when emitting file @{[$self->path]}"; + } + + return Igor::Pipeline::Type::CHANGED; + } + + sub diff { + my ($self, $type, $data, undef, %opts) = @_; + + prepare_for_copy($self, \$type, \$data); + + my $diff; + if ($type == Igor::Pipeline::Type::TEXT) { + try { + $diff = Igor::Diff::diff \$data, $self->path->stringify, \%opts; + } catch { + $diff = $_; + } + } elsif ($type == Igor::Pipeline::Type::FILE) { + try { + $diff = Igor::Diff::diff $data->stringify, $self->path->stringify, \%opts; + } catch { + $diff = $_; + } + } else { + die "Unsupported type \"$type\" at \"" . __PACKAGE__ . "\" when checking file $self->path"; + } + + return $diff; + } + + sub stringify { + my ($self) = @_; + + my $name = $self->path->stringify; + if(defined $self->perm) { + my $perm = sprintf("%o", $self->perm); + $name .= " (chmod $perm)"; + } + + return $name; + } + } + + package Igor::Sink::Collection { + use strict; + use warnings; + + # Collection sinks are a bit of a hack: They simply export to a context, which + # 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 Class::Tiny qw(collection id), { + checked => 0, + }; + + use Const::Fast; + use Data::Dumper; + use Log::ger; + use Text::Diff (); + + const my @REQUIRES => (Igor::Pipeline::Type::TEXT); + + sub requires { \@REQUIRES } + + sub check { + my ($self, $type, $data, $ctx) = @_; + + # Only build the context once + return 1 if $self->checked; + + # 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; + + # Ensure that collection exists + die "Unknown collection '@{[$self->collection]}' for package '@{[$self->id]}'" + unless exists $ctx->{collections}->{$self->collection}; + my $collection = $ctx->{collections}->{$self->collection}; + + # Ensure that a package only writes to the context once + die "Duplicate entry for @{[$self->id]} in collection @{[$self->collection]}" if (exists $collection->{$self->id}); + + # Write to the context + $collection->{$self->id} = $data; + + # Check has run + $self->checked(1); + + return 1; + } + + sub emit { + my ($self, $type, $data, $ctx) = @_; + + # Sets $ctx + $self->check($type, $data, $ctx); + + return Igor::Pipeline::Type::UNCHANGED; + } + + sub diff { + my ($self, $type, $data, $ctx) = @_; + + # Diff happens in a dedicated operation, based on $ctx + # Sets $ctx + $self->check($type, $data, $ctx); + + return ''; + } + + sub stringify { + my ($self) = @_; + + my $name = "collection(@{[$self->collection]})"; + return $name; + } + } + + 1; + + __END__ +IGOR_SINK + +$fatpacked{"Igor/Types.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_TYPES'; + package Igor::Types; + use warnings; + use strict; + + use Type::Library -base; + use Type::Utils -all; + + use Path::Tiny; + + BEGIN { extends "Types::Standard" }; + + + our $PathTiny = class_type "PathTiny", { class => "Path::Tiny" }; + coerce "PathTiny", + from "Str", via { Path::Tiny->new($_) }; + 1; + + __END__ +IGOR_TYPES + +$fatpacked{"Igor/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'IGOR_UTIL'; + package Igor::Util; + use Exporter 'import'; + @EXPORT_OK = qw(colored); + + use strict; + use warnings; + use feature 'state'; + + use Data::Diver qw(DiveRef); + use Data::Dumper; + use File::Glob ':bsd_glob'; + use Graph; + use Graph::Directed; + use Log::ger; + use Net::Domain; + use Path::Tiny; + use Scalar::Util qw(reftype); + use Sys::Hostname; + use Term::ANSIColor (); + use TOML; + use TOML::Parser; + + sub read_toml { + my ($filepath) = @_; + + state $parser = TOML::Parser->new( + inflate_boolean => sub { $_[0] eq 'true' ? \1 : \0 }, + ); + my ($conf, $err) = $parser->parse_file($filepath); + unless ($conf) { + log_error "Parsing of $filepath failed: $err"; + die $err; + } + + return $conf; + } + + sub build_graph { + my ($hash, $lambda_deps) = @_; + + # Build the graph + my $g = Graph::Directed->new; + + for my $key (sort keys %$hash) { + $g->add_vertex($key); + my $deps = $lambda_deps->($hash->{$key}); + next unless defined($deps); + for my $child (@$deps) { + $g->add_edge($key, $child); + } + } + + return $g; + } + + sub toposort_dependencies { + my ($hash, $root, $lambda_deps) = @_; + + my $g = build_graph($hash, $lambda_deps); + $g->add_vertex($root); + + log_trace "Dependency graph: $g\n"; + + # Do a topological sort + my @ts = $g->topological_sort; + + # Now restrict that to the nodes reachable from the root + my %r = ($root => 1); + $r{$_}=1 for ($g->all_reachable($root)); + + my @order = grep { $r{$_} } @ts; + return @order; + } + + # Tries to determine an identifier for the current computer from the following sources: + # - fully qualified domain name (via Net::Domain) + # - hostname (via Sys::Hostname) + # In the following order, this sources are probed, the first successful entry is returned + sub guess_identifier { + # Try fqdn + my $fqdn = Net::Domain::hostfqdn; + return $fqdn if defined $fqdn; + + # Try hostname + return Sys::Hostname::hostname; # Croaks on error + } + + sub colored { + if (-t STDOUT) { # outputting to terminal + return Term::ANSIColor::colored(@_); + } else { + # Colored has two calling modes: + # colored(STRING, ATTR[, ATTR ...]) + # colored(ATTR-REF, STRING[, STRING...]) + + unless (ref($_[0])) { # Called as option one + return $_; + } else { # Called as option two + shift; + return @_; + } + } + } + + { no warnings 'redefine'; + sub glob { + my ($pattern) = @_; + + return bsd_glob($pattern, GLOB_BRACE | GLOB_MARK | GLOB_NOSORT | GLOB_QUOTE | GLOB_TILDE); + } + } + + # Read a file (as Path::Tiny instances) containing a sub and return the correspoding coderef + sub file_to_coderef { + my ($path) = @_; + my $source = $path->slurp; + log_trace "Executing @{[$path]}:\n$source"; + my $coderef = eval { eval($source) }; + die "Failure while evaluating the coderef at @{[$path]}: $@\n" if not defined $coderef; + return $coderef; + } + + # Traversal for HASH of HASH of HASH ... calls the callback with the value and current list of breadcrumbs + # i.e.: [key1, innerkey2, innermostkey3] + sub traverse_nested_hash { + my ($hash, $cb) = @_; + + my @worklist = ({ + breadcrumbs => [], + data => $hash, + }); + + my %result; + + while(@worklist) { + my $ctx = pop @worklist; + my @breadcrumbs = @{$ctx->{breadcrumbs}}; + my $d = $ctx->{data}; + if (reftype($d) // '' eq 'HASH') { + for my $k (keys %$d) { + my $bc = [@breadcrumbs, $k]; + push @worklist, { breadcrumbs => $bc, data => $d->{$k}}; + } + } else { + my $ref = DiveRef(\%result, @breadcrumbs); + $$ref = $cb->($d, \@breadcrumbs); + } + } + + return \%result; + } + + 1; + + __END__ +IGOR_UTIL + +$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; +LOG_GER + +$fatpacked{"Log/ger/Format.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_FORMAT'; + package Log::ger::Format;our$DATE='2017-08-03';our$VERSION='0.023';use parent qw(Log::ger::Plugin);sub _import_sets_for_current_package {1}1; +LOG_GER_FORMAT + +$fatpacked{"Log/ger/Format/None.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_FORMAT_NONE'; + package Log::ger::Format::None;our$DATE='2017-08-03';our$VERSION='0.023';sub get_hooks {return {create_formatter=>[__PACKAGE__,50,sub {[sub {shift}]}],}}1; +LOG_GER_FORMAT_NONE + +$fatpacked{"Log/ger/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_HEAVY'; + package Log::ger::Heavy;our$DATE='2017-08-03';our$VERSION='0.023';package Log::ger;our%Default_Hooks=(create_formatter=>[[__PACKAGE__,90,sub {my%args=@_;my$formatter=sub {return $_[0]if @_ < 2;my$fmt=shift;my@args;for (@_){if (!defined($_)){push@args,'<undef>'}elsif (ref $_){require Log::ger::Util unless$_dumper;push@args,Log::ger::Util::_dump($_)}else {push@args,$_}}sprintf$fmt,@args};[$formatter]}],],create_layouter=>[],create_routine_names=>[[__PACKAGE__,90,sub {my%args=@_;my$levels=[keys%Levels];return [{log_subs=>[map {["log_$_",$_]}@$levels],is_subs=>[map {["log_is_$_",$_]}@$levels],log_methods=>[map {["$_",$_]}@$levels],is_methods=>[map {["is_$_",$_]}@$levels],},1]}],],create_log_routine=>[[__PACKAGE__,10,sub {my%args=@_;my$level=$args{level};if (defined($level)&& ($Current_Level < $level || @{$Global_Hooks{create_log_routine}}==1)){$_logger_is_null=1;return [sub {0}]}[undef]}],],create_logml_routine=>[],create_is_routine=>[[__PACKAGE__,90,sub {my%args=@_;my$level=$args{level};[sub {$Current_Level >= $level}]}],],before_install_routines=>[],after_install_routines=>[],);for my$phase (keys%Default_Hooks){$Global_Hooks{$phase}=[@{$Default_Hooks{$phase}}]}sub run_hooks {my ($phase,$hook_args,$flow_control,$target,$target_arg)=@_;$Global_Hooks{$phase}or die "Unknown phase '$phase'";my@hooks=@{$Global_Hooks{$phase}};if ($target eq 'package'){unshift@hooks,@{$Per_Package_Hooks{$target_arg}{$phase}|| []}}elsif ($target eq 'hash'){my ($addr)="$target_arg" =~ $re_addr;unshift@hooks,@{$Per_Hash_Hooks{$addr}{$phase}|| []}}elsif ($target eq 'object'){my ($addr)="$target_arg" =~ $re_addr;unshift@hooks,@{$Per_Object_Hooks{$addr}{$phase}|| []}}my$res;for my$hook (sort {$a->[1]<=> $b->[1]}@hooks){my$hook_res=$hook->[2]->(%$hook_args);if (defined$hook_res->[0]){$res=$hook_res->[0];if (ref$flow_control eq 'CODE'){last if$flow_control->($hook,$hook_res)}else {last if$flow_control}}last if$hook_res->[1]}return$res}sub init_target {my ($target,$target_arg,$init_args)=@_;my%hook_args=(target=>$target,target_arg=>$target_arg,init_args=>$init_args,);my%formatters;run_hooks('create_formatter',\%hook_args,sub {my ($hook,$hook_res)=@_;my ($formatter,$flow_control,$fmtname)=@$hook_res;$fmtname='default' if!defined($fmtname);$formatters{$fmtname}||= $formatter;$flow_control},$target,$target_arg);my$layouter=run_hooks('create_layouter',\%hook_args,1,$target,$target_arg);my$routine_names={};run_hooks('create_routine_names',\%hook_args,sub {my ($hook,$hook_res)=@_;my ($rn,$flow_control)=@$hook_res;$rn or return;for (keys %$rn){push @{$routine_names->{$_}},@{$rn->{$_}}}$flow_control},$target,$target_arg);my@routines;my$object=$target eq 'object';CREATE_LOG_ROUTINES: {my@rn;if ($target eq 'package'){push@rn,@{$routine_names->{log_subs}|| []};push@rn,@{$routine_names->{logml_subs}|| []}}else {push@rn,@{$routine_names->{log_methods}|| []};push@rn,@{$routine_names->{logml_methods}|| []}}my$mllogger0;for my$rn (@rn){my ($rname,$lname,$fmtname)=@$rn;my$lnum;$lnum=$Levels{$lname}if defined$lname;my$routine_name_is_ml=!defined($lname);$fmtname='default' if!defined($fmtname);my$logger;my ($logger0,$logger0_is_ml);$_logger_is_null=0;for my$phase (qw/create_logml_routine create_log_routine/){local$hook_args{name}=$rname;local$hook_args{level}=$lnum;local$hook_args{str_level}=$lname;$logger0_is_ml=$phase eq 'create_logml_routine';if ($mllogger0){$logger0=$mllogger0;last}$logger0=run_hooks($phase,\%hook_args,1,$target,$target_arg)or next;if ($logger0_is_ml){$mllogger0=$logger0}last}unless ($logger0){$_logger_is_null=1;$logger0=sub {0}}require Log::ger::Util if!$logger0_is_ml && $routine_name_is_ml;{if ($_logger_is_null){$logger=$logger0;last}my$formatter=$formatters{$fmtname}or die "Formatter named '$fmtname' not available";if ($formatter){if ($layouter){if ($logger0_is_ml){if ($routine_name_is_ml){if ($object){$logger=sub {shift;my$lnum=shift;my$lname=Log::ger::Util::string_level($lnum);$logger0->($init_args,$lnum,$layouter->($formatter->(@_),$init_args,$lnum,$lname))}}else {$logger=sub {my$lnum=shift;my$lname=Log::ger::Util::string_level($lnum);$logger0->($init_args,$lnum,$layouter->($formatter->(@_),$init_args,$lnum,$lname))}}}else {if ($object){$logger=sub {shift;$logger0->($init_args,$lnum,$layouter->($formatter->(@_),$init_args,$lnum,$lname))}}else {$logger=sub {$logger0->($init_args,$lnum,$layouter->($formatter->(@_),$init_args,$lnum,$lname))}}}}else {if ($routine_name_is_ml){if ($object){$logger=sub {shift;return 0 if Log::ger::Util::numeric_level(shift)> $Current_Level;$logger0->($init_args,$layouter->($formatter->(@_),$init_args,$lnum,$lname))}}else {$logger=sub {return 0 if Log::ger::Util::numeric_level(shift)> $Current_Level;$logger0->($init_args,$layouter->($formatter->(@_),$init_args,$lnum,$lname))}}}else {if ($object){$logger=sub {shift;$logger0->($init_args,$layouter->($formatter->(@_),$init_args,$lnum,$lname))}}else {$logger=sub {$logger0->($init_args,$layouter->($formatter->(@_),$init_args,$lnum,$lname))}}}}}else {if ($logger0_is_ml){if ($routine_name_is_ml){if ($object){$logger=sub {shift;my$lnum=shift;$logger0->($init_args,$lnum,$formatter->(@_))}}else {$logger=sub {my$lnum=shift;$logger0->($init_args,$lnum,$formatter->(@_))}}}else {if ($object){$logger=sub {shift;$logger0->($init_args,$lnum,$formatter->(@_))}}else {$logger=sub {$logger0->($init_args,$lnum,$formatter->(@_))}}}}else {if ($routine_name_is_ml){if ($object){$logger=sub {shift;return 0 if Log::ger::Util::numeric_level(shift)> $Current_Level;$logger0->($init_args,$formatter->(@_))}}else {$logger=sub {return 0 if Log::ger::Util::numeric_level(shift)> $Current_Level;$logger0->($init_args,$formatter->(@_))}}}else {if ($object){$logger=sub {shift;$logger0->($init_args,$formatter->(@_))}}else {$logger=sub {$logger0->($init_args,$formatter->(@_))}}}}}}else {{if ($logger0_is_ml){if ($routine_name_is_ml){if ($object){$logger=sub {shift;my$lnum=shift;$logger0->($init_args,$lnum,@_)}}else {$logger=sub {my$lnum=shift;$logger0->($init_args,$lnum,@_)}}}else {if ($object){$logger=sub {shift;$logger0->($init_args,$lnum,@_)}}else {$logger=sub {$logger0->($init_args,$lnum,@_)}}}}else {if ($routine_name_is_ml){if ($object){$logger=sub {shift;return 0 if Log::ger::Util::numeric_level(shift)> $Current_Level;$logger0->($init_args,@_)}}else {$logger=sub {return 0 if Log::ger::Util::numeric_level(shift)> $Current_Level;$logger0->($init_args,@_)}}}else {if ($object){$logger=sub {shift;$logger0->($init_args,@_)}}else {$logger=sub {$logger0->($init_args,@_)}}}}}}}L1: my$type=$routine_name_is_ml ? ($object ? 'logml_method' : 'logml_sub'): ($object ? 'log_method' : 'log_sub');push@routines,[$logger,$rname,$lnum,$type]}}CREATE_IS_ROUTINES: {my@rn;my$type;if ($target eq 'package'){push@rn,@{$routine_names->{is_subs}|| []};$type='is_sub'}else {push@rn,@{$routine_names->{is_methods}|| []};$type='is_method'}for my$rn (@rn){my ($rname,$lname)=@$rn;my$lnum=$Levels{$lname};local$hook_args{name}=$rname;local$hook_args{level}=$lnum;local$hook_args{str_level}=$lname;my$code_is=run_hooks('create_is_routine',\%hook_args,1,$target,$target_arg);next unless$code_is;push@routines,[$code_is,$rname,$lnum,$type]}}{local$hook_args{routines}=\@routines;local$hook_args{formatters}=\%formatters;local$hook_args{layouter}=$layouter;run_hooks('before_install_routines',\%hook_args,0,$target,$target_arg)}install_routines($target,$target_arg,\@routines);{local$hook_args{routines}=\@routines;run_hooks('after_install_routines',\%hook_args,0,$target,$target_arg)}}1; +LOG_GER_HEAVY + +$fatpacked{"Log/ger/Layout.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_LAYOUT'; + package Log::ger::Layout;our$DATE='2017-08-03';our$VERSION='0.023';use parent qw(Log::ger::Plugin);sub _replace_package_regex {qr/\ALog::ger::Layout::/}1; +LOG_GER_LAYOUT + +$fatpacked{"Log/ger/Output.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_OUTPUT'; + package Log::ger::Output;our$DATE='2017-08-03';our$VERSION='0.023';use parent 'Log::ger::Plugin';sub _replace_package_regex {qr/\ALog::ger::Output::/}1; +LOG_GER_OUTPUT + +$fatpacked{"Log/ger/Output/Array.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_OUTPUT_ARRAY'; + package Log::ger::Output::Array;our$DATE='2017-08-03';our$VERSION='0.023';use strict;use warnings;sub get_hooks {my%conf=@_;$conf{array}or die "Please specify array";return {create_log_routine=>[__PACKAGE__,50,sub {my%args=@_;my$logger=sub {my ($ctx,$msg)=@_;push @{$conf{array}},$msg};[$logger]}],}}1; +LOG_GER_OUTPUT_ARRAY + +$fatpacked{"Log/ger/Output/ArrayML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_OUTPUT_ARRAYML'; + package Log::ger::Output::ArrayML;our$DATE='2017-08-03';our$VERSION='0.023';use strict;use warnings;use Log::ger::Util;sub get_hooks {my%conf=@_;$conf{array}or die "Please specify array";return {create_logml_routine=>[__PACKAGE__,50,sub {my%args=@_;my$logger=sub {my$level=Log::ger::Util::numeric_level($_[1]);return if$level > $Log::ger::Current_Level;push @{$conf{array}},$_[2]};[$logger]}],}}1; +LOG_GER_OUTPUT_ARRAYML + +$fatpacked{"Log/ger/Output/Composite.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_OUTPUT_COMPOSITE'; + package Log::ger::Output::Composite;our$DATE='2017-07-02';our$VERSION='0.007';use strict;use warnings;sub _get_min_max_level {my$level=shift;my ($min,$max);if (defined$level){if (ref$level eq 'ARRAY'){$min=Log::ger::Util::numeric_level($level->[0]);$max=Log::ger::Util::numeric_level($level->[1]);($min,$max)=($max,$min)if$min > $max}else {$min=0;$max=Log::ger::Util::numeric_level($level)}}($min,$max)}sub get_hooks {my%conf=@_;my@ospecs;{my$outputs=$conf{outputs};for my$oname (sort keys %$outputs){my$ospec0=$outputs->{$oname};my@ospecs0;if (ref$ospec0 eq 'ARRAY'){@ospecs0=map {+{%{$_}}}@$ospec0}else {@ospecs0=(+{%{$ospec0}})}die "Invalid output name '$oname'" unless$oname =~ /\A\w+(::\w+)*\z/;my$mod="Log::ger::Output::$oname";(my$mod_pm="$mod.pm")=~ s!::!/!g;require$mod_pm;for my$ospec (@ospecs0){$ospec->{_name}=$oname;$ospec->{_mod}=$mod;push@ospecs,$ospec}}}return {'create_logml_routine'=>[__PACKAGE__,50,sub {no strict 'refs';require Data::Dmp;my%args=@_;my$target=$args{target};my$target_arg=$args{target_arg};my$loggers=[];my$logger_is_ml=[];my$layouters=[];for my$ospec (@ospecs){my$oname=$ospec->{_name};my$mod="Log::ger::Output::$oname";my$hooks=&{"$mod\::get_hooks"}(%{$ospec->{conf}|| {}})or die "Output module $mod does not return any hooks";my@hook_args=(target=>$args{target},target_arg=>$args{target_arg},init_args=>$args{init_args},);my$res;{if ($hooks->{create_logml_routine}){$res=$hooks->{create_logml_routine}->[2]->(@hook_args);if ($res->[0]){push @$loggers,$res->[0];push @$logger_is_ml,1;last}}push@hook_args,(level=>6,str_level=>'trace');if ($hooks->{create_log_routine}){$res=$hooks->{create_log_routine}->[2]->(@hook_args);if ($res->[0]){push @$loggers,$res->[0];push @$logger_is_ml,0;last}}die "Output module $mod does not produce logger in "."its create_logml_routine nor create_log_routine "."hook"}if ($ospec->{layout}){my$lname=$ospec->{layout}[0];my$lconf=$ospec->{layout}[1]|| {};my$lmod="Log::ger::Layout::$lname";(my$lmod_pm="$lmod.pm")=~ s!::!/!g;require$lmod_pm;my$lhooks=&{"$lmod\::get_hooks"}(%$lconf)or die "Layout module $lmod does not return "."any hooks";$lhooks->{create_layouter}or die "Layout module $mod does not declare "."layouter";my@lhook_args=(target=>$args{target},target_arg=>$args{target_arg},init_args=>$args{init_args},);my$lres=$lhooks->{create_layouter}->[2]->(@lhook_args)or die "Hook from layout module "."$lmod does not produce layout routine";ref$lres->[0]eq 'CODE' or die "Layouter from layout module $lmod "."is not a coderef";push @$layouters,$lres->[0]}else {push @$layouters,undef}}unless (@$loggers){$Log::err::_logger_is_null=1;return [sub {0}]}my$varname=do {my$suffix;if ($args{target}eq 'package'){$suffix=$args{target_arg}}else {($suffix)="$args{target_arg}" =~ /\(0x(\w+)/}"Log::ger::Stash::OComposite_$suffix"};{no strict 'refs';${$varname}=[];${$varname}->[0]=$loggers;${$varname}->[1]=$layouters;${$varname}->[2]=$args{init_args}}my$logger;{my@src;push@src,"sub {\n";push@src," my (\$ctx, \$lvl, \$msg) = \@_;\n";for my$i (0..$#ospecs){my$ospec=$ospecs[$i];push@src," # output #$i: $ospec->{_name}\n";push@src," {\n";if ($ospec->{category_level}|| $conf{category_level}){push@src," my \$cat = \$ctx->{category} || "."'';\n";my@cats;if ($ospec->{category_level}){for my$cat (keys %{$ospec->{category_level}}){my$clevel=$ospec->{category_level}{$cat};push@cats,[$cat,1,$clevel]}}if ($conf{category_level}){for my$cat (keys %{$conf{category_level}}){my$clevel=$conf{category_level}{$cat};push@cats,[$cat,2,$clevel]}}for my$cat (sort {length($b->[0])<=> length($a->[0])|| $a->[0]cmp $b->[0]|| $a->[1]<=> $b->[1]}@cats){push@src," if (\$cat eq ".Data::Dmp::dmp($cat->[0])." || index(\$cat, ".Data::Dmp::dmp("$cat->[0]\::").") == 0) { ";my ($min_level,$max_level)=_get_min_max_level($cat->[2]);push@src,"if (\$lvl >= $min_level && "."\$lvl <= $max_level) { goto L } else { last }";push@src," }\n"}push@src,"\n"}my ($min_level,$max_level)=_get_min_max_level($ospec->{level});if (defined$min_level){push@src," if (\$lvl >= $min_level && "."\$lvl <= $max_level) { goto L } else { last }\n"}push@src," if (\$Log::ger::Current_Level >= \$lvl) { goto L } else { last }\n";if ($logger_is_ml->[$i]){push@src," L: if (\$$varname\->[1][$i]) { \$$varname\->[0][$i]->(\$ctx, \$lvl, \$$varname\->[1][$i]->(\$msg, \$$varname\->[2], \$lvl, Log::ger::Util::string_level(\$lvl))) } else { \$$varname\->[0][$i]->(\$ctx, \$lvl, \$msg) }\n"}else {push@src," L: if (\$$varname\->[1][$i]) { \$$varname\->[0][$i]->(\$ctx, \$$varname\->[1][$i]->(\$msg, \$$varname\->[2], \$lvl, Log::ger::Util::string_level(\$lvl))) } else { \$$varname\->[0][$i]->(\$ctx, \$msg) }\n"}push@src," }\n";push@src," # end output #$i\n\n"}push@src,"};\n";my$src=join("",@src);$logger=eval$src}[$logger]}]}}1; +LOG_GER_OUTPUT_COMPOSITE + +$fatpacked{"Log/ger/Output/Null.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_OUTPUT_NULL'; + package Log::ger::Output::Null;our$DATE='2017-08-03';our$VERSION='0.023';sub get_hooks {return {create_log_routine=>[__PACKAGE__,50,sub {$Log::ger::_logger_is_null=1;[sub {0}]}],}}1; +LOG_GER_OUTPUT_NULL + +$fatpacked{"Log/ger/Output/Screen.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_OUTPUT_SCREEN'; + package Log::ger::Output::Screen;our$DATE='2017-08-03';our$VERSION='0.007';use strict;use warnings;use Log::ger::Util;our%colors=(10=>"\e[31m",20=>"\e[35m",30=>"\e[1;34m",40=>"\e[32m",50=>"",60=>"\e[33m",);our%level_map;sub _pick_color {my$level=shift;if (defined(my$c=$colors{$level})){return$c}if (defined(my$clevel=$level_map{$level})){return$colors{$clevel}}my ($dist,$clevel);for my$k (keys%colors){my$d=abs($k - $level);if (!defined($dist)|| $dist > $d){$dist=$d;$clevel=$k}}$level_map{$level}=$clevel;return$colors{$clevel}}sub hook_before_log {my ($ctx,$msg)=@_}sub hook_after_log {my ($ctx,$msg)=@_;print {$ctx->{_fh}}"\n" unless$msg =~ /\R\z/}sub get_hooks {my%conf=@_;my$stderr=$conf{stderr};$stderr=1 unless defined$stderr;my$handle=$stderr ? \*STDERR : \*STDOUT;my$use_color=$conf{use_color};$use_color=$ENV{COLOR}unless defined$use_color;$use_color=(-t STDOUT)unless defined$use_color;my$formatter=$conf{formatter};return {create_log_routine=>[__PACKAGE__,50,sub {my%args=@_;my$logger=sub {my$level=$args{level};my$msg=$_[1];if ($formatter){$msg=$formatter->($msg)}hook_before_log({_fh=>$handle },$msg);if ($use_color){print$handle _pick_color($level),$msg,"\e[0m"}else {print$handle $msg}hook_after_log({_fh=>$handle },$msg)};[$logger]}],create_logml_routine=>[__PACKAGE__,50,sub {my%args=@_;my$logger=sub {my$level=Log::ger::Util::numeric_level($_[1]);return if$level > $Log::ger::Current_Level;my$msg=$_[2];if ($formatter){$msg=$formatter->($msg)}hook_before_log({_fh=>$handle },$msg);if ($use_color){print$handle _pick_color($level),$msg,"\e[0m"}else {print$handle $msg}hook_after_log({_fh=>$handle },$msg)};[$logger]}],}}1; +LOG_GER_OUTPUT_SCREEN + +$fatpacked{"Log/ger/Output/String.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_OUTPUT_STRING'; + package Log::ger::Output::String;our$DATE='2017-08-03';our$VERSION='0.023';use strict;use warnings;sub get_hooks {my%conf=@_;$conf{string}or die "Please specify string";my$formatter=$conf{formatter};my$append_newline=$conf{append_newline};$append_newline=1 unless defined$append_newline;return {create_log_routine=>[__PACKAGE__,50,sub {my%args=@_;my$level=$args{level};my$logger=sub {my$msg=$_[1];if ($formatter){$msg=$formatter->($msg)}${$conf{string}}.= $msg;${$conf{string}}.= "\n" unless!$append_newline || $msg =~ /\R\z/};[$logger]}],}}1; +LOG_GER_OUTPUT_STRING + +$fatpacked{"Log/ger/Plugin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_PLUGIN'; + package Log::ger::Plugin;our$DATE='2017-08-03';our$VERSION='0.023';use strict;use warnings;use Log::ger::Util;sub set {my$pkg=shift;my%args;if (ref $_[0]eq 'HASH'){%args=%{shift()}}else {%args=(name=>shift,conf=>{@_})}$args{prefix}||= $pkg .'::';$args{replace_package_regex}=$pkg->_replace_package_regex;Log::ger::Util::set_plugin(%args)}sub set_for_current_package {my$pkg=shift;my%args;if (ref $_[0]eq 'HASH'){%args=%{shift()}}else {%args=(name=>shift,conf=>{@_})}my$caller=caller(0);$args{target}='package';$args{target_arg}=$caller;set($pkg,\%args)}sub _import_sets_for_current_package {0}sub _replace_package_regex {undef}sub import {if (@_ > 1){if ($_[0]->_import_sets_for_current_package){goto&set_for_current_package}else {goto&set}}}1; +LOG_GER_PLUGIN + +$fatpacked{"Log/ger/Plugin/MultilevelLog.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_PLUGIN_MULTILEVELLOG'; + package Log::ger::Plugin::MultilevelLog;our$DATE='2017-08-03';our$VERSION='0.023';use strict;use warnings;use Log::ger::Util;sub get_hooks {my%conf=@_;return {create_routine_names=>[__PACKAGE__,50,sub {return [{logml_subs=>[[$conf{sub_name}|| 'log',undef]],logml_methods=>[[$conf{method_name}|| 'log',undef]],}]},],}}1; +LOG_GER_PLUGIN_MULTILEVELLOG + +$fatpacked{"Log/ger/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOG_GER_UTIL'; + package Log::ger::Util;our$DATE='2017-08-03';our$VERSION='0.023';use strict;use warnings;require Log::ger;require Log::ger::Heavy;sub _dump {unless ($Log::ger::_dumper){eval {no warnings 'once';require Data::Dmp;$Data::Dmp::OPT_REMOVE_PRAGMAS=1;1};if ($@){no warnings 'once';require Data::Dumper;$Log::ger::_dumper=sub {local$Data::Dumper::Terse=1;local$Data::Dumper::Indent=0;local$Data::Dumper::Useqq=1;local$Data::Dumper::Deparse=1;local$Data::Dumper::Quotekeys=0;local$Data::Dumper::Sortkeys=1;local$Data::Dumper::Trailingcomma=1;Data::Dumper::Dumper($_[0])}}else {$Log::ger::_dumper=sub {Data::Dmp::dmp($_[0])}}}$Log::ger::_dumper->($_[0])}sub numeric_level {my$level=shift;return$level if$level =~ /\A\d+\z/;return$Log::ger::Levels{$level}if defined$Log::ger::Levels{$level};return$Log::ger::Level_Aliases{$level}if defined$Log::ger::Level_Aliases{$level};die "Unknown level '$level'"}sub string_level {my$level=shift;return$level if defined$Log::ger::Levels{$level};$level=$Log::ger::Level_Aliases{$level}if defined$Log::ger::Level_Aliases{$level};for (keys%Log::ger::Levels){my$v=$Log::ger::Levels{$_};return $_ if$v==$level}die "Unknown level '$level'"}sub set_level {no warnings 'once';$Log::ger::Current_Level=numeric_level(shift);reinit_all_targets()}sub _action_on_hooks {no warnings 'once';my ($action,$target,$target_arg,$phase)=splice @_,0,4;my$hooks=$Log::ger::Global_Hooks{$phase}or die "Unknown phase '$phase'";if ($target eq 'package'){$hooks=($Log::ger::Per_Package_Hooks{$target_arg}{$phase}||= [])}elsif ($target eq 'object'){my ($addr)=$target_arg =~ $Log::ger::re_addr;$hooks=($Log::ger::Per_Object_Hooks{$addr}{$phase}||= [])}elsif ($target eq 'hash'){my ($addr)=$target_arg =~ $Log::ger::re_addr;$hooks=($Log::ger::Per_Hash_Hooks{$addr}{$phase}||= [])}if ($action eq 'add'){my$hook=shift;unshift @$hooks,$hook}elsif ($action eq 'remove'){my$code=shift;for my$i (reverse 0..$#{$hooks}){splice @$hooks,$i,1 if$code->($hooks->[$i])}}elsif ($action eq 'reset'){my$saved=[@$hooks];splice @$hooks,0,scalar(@$hooks),@{$Log::ger::Default_Hooks{$phase}};return$saved}elsif ($action eq 'empty'){my$saved=[@$hooks];splice @$hooks,0;return$saved}elsif ($action eq 'save'){return [@$hooks]}elsif ($action eq 'restore'){my$saved=shift;splice @$hooks,0,scalar(@$hooks),@$saved;return$saved}}sub add_hook {my ($phase,$hook)=@_;_action_on_hooks('add','',undef,$phase,$hook)}sub add_per_target_hook {my ($target,$target_arg,$phase,$hook)=@_;_action_on_hooks('add',$target,$target_arg,$phase,$hook)}sub remove_hook {my ($phase,$code)=@_;_action_on_hooks('remove','',undef,$phase,$code)}sub remove_per_target_hook {my ($target,$target_arg,$phase,$code)=@_;_action_on_hooks('remove',$target,$target_arg,$phase,$code)}sub reset_hooks {my ($phase)=@_;_action_on_hooks('reset','',undef,$phase)}sub reset_per_target_hooks {my ($target,$target_arg,$phase)=@_;_action_on_hooks('reset',$target,$target_arg,$phase)}sub empty_hooks {my ($phase)=@_;_action_on_hooks('empty','',undef,$phase)}sub empty_per_target_hooks {my ($target,$target_arg,$phase)=@_;_action_on_hooks('empty',$target,$target_arg,$phase)}sub save_hooks {my ($phase)=@_;_action_on_hooks('save','',undef,$phase)}sub save_per_target_hooks {my ($target,$target_arg,$phase)=@_;_action_on_hooks('save',$target,$target_arg,$phase)}sub restore_hooks {my ($phase,$saved)=@_;_action_on_hooks('restore','',undef,$phase,$saved)}sub restore_per_target_hooks {my ($target,$target_arg,$phase,$saved)=@_;_action_on_hooks('restore',$target,$target_arg,$phase,$saved)}sub reinit_target {my ($target,$target_arg)=@_;Log::ger::add_target($target,$target_arg,{},0);if ($target eq 'package'){my$init_args=$Log::ger::Package_Targets{$target_arg};Log::ger::init_target(package=>$target_arg,$init_args)}elsif ($target eq 'object'){my ($obj_addr)=$target_arg =~ $Log::ger::re_addr or die "Invalid object '$target_arg': not a reference";my$v=$Log::ger::Object_Targets{$obj_addr}or die "Unknown object target '$target_arg'";Log::ger::init_target(object=>$v->[0],$v->[1])}elsif ($target eq 'hash'){my ($hash_addr)=$target_arg =~ $Log::ger::re_addr or die "Invalid hashref '$target_arg': not a reference";my$v=$Log::ger::Hash_Targets{$hash_addr}or die "Unknown hash target '$target_arg'";Log::ger::init_target(hash=>$v->[0],$v->[1])}else {die "Unknown target '$target'"}}sub reinit_all_targets {for my$pkg (keys%Log::ger::Package_Targets){Log::ger::init_target(package=>$pkg,$Log::ger::Package_Targets{$pkg})}for my$k (keys%Log::ger::Object_Targets){my ($obj,$init_args)=@{$Log::ger::Object_Targets{$k}};Log::ger::init_target(object=>$obj,$init_args)}for my$k (keys%Log::ger::Hash_Targets){my ($hash,$init_args)=@{$Log::ger::Hash_Targets{$k}};Log::ger::init_target(hash=>$hash,$init_args)}}sub set_plugin {my%args=@_;my$hooks;if ($args{hooks}){$hooks=$args{hooks}}else {no strict 'refs';my$prefix=$args{prefix}|| 'Log::ger::Plugin::';my$mod=$args{name};$mod=$prefix .$mod unless index($mod,$prefix)==0;(my$mod_pm="$mod.pm")=~ s!::!/!g;require$mod_pm;$hooks=&{"$mod\::get_hooks"}(%{$args{conf}|| {}})}{last unless$args{replace_package_regex};my$all_hooks;if (!$args{target}){$all_hooks=\%Log::ger::Global_Hooks}elsif ($args{target}eq 'package'){$all_hooks=$Log::ger::Per_Package_Hooks{$args{target_arg}}}elsif ($args{target}eq 'object'){my ($addr)=$args{target_arg}=~ $Log::ger::re_addr;$all_hooks=$Log::ger::Per_Object_Hooks{$addr}}elsif ($args{target}eq 'hash'){my ($addr)=$args{target_arg}=~ $Log::ger::re_addr;$all_hooks=$Log::ger::Per_Hash_Hooks{$addr}}last unless$all_hooks;for my$phase (keys %$all_hooks){my$hooks=$all_hooks->{$phase};for my$i (reverse 0..$#{$hooks}){splice @$hooks,$i,1 if$hooks->[$i][0]=~ $args{replace_package_regex}}}}for my$phase (keys %$hooks){my$hook=$hooks->{$phase};if (defined$args{target}){add_per_target_hook($args{target},$args{target_arg},$phase,$hook)}else {add_hook($phase,$hook)}}my$reinit=$args{reinit};$reinit=1 unless defined$reinit;if ($reinit){if (defined$args{target}){reinit_target($args{target},$args{target_arg})}else {reinit_all_targets()}}}1; +LOG_GER_UTIL + +$fatpacked{"Path/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_TINY'; + use 5.008001;use strict;use warnings;package Path::Tiny;our$VERSION='0.104';use Config;use Exporter 5.57 (qw/import/);use File::Spec 0.86 ();use Carp ();our@EXPORT=qw/path/;our@EXPORT_OK=qw/cwd rootdir tempfile tempdir/;use constant {PATH=>0,CANON=>1,VOL=>2,DIR=>3,FILE=>4,TEMP=>5,IS_BSD=>(scalar $^O =~ /bsd$/),IS_WIN32=>($^O eq 'MSWin32'),};use overload (q{""}=>sub {$_[0]->[PATH]},bool=>sub () {1},fallback=>1,);sub FREEZE {return $_[0]->[PATH]}sub THAW {return path($_[2])}{no warnings 'once';*TO_JSON=*FREEZE};my$HAS_UU;sub _check_UU {!!eval {require Unicode::UTF8;Unicode::UTF8->VERSION(0.58);1}}my$HAS_PU;sub _check_PU {!!eval {require PerlIO::utf8_strict;PerlIO::utf8_strict->VERSION(0.003);1}}my$HAS_FLOCK=$Config{d_flock}|| $Config{d_fcntl_can_lock}|| $Config{d_lockf};my$SLASH=qr{[\\/]};my$NOTSLASH=qr{[^\\/]};my$DRV_VOL=qr{[a-z]:}i;my$UNC_VOL=qr{$SLASH $SLASH $NOTSLASH+ $SLASH $NOTSLASH+}x;my$WIN32_ROOT=qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x;sub _win32_vol {my ($path,$drv)=@_;require Cwd;my$dcwd=eval {Cwd::getdcwd($drv)};$dcwd="$drv" unless defined$dcwd && length$dcwd;$dcwd =~ s{$SLASH?$}{/};$path =~ s{^$DRV_VOL}{$dcwd};return$path}sub _is_root {return IS_WIN32()? ($_[0]=~ /^$WIN32_ROOT$/): ($_[0]eq '/')}BEGIN {*_same=IS_WIN32()? sub {lc($_[0])eq lc($_[1])}: sub {$_[0]eq $_[1]}}my%MODEBITS=(om=>0007,gm=>0070,um=>0700);{my$m=0;$MODEBITS{$_}=(1 << $m++)for qw/ox ow or gx gw gr ux uw ur/};sub _symbolic_chmod {my ($mode,$symbolic)=@_;for my$clause (split /,\s*/,$symbolic){if ($clause =~ m{\A([augo]+)([=+-])([rwx]+)\z}){my ($who,$action,$perms)=($1,$2,$3);$who =~ s/a/ugo/g;for my$w (split //,$who){my$p=0;$p |= $MODEBITS{"$w$_"}for split //,$perms;if ($action eq '='){$mode=($mode & ~$MODEBITS{"${w}m"})| $p}else {$mode=$action eq "+" ? ($mode | $p): ($mode & ~$p)}}}else {Carp::croak("Invalid mode clause '$clause' for chmod()")}}return$mode}{package flock;use if Path::Tiny::IS_BSD(),'warnings::register'}my$WARNED_BSD_NFS=0;sub _throw {my ($self,$function,$file,$msg)=@_;if (IS_BSD()&& $function =~ /^flock/ && $! =~ /operation not supported/i &&!warnings::fatal_enabled('flock')){if (!$WARNED_BSD_NFS){warnings::warn(flock=>"No flock for NFS on BSD: continuing in unsafe mode");$WARNED_BSD_NFS++}}else {$msg=$! unless defined$msg;Path::Tiny::Error->throw($function,(defined$file ? $file : $self->[PATH]),$msg)}return}sub _get_args {my ($raw,@valid)=@_;if (defined($raw)&& ref($raw)ne 'HASH'){my (undef,undef,undef,$called_as)=caller(1);$called_as =~ s{^.*::}{};Carp::croak("Options for $called_as must be a hash reference")}my$cooked={};for my$k (@valid){$cooked->{$k}=delete$raw->{$k}if exists$raw->{$k}}if (keys %$raw){my (undef,undef,undef,$called_as)=caller(1);$called_as =~ s{^.*::}{};Carp::croak("Invalid option(s) for $called_as: " .join(", ",keys %$raw))}return$cooked}sub path {my$path=shift;Carp::croak("Path::Tiny paths require defined, positive-length parts")unless 1 + @_==grep {defined && length}$path,@_;if (!@_ && ref($path)eq __PACKAGE__ &&!$path->[TEMP]){return$path}$path="$path";if (IS_WIN32()){$path=_win32_vol($path,$1)if$path =~ m{^($DRV_VOL)(?:$NOTSLASH|$)};$path .= "/" if$path =~ m{^$UNC_VOL$}}if (@_){$path .= (_is_root($path)? "" : "/").join("/",@_)}my$cpath=$path=File::Spec->canonpath($path);$path =~ tr[\\][/] if IS_WIN32();$path="/" if$path eq '/..';$path .= "/" if IS_WIN32()&& $path =~ m{^$UNC_VOL$};if (_is_root($path)){$path =~ s{/?$}{/}}else {$path =~ s{/$}{}}if ($path =~ m{^(~[^/]*).*}){require File::Glob;my ($homedir)=File::Glob::bsd_glob($1);$homedir =~ tr[\\][/] if IS_WIN32();$path =~ s{^(~[^/]*)}{$homedir}}bless [$path,$cpath ],__PACKAGE__}sub new {shift;path(@_)}sub cwd {require Cwd;return path(Cwd::getcwd())}sub rootdir {path(File::Spec->rootdir)}sub tempfile {shift if @_ && $_[0]eq 'Path::Tiny';my$opts=(@_ && ref $_[0]eq 'HASH')? shift @_ : {};$opts=_get_args($opts,qw/realpath/);my ($maybe_template,$args)=_parse_file_temp_args(@_);$args->{TEMPLATE}=$maybe_template->[0]if @$maybe_template;require File::Temp;my$temp=File::Temp->new(TMPDIR=>1,%$args);close$temp;my$self=$opts->{realpath}? path($temp)->realpath : path($temp)->absolute;$self->[TEMP]=$temp;return$self}sub tempdir {shift if @_ && $_[0]eq 'Path::Tiny';my$opts=(@_ && ref $_[0]eq 'HASH')? shift @_ : {};$opts=_get_args($opts,qw/realpath/);my ($maybe_template,$args)=_parse_file_temp_args(@_);require File::Temp;my$temp=File::Temp->newdir(@$maybe_template,TMPDIR=>1,%$args);my$self=$opts->{realpath}? path($temp)->realpath : path($temp)->absolute;$self->[TEMP]=$temp;$temp->{REALNAME}=$self->[CANON]if IS_WIN32;return$self}sub _parse_file_temp_args {my$leading_template=(scalar(@_)% 2==1 ? shift(@_): '');my%args=@_;%args=map {uc($_),$args{$_}}keys%args;my@template=(exists$args{TEMPLATE}? delete$args{TEMPLATE}: $leading_template ? $leading_template : ());return (\@template,\%args)}sub _splitpath {my ($self)=@_;@{$self}[VOL,DIR,FILE ]=File::Spec->splitpath($self->[PATH])}sub _resolve_symlinks {my ($self)=@_;my$new=$self;my ($count,%seen)=0;while (-l $new->[PATH]){if ($seen{$new->[PATH]}++){$self->_throw('readlink',$self->[PATH],"symlink loop detected")}if (++$count > 100){$self->_throw('readlink',$self->[PATH],"maximum symlink depth exceeded")}my$resolved=readlink$new->[PATH]or $new->_throw('readlink',$new->[PATH]);$resolved=path($resolved);$new=$resolved->is_absolute ? $resolved : $new->sibling($resolved)}return$new}sub absolute {my ($self,$base)=@_;if (IS_WIN32){return$self if length$self->volume;if ($self->is_absolute){require Cwd;my ($drv)=Win32::GetCwd()=~ /^($DRV_VOL | $UNC_VOL)/x;return path($drv .$self->[PATH])}}else {return$self if$self->is_absolute}require Cwd;return path(Cwd::getcwd(),$_[0]->[PATH])unless defined$base;$base=path($base);return path(($base->is_absolute ? $base : $base->absolute),$_[0]->[PATH])}sub append {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode truncate/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open>'}unless defined$binmode;my$mode=$args->{truncate}? ">" : ">>";my$fh=$self->filehandle({locked=>1 },$mode,$binmode);print {$fh}map {ref eq 'ARRAY' ? @$_ : $_}@data;close$fh or $self->_throw('close')}sub append_raw {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode truncate/);$args->{binmode}=':unix';append($self,$args,@data)}sub append_utf8 {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode truncate/);if (defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU())){$args->{binmode}=":unix";append($self,$args,map {Unicode::UTF8::encode_utf8($_)}@data)}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){$args->{binmode}=":unix:utf8_strict";append($self,$args,@data)}else {$args->{binmode}=":unix:encoding(UTF-8)";append($self,$args,@data)}}sub assert {my ($self,$assertion)=@_;return$self unless$assertion;if (ref$assertion eq 'CODE'){local $_=$self;$assertion->()or Path::Tiny::Error->throw("assert",$self->[PATH],"failed assertion")}else {Carp::croak("argument to assert must be a code reference argument")}return$self}sub basename {my ($self,@suffixes)=@_;$self->_splitpath unless defined$self->[FILE];my$file=$self->[FILE];for my$s (@suffixes){my$re=ref($s)eq 'Regexp' ? qr/$s$/ : qr/\Q$s\E$/;last if$file =~ s/$re//}return$file}sub canonpath {$_[0]->[CANON]}sub cached_temp {my$self=shift;$self->_throw("cached_temp",$self,"has no cached File::Temp object")unless defined$self->[TEMP];return$self->[TEMP]}sub child {my ($self,@parts)=@_;return path($self->[PATH],@parts)}sub children {my ($self,$filter)=@_;my$dh;opendir$dh,$self->[PATH]or $self->_throw('opendir');my@children=readdir$dh;closedir$dh or $self->_throw('closedir');if (not defined$filter){@children=grep {$_ ne '.' && $_ ne '..'}@children}elsif ($filter && ref($filter)eq 'Regexp'){@children=grep {$_ ne '.' && $_ ne '..' && $_ =~ $filter}@children}else {Carp::croak("Invalid argument '$filter' for children()")}return map {path($self->[PATH],$_)}@children}sub chmod {my ($self,$new_mode)=@_;my$mode;if ($new_mode =~ /\d/){$mode=($new_mode =~ /^0/ ? oct($new_mode): $new_mode)}elsif ($new_mode =~ /[=+-]/){$mode=_symbolic_chmod($self->stat->mode & 07777,$new_mode)}else {Carp::croak("Invalid mode argument '$new_mode' for chmod()")}CORE::chmod($mode,$self->[PATH])or $self->_throw("chmod");return 1}sub copy {my ($self,$dest)=@_;require File::Copy;File::Copy::copy($self->[PATH],$dest)or Carp::croak("copy failed for $self to $dest: $!");return -d $dest ? path($dest,$self->basename): path($dest)}sub digest {my ($self,@opts)=@_;my$args=(@opts && ref$opts[0]eq 'HASH')? shift@opts : {};$args=_get_args($args,qw/chunk_size/);unshift@opts,'SHA-256' unless@opts;require Digest;my$digest=Digest->new(@opts);if ($args->{chunk_size}){my$fh=$self->filehandle({locked=>1 },"<",":unix");my$buf;$digest->add($buf)while read$fh,$buf,$args->{chunk_size}}else {$digest->add($self->slurp_raw)}return$digest->hexdigest}sub dirname {my ($self)=@_;$self->_splitpath unless defined$self->[DIR];return length$self->[DIR]? $self->[DIR]: "."}sub edit {my$self=shift;my$cb=shift;my$args=_get_args(shift,qw/binmode/);Carp::croak("Callback for edit() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';local $_=$self->slurp(exists($args->{binmode})? {binmode=>$args->{binmode}}: ());$cb->();$self->spew($args,$_);return}sub edit_utf8 {my ($self,$cb)=@_;Carp::croak("Callback for edit_utf8() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';local $_=$self->slurp_utf8;$cb->();$self->spew_utf8($_);return}sub edit_raw {$_[2]={binmode=>":unix" };goto&edit}sub edit_lines {my$self=shift;my$cb=shift;my$args=_get_args(shift,qw/binmode/);Carp::croak("Callback for edit_lines() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open>'}unless defined$binmode;my$resolved_path=$self->_resolve_symlinks;my$temp=path($resolved_path .$$ .int(rand(2**31)));my$temp_fh=$temp->filehandle({exclusive=>1,locked=>1 },">",$binmode);my$in_fh=$self->filehandle({locked=>1 },'<',$binmode);local $_;while (<$in_fh>){$cb->();$temp_fh->print($_)}close$temp_fh or $self->_throw('close',$temp);close$in_fh or $self->_throw('close');return$temp->move($resolved_path)}sub edit_lines_raw {$_[2]={binmode=>":unix" };goto&edit_lines}sub edit_lines_utf8 {$_[2]={binmode=>":raw:encoding(UTF-8)" };goto&edit_lines}sub exists {-e $_[0]->[PATH]}sub is_file {-e $_[0]->[PATH]&&!-d _}sub is_dir {-d $_[0]->[PATH]}sub filehandle {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked exclusive/);$args->{locked}=1 if$args->{exclusive};my ($opentype,$binmode)=@args;$opentype="<" unless defined$opentype;Carp::croak("Invalid file mode '$opentype'")unless grep {$opentype eq $_}qw/< +< > +> >> +>>/;$binmode=((caller(0))[10]|| {})->{'open' .substr($opentype,-1,1)}unless defined$binmode;$binmode="" unless defined$binmode;my ($fh,$lock,$trunc);if ($HAS_FLOCK && $args->{locked}){require Fcntl;if (grep {$opentype eq $_}qw(> +>)){my$flags=$opentype eq ">" ? Fcntl::O_WRONLY(): Fcntl::O_RDWR();$flags |= Fcntl::O_CREAT();$flags |= Fcntl::O_EXCL()if$args->{exclusive};sysopen($fh,$self->[PATH],$flags)or $self->_throw("sysopen");if ($binmode =~ s/^:unix//){binmode($fh,":raw")or $self->_throw("binmode (:raw)");while (1 < (my$layers=()=PerlIO::get_layers($fh,output=>1))){binmode($fh,":pop")or $self->_throw("binmode (:pop)")}}if (length$binmode){binmode($fh,$binmode)or $self->_throw("binmode ($binmode)")}$lock=Fcntl::LOCK_EX();$trunc=1}elsif ($^O eq 'aix' && $opentype eq "<"){if (-w $self->[PATH]){$opentype="+<";$lock=Fcntl::LOCK_EX()}}else {$lock=$opentype eq "<" ? Fcntl::LOCK_SH(): Fcntl::LOCK_EX()}}unless ($fh){my$mode=$opentype .$binmode;open$fh,$mode,$self->[PATH]or $self->_throw("open ($mode)")}do {flock($fh,$lock)or $self->_throw("flock ($lock)")}if$lock;do {truncate($fh,0)or $self->_throw("truncate")}if$trunc;return$fh}sub is_absolute {substr($_[0]->dirname,0,1)eq '/'}sub is_relative {substr($_[0]->dirname,0,1)ne '/'}sub is_rootdir {my ($self)=@_;$self->_splitpath unless defined$self->[DIR];return$self->[DIR]eq '/' && $self->[FILE]eq ''}sub iterator {my$self=shift;my$args=_get_args(shift,qw/recurse follow_symlinks/);my@dirs=$self;my$current;return sub {my$next;while (@dirs){if (ref$dirs[0]eq 'Path::Tiny'){if (!-r $dirs[0]){shift@dirs and next}$current=$dirs[0];my$dh;opendir($dh,$current->[PATH])or $self->_throw('opendir',$current->[PATH]);$dirs[0]=$dh;if (-l $current->[PATH]&&!$args->{follow_symlinks}){shift@dirs and next}}while (defined($next=readdir$dirs[0])){next if$next eq '.' || $next eq '..';my$path=$current->child($next);push@dirs,$path if$args->{recurse}&& -d $path &&!(!$args->{follow_symlinks}&& -l $path);return$path}shift@dirs}return}}sub lines {my$self=shift;my$args=_get_args(shift,qw/binmode chomp count/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open<'}unless defined$binmode;my$fh=$self->filehandle({locked=>1 },"<",$binmode);my$chomp=$args->{chomp};if ($args->{count}){my ($counter,$mod,@result)=(0,abs($args->{count}));while (my$line=<$fh>){$line =~ s/(?:\x{0d}?\x{0a}|\x{0d})$// if$chomp;$result[$counter++ ]=$line;last if$counter==$args->{count};$counter %= $mod}splice(@result,0,0,splice(@result,$counter))if@result==$mod && $counter % $mod;return@result}elsif ($chomp){return map {s/(?:\x{0d}?\x{0a}|\x{0d})$//;$_}<$fh>}else {return wantarray ? <$fh> : (my$count=()=<$fh>)}}sub lines_raw {my$self=shift;my$args=_get_args(shift,qw/binmode chomp count/);if ($args->{chomp}&&!$args->{count}){return split /\n/,slurp_raw($self)}else {$args->{binmode}=":raw";return lines($self,$args)}}my$CRLF=qr/(?:\x{0d}?\x{0a}|\x{0d})/;sub lines_utf8 {my$self=shift;my$args=_get_args(shift,qw/binmode chomp count/);if ((defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU()))&& $args->{chomp}&&!$args->{count}){my$slurp=slurp_utf8($self);$slurp =~ s/$CRLF$//;return split$CRLF,$slurp,-1}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){$args->{binmode}=":unix:utf8_strict";return lines($self,$args)}else {$args->{binmode}=":raw:encoding(UTF-8)";return lines($self,$args)}}sub mkpath {my ($self,$args)=@_;$args={}unless ref$args eq 'HASH';my$err;$args->{error}=\$err unless defined$args->{error};require File::Path;my@dirs=File::Path::make_path($self->[PATH],$args);if ($err && @$err){my ($file,$message)=%{$err->[0]};Carp::croak("mkpath failed for $file: $message")}return@dirs}sub move {my ($self,$dst)=@_;return rename($self->[PATH],$dst)|| $self->_throw('rename',$self->[PATH]."' -> '$dst")}my%opens=(opena=>">>",openr=>"<",openw=>">",openrw=>"+<");while (my ($k,$v)=each%opens){no strict 'refs';*{$k}=sub {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked/);my ($binmode)=@args;$binmode=((caller(0))[10]|| {})->{'open' .substr($v,-1,1)}unless defined$binmode;$self->filehandle($args,$v,$binmode)};*{$k ."_raw"}=sub {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked/);$self->filehandle($args,$v,":raw")};*{$k ."_utf8"}=sub {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked/);$self->filehandle($args,$v,":raw:encoding(UTF-8)")}}sub parent {my ($self,$level)=@_;$level=1 unless defined$level && $level > 0;$self->_splitpath unless defined$self->[FILE];my$parent;if (length$self->[FILE]){if ($self->[FILE]eq '.' || $self->[FILE]eq ".."){$parent=path($self->[PATH]."/..")}else {$parent=path(_non_empty($self->[VOL].$self->[DIR]))}}elsif (length$self->[DIR]){if ($self->[DIR]=~ m{(?:^\.\./|/\.\./|/\.\.$)}){$parent=path($self->[VOL].$self->[DIR]."/..")}else {(my$dir=$self->[DIR])=~ s{/[^\/]+/$}{/};$parent=path($self->[VOL].$dir)}}else {$parent=path(_non_empty($self->[VOL]))}return$level==1 ? $parent : $parent->parent($level - 1)}sub _non_empty {my ($string)=shift;return ((defined($string)&& length($string))? $string : ".")}sub realpath {my$self=shift;$self=$self->_resolve_symlinks;require Cwd;$self->_splitpath if!defined$self->[FILE];my$check_parent=length$self->[FILE]&& $self->[FILE]ne '.' && $self->[FILE]ne '..';my$realpath=eval {local$SIG{__WARN__}=sub {};Cwd::realpath($check_parent ? $self->parent->[PATH]: $self->[PATH])};$self->_throw("resolving realpath")unless defined$realpath && length$realpath && -e $realpath;return ($check_parent ? path($realpath,$self->[FILE]): path($realpath))}sub relative {my ($self,$base)=@_;$base=path(defined$base && length$base ? $base : '.');$self=$self->absolute if$self->is_relative;$base=$base->absolute if$base->is_relative;$self=$self->absolute if!length$self->volume && length$base->volume;$base=$base->absolute if length$self->volume &&!length$base->volume;if (!_same($self->volume,$base->volume)){Carp::croak("relative() can't cross volumes: '$self' vs '$base'")}return path(".")if _same($self->[PATH],$base->[PATH]);if ($base->subsumes($self)){$base="" if$base->is_rootdir;my$relative="$self";$relative =~ s{\A\Q$base/}{};return path($relative)}my (@common,@self_parts,@base_parts);@base_parts=split /\//,$base->_just_filepath;if ($self->is_rootdir){@common=("");shift@base_parts}else {@self_parts=split /\//,$self->_just_filepath;while (@self_parts && @base_parts && _same($self_parts[0],$base_parts[0])){push@common,shift@base_parts;shift@self_parts}}if (my$new_base=$self->_resolve_between(\@common,\@base_parts)){return$self->relative($new_base)}my@new_path=(("..")x (0+ @base_parts),@self_parts);return path(@new_path)}sub _just_filepath {my$self=shift;my$self_vol=$self->volume;return "$self" if!length$self_vol;(my$self_path="$self")=~ s{\A\Q$self_vol}{};return$self_path}sub _resolve_between {my ($self,$common,$base)=@_;my$path=$self->volume .join("/",@$common);my$changed=0;for my$p (@$base){$path .= "/$p";if ($p eq '..'){$changed=1;if (-e $path){$path=path($path)->realpath->[PATH]}else {$path =~ s{/[^/]+/..$}{/}}}if (-l $path){$changed=1;$path=path($path)->realpath->[PATH]}}return$changed ? path($path): undef}sub remove {my$self=shift;return 0 if!-e $self->[PATH]&&!-l $self->[PATH];return unlink($self->[PATH])|| $self->_throw('unlink')}sub remove_tree {my ($self,$args)=@_;return 0 if!-e $self->[PATH]&&!-l $self->[PATH];$args={}unless ref$args eq 'HASH';my$err;$args->{error}=\$err unless defined$args->{error};$args->{safe}=1 unless defined$args->{safe};require File::Path;my$count=File::Path::remove_tree($self->[PATH],$args);if ($err && @$err){my ($file,$message)=%{$err->[0]};Carp::croak("remove_tree failed for $file: $message")}return$count}sub sibling {my$self=shift;return path($self->parent->[PATH],@_)}sub slurp {my$self=shift;my$args=_get_args(shift,qw/binmode/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open<'}unless defined$binmode;my$fh=$self->filehandle({locked=>1 },"<",$binmode);if ((defined($binmode)? $binmode : "")eq ":unix" and my$size=-s $fh){my$buf;read$fh,$buf,$size;return$buf}else {local $/;return scalar <$fh>}}sub slurp_raw {$_[1]={binmode=>":unix" };goto&slurp}sub slurp_utf8 {if (defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU())){return Unicode::UTF8::decode_utf8(slurp($_[0],{binmode=>":unix" }))}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){$_[1]={binmode=>":unix:utf8_strict" };goto&slurp}else {$_[1]={binmode=>":raw:encoding(UTF-8)" };goto&slurp}}sub spew {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open>'}unless defined$binmode;my$resolved_path=$self->_resolve_symlinks;my$temp=path($resolved_path .$$ .int(rand(2**31)));my$fh=$temp->filehandle({exclusive=>1,locked=>1 },">",$binmode);print {$fh}map {ref eq 'ARRAY' ? @$_ : $_}@data;close$fh or $self->_throw('close',$temp->[PATH]);return$temp->move($resolved_path)}sub spew_raw {splice @_,1,0,{binmode=>":unix" };goto&spew}sub spew_utf8 {if (defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU())){my$self=shift;spew($self,{binmode=>":unix" },map {Unicode::UTF8::encode_utf8($_)}map {ref eq 'ARRAY' ? @$_ : $_}@_)}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){splice @_,1,0,{binmode=>":unix:utf8_strict" };goto&spew}else {splice @_,1,0,{binmode=>":unix:encoding(UTF-8)" };goto&spew}}sub stat {my$self=shift;require File::stat;return File::stat::stat($self->[PATH])|| $self->_throw('stat')}sub lstat {my$self=shift;require File::stat;return File::stat::lstat($self->[PATH])|| $self->_throw('lstat')}sub stringify {$_[0]->[PATH]}sub subsumes {my$self=shift;Carp::croak("subsumes() requires a defined, positive-length argument")unless defined $_[0];my$other=path(shift);if ($self->is_absolute &&!$other->is_absolute){$other=$other->absolute}elsif ($other->is_absolute &&!$self->is_absolute){$self=$self->absolute}if (length$self->volume &&!length$other->volume){$other=$other->absolute}elsif (length$other->volume &&!length$self->volume){$self=$self->absolute}if ($self->[PATH]eq '.'){return!!1}elsif ($self->is_rootdir){return$other->[PATH]=~ m{^\Q$self->[PATH]\E}}else {return$other->[PATH]=~ m{^\Q$self->[PATH]\E(?:/|$)}}}sub touch {my ($self,$epoch)=@_;if (!-e $self->[PATH]){my$fh=$self->openw;close$fh or $self->_throw('close')}if (defined$epoch){utime$epoch,$epoch,$self->[PATH]or $self->_throw("utime ($epoch)")}else {utime undef,undef,$self->[PATH]or $self->_throw("utime ()")}return$self}sub touchpath {my ($self)=@_;my$parent=$self->parent;$parent->mkpath unless$parent->exists;$self->touch}sub visit {my$self=shift;my$cb=shift;my$args=_get_args(shift,qw/recurse follow_symlinks/);Carp::croak("Callback for visit() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';my$next=$self->iterator($args);my$state={};while (my$file=$next->()){local $_=$file;my$r=$cb->($file,$state);last if ref($r)eq 'SCALAR' &&!$$r}return$state}sub volume {my ($self)=@_;$self->_splitpath unless defined$self->[VOL];return$self->[VOL]}package Path::Tiny::Error;our@CARP_NOT=qw/Path::Tiny/;use overload (q{""}=>sub {(shift)->{msg}},fallback=>1);sub throw {my ($class,$op,$file,$err)=@_;chomp(my$trace=Carp::shortmess);my$msg="Error $op on '$file': $err$trace\n";die bless {op=>$op,file=>$file,err=>$err,msg=>$msg },$class}1; +PATH_TINY + +$fatpacked{"Reply/Plugin/TypeTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'REPLY_PLUGIN_TYPETINY'; + package Reply::Plugin::TypeTiny;use strict;use warnings;BEGIN {$Reply::Plugin::TypeTiny::AUTHORITY='cpan:TOBYINK';$Reply::Plugin::TypeTiny::VERSION='1.002001'};require Reply::Plugin;our@ISA='Reply::Plugin';use Scalar::Util qw(blessed);use Term::ANSIColor;sub mangle_error {my$self=shift;my ($err)=@_;if (blessed$err and $err->isa("Error::TypeTiny::Assertion")){my$explain=$err->explain;if ($explain){print color("cyan");print "Error::TypeTiny::Assertion explain:\n";$self->_explanation($explain,"");local $|=1;print "\n";print color("reset")}}return @_}sub _explanation {my$self=shift;my ($ex,$indent)=@_;for my$line (@$ex){if (ref($line)eq q(ARRAY)){print "$indent * Explain:\n";$self->_explanation($line,"$indent ")}else {print "$indent * $line\n"}}}1; +REPLY_PLUGIN_TYPETINY + +$fatpacked{"String/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_SHELLQUOTE'; + package String::ShellQuote;use strict;use vars qw($VERSION @ISA @EXPORT);require Exporter;$VERSION='1.04';@ISA=qw(Exporter);@EXPORT=qw(shell_quote shell_quote_best_effort shell_comment_quote);sub croak {require Carp;goto&Carp::croak}sub _shell_quote_backend {my@in=@_;my@err=();if (0){require RS::Handy;print RS::Handy::data_dump(\@in)}return \@err,'' unless@in;my$ret='';my$saw_non_equal=0;for (@in){if (!defined $_ or $_ eq ''){$_="''";next}if (s/\x00//g){push@err,"No way to quote string containing null (\\000) bytes"}my$escape=0;if (/=/){if (!$saw_non_equal){$escape=1}}else {$saw_non_equal=1}if (m|[^\w!%+,\-./:=@^]|){$escape=1}if ($escape || (!$saw_non_equal && /=/)){s/'/'\\''/g;s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge;$_="'$_'";s/^''//;s/''$//}}continue {$ret .= "$_ "}chop$ret;return \@err,$ret}sub shell_quote {my ($rerr,$s)=_shell_quote_backend @_;if (@$rerr){my%seen;@$rerr=grep {!$seen{$_}++}@$rerr;my$s=join '',map {"shell_quote(): $_\n"}@$rerr;chomp$s;croak$s}return$s}sub shell_quote_best_effort {my ($rerr,$s)=_shell_quote_backend @_;return$s}sub shell_comment_quote {return '' unless @_;unless (@_==1){croak "Too many arguments to shell_comment_quote " ."(got " .@_ ." expected 1)"}local $_=shift;s/\n/\n#/g;return $_}1; +STRING_SHELLQUOTE + +$fatpacked{"Sub/Exporter/Progressive.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_EXPORTER_PROGRESSIVE'; + package Sub::Exporter::Progressive;$Sub::Exporter::Progressive::VERSION='0.001013';use strict;use warnings;sub _croak {require Carp;&Carp::croak}sub import {my ($self,@args)=@_;my$inner_target=caller;my$export_data=sub_export_options($inner_target,@args);my$full_exporter;no strict 'refs';no warnings 'once';@{"${inner_target}::EXPORT_OK"}=@{$export_data->{exports}};@{"${inner_target}::EXPORT"}=@{$export_data->{defaults}};%{"${inner_target}::EXPORT_TAGS"}=%{$export_data->{tags}};*{"${inner_target}::import"}=sub {use strict;my ($self,@args)=@_;if (grep {length ref $_ or $_ !~ / \A [:-]? \w+ \z /xm}@args){_croak 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed' unless eval {require Sub::Exporter};$full_exporter ||= Sub::Exporter::build_exporter($export_data->{original});goto$full_exporter}elsif (defined((my ($num)=grep {m/^\d/}@args)[0])){_croak "cannot export symbols with a leading digit: '$num'"}else {require Exporter;s/ \A - /:/xm for@args;@_=($self,@args);goto \&Exporter::import}};return}my$too_complicated=<<'DEATH';sub sub_export_options {my ($inner_target,$setup,$options)=@_;my@exports;my@defaults;my%tags;if (($setup||'')eq '-setup'){my%options=%$options;OPTIONS: for my$opt (keys%options){if ($opt eq 'exports'){_croak$too_complicated if ref$options{exports}ne 'ARRAY';@exports=@{$options{exports}};_croak$too_complicated if grep {length ref $_}@exports}elsif ($opt eq 'groups'){%tags=%{$options{groups}};for my$tagset (values%tags){_croak$too_complicated if grep {length ref $_ or $_ =~ / \A - (?! all \b ) /x}@{$tagset}}@defaults=@{$tags{default}|| []}}else {_croak$too_complicated}}@{$_}=map {/ \A [:-] all \z /x ? @exports : $_}@{$_}for \@defaults,values%tags;$tags{all}||= [@exports ];my%exports=map {$_=>1}@exports;my@errors=grep {not $exports{$_}}@defaults;_croak join(', ',@errors)." is not exported by the $inner_target module\n" if@errors}return {exports=>\@exports,defaults=>\@defaults,original=>$options,tags=>\%tags,}}1; + You are using Sub::Exporter::Progressive, but the features your program uses from + Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well + just use vanilla Sub::Exporter + DEATH +SUB_EXPORTER_PROGRESSIVE + +$fatpacked{"TOML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TOML'; + package TOML;use 5.008005;use strict;use warnings;use Exporter 'import';our ($VERSION,@EXPORT,@_NAMESPACE,$PARSER);use B;use Carp qw(croak);use TOML::Parser 0.03;$VERSION="0.97";@EXPORT=qw(from_toml to_toml);$PARSER=TOML::Parser->new(inflate_boolean=>sub {$_[0]});sub to_toml {my$stuff=shift;local@_NAMESPACE=();_to_toml($stuff)}sub _to_toml {my ($stuff)=@_;if (ref$stuff eq 'HASH'){my$res='';my@keys=sort keys %$stuff;for my$key (grep {ref$stuff->{$_}ne 'HASH'}@keys){my$val=$stuff->{$key};$res .= "$key = " ._serialize($val)."\n"}for my$key (grep {ref$stuff->{$_}eq 'HASH'}@keys){my$val=$stuff->{$key};local@_NAMESPACE=(@_NAMESPACE,$key);$res .= sprintf("[%s]\n",join(".",@_NAMESPACE));$res .= _to_toml($val)}return$res}else {croak("You cannot convert non-HashRef values to TOML")}}sub _serialize {my$value=shift;my$b_obj=B::svref_2object(\$value);my$flags=$b_obj->FLAGS;return$value if$flags & (B::SVp_IOK | B::SVp_NOK)and!($flags & B::SVp_POK);my$type=ref($value);if (!$type){return string_to_json($value)}elsif ($type eq 'ARRAY'){return sprintf('[%s]',join(", ",map {_serialize($_)}@$value))}elsif ($type eq 'SCALAR'){if (defined $$value){if ($$value eq '0'){return 'false'}elsif ($$value eq '1'){return 'true'}else {croak("cannot encode reference to scalar")}}croak("cannot encode reference to scalar")}croak("Bad type in to_toml: $type")}my%esc=("\n"=>'\n',"\r"=>'\r',"\t"=>'\t',"\f"=>'\f',"\b"=>'\b',"\""=>'\"',"\\"=>'\\\\',"\'"=>'\\\'',);sub string_to_json {my ($arg)=@_;$arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;$arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;return '"' .$arg .'"'}sub from_toml {my$string=shift;local $@;my$toml=eval {$PARSER->parse($string)};return wantarray ? ($toml,$@): $toml}1; +TOML + +$fatpacked{"TOML/Parser.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TOML_PARSER'; + package TOML::Parser;use 5.010000;use strict;use warnings;use Encode;our$VERSION="0.91";use TOML::Parser::Tokenizer qw/:constant/;use TOML::Parser::Tokenizer::Strict;use TOML::Parser::Util qw/unescape_str/;use Types::Serialiser;sub new {my$class=shift;my$args=(@_==1 and ref $_[0]eq 'HASH')? +shift : +{@_ };return bless +{inflate_datetime=>sub {$_[0]},inflate_boolean=>sub {$_[0]eq 'true' ? Types::Serialiser::true : Types::Serialiser::false},strict_mode=>0,%$args,}=>$class}sub parse_file {my ($self,$file)=@_;open my$fh,'<:encoding(utf-8)',$file or die $!;return$self->parse_fh($fh)}sub parse_fh {my ($self,$fh)=@_;my$src=do {local $/;<$fh>};return$self->parse($src)}sub _tokenizer_class {my$self=shift;return$self->{strict_mode}? 'TOML::Parser::Tokenizer::Strict' : 'TOML::Parser::Tokenizer'}our@TOKENS;our$ROOT;our$CONTEXT;sub parse {my ($self,$src)=@_;local$ROOT={};local$CONTEXT=$ROOT;local@TOKENS=$self->_tokenizer_class->tokenize($src);while (my$token=shift@TOKENS){$self->_parse_token($token)}return$ROOT}sub _parse_token {my ($self,$token)=@_;my ($type,$val)=@$token;if ($type eq TOKEN_TABLE){$self->_parse_table($val)}elsif ($type eq TOKEN_ARRAY_OF_TABLE){$self->_parse_array_of_table($val)}elsif (my ($key,$value)=$self->_parse_key_and_value($token)){die "Duplicate key. key:$key" if exists$CONTEXT->{$key};$CONTEXT->{$key}=$value}elsif ($type eq TOKEN_COMMENT){}else {die "Unknown case. type:$type"}}sub _parse_key_and_value {my ($self,$token)=@_;my ($type,$val)=@$token;if ($type eq TOKEN_KEY){my$token=shift@TOKENS;my$key=$val;my$value=$self->_parse_value_token($token);return ($key,$value)}return}sub _parse_table {my ($self,$keys)=@_;my@keys=@$keys;$CONTEXT=$ROOT;for my$k (@keys){if (exists$CONTEXT->{$k}){$CONTEXT=ref$CONTEXT->{$k}eq 'ARRAY' ? $CONTEXT->{$k}->[-1]: ref$CONTEXT->{$k}eq 'HASH' ? $CONTEXT->{$k}: die "invalid structure. @{[ join '.', @keys ]} cannot be `Table`"}else {$CONTEXT=$CONTEXT->{$k}||= +{}}}}sub _parse_array_of_table {my ($self,$keys)=@_;my@keys=@$keys;my$last_key=pop@keys;$CONTEXT=$ROOT;for my$k (@keys){if (exists$CONTEXT->{$k}){$CONTEXT=ref$CONTEXT->{$k}eq 'ARRAY' ? $CONTEXT->{$k}->[-1]: ref$CONTEXT->{$k}eq 'HASH' ? $CONTEXT->{$k}: die "invalid structure. @{[ join '.', @keys ]} cannot be `Array of table`."}else {$CONTEXT=$CONTEXT->{$k}||= +{}}}$CONTEXT->{$last_key}=[]unless exists$CONTEXT->{$last_key};die "invalid structure. @{[ join '.', @keys ]} cannot be `Array of table`" unless ref$CONTEXT->{$last_key}eq 'ARRAY';push @{$CONTEXT->{$last_key}}=>$CONTEXT={}}sub _parse_value_token {my$self=shift;my$token=shift;my ($type,$val,@args)=@$token;if ($type eq TOKEN_COMMENT){return}elsif ($type eq TOKEN_INTEGER || $type eq TOKEN_FLOAT){$val =~ tr/_//d;return 0+$val}elsif ($type eq TOKEN_BOOLEAN){return$self->inflate_boolean($val)}elsif ($type eq TOKEN_DATETIME){return$self->inflate_datetime($val)}elsif ($type eq TOKEN_STRING){my ($is_raw)=@args;return$is_raw ? $val : unescape_str($val)}elsif ($type eq TOKEN_MULTI_LINE_STRING_BEGIN){my ($is_raw)=@args;my$value=$self->_parse_value_token(shift@TOKENS);$value =~ s/\A(?:\r\n|[\r\n])//msg;$value =~ s/\\\s+//msg;if (my$token=shift@TOKENS){my ($type)=@$token;return$value if$type eq TOKEN_MULTI_LINE_STRING_END;die "Unexpected token: $type"}}elsif ($type eq TOKEN_INLINE_TABLE_BEGIN){my%data;while (my$token=shift@TOKENS){last if$token->[0]eq TOKEN_INLINE_TABLE_END;next if$token->[0]eq TOKEN_COMMENT;my ($key,$value)=$self->_parse_key_and_value($token);die "Duplicate key. key:$key" if exists$data{$key};$data{$key}=$value}return \%data}elsif ($type eq TOKEN_ARRAY_BEGIN){my@data;my$last_token;while (my$token=shift@TOKENS){last if$token->[0]eq TOKEN_ARRAY_END;next if$token->[0]eq TOKEN_COMMENT;if ($self->{strict_mode}){die "Unexpected token: $token->[0]" if defined$last_token && $token->[0]ne $last_token->[0]}push@data=>$self->_parse_value_token($token);$last_token=$token}return \@data}die "Unexpected token: $type"}sub inflate_datetime {my$self=shift;return$self->{inflate_datetime}->(@_)}sub inflate_boolean {my$self=shift;return$self->{inflate_boolean}->(@_)}1; +TOML_PARSER + +$fatpacked{"TOML/Parser/Tokenizer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TOML_PARSER_TOKENIZER'; + package TOML::Parser::Tokenizer;use 5.010000;use strict;use warnings;use Exporter 5.57 'import';use constant DEBUG=>$ENV{TOML_PARSER_TOKENIZER_DEBUG}? 1 : 0;BEGIN {my@TOKENS=map uc,qw/comment table array_of_table key integer float boolean datetime string multi_line_string_begin multi_line_string_end inline_table_begin inline_table_end array_begin array_end/;my%CONSTANTS=map {("TOKEN_$_"=>$_)}@TOKENS;require constant;constant->import(\%CONSTANTS);our@EXPORT_OK=keys%CONSTANTS;our%EXPORT_TAGS=(constant=>[keys%CONSTANTS],)};sub grammar_regexp {return +{comment=>qr{#(.*)},table=>{start=>qr{\[},key=>qr{(?:"(.*?)(?<!(?<!\\)\\)"|\'(.*?)(?<!(?<!\\)\\)\'|([^.\s\\\]]+))},sep=>qr{\.},end=>qr{\]},},array_of_table=>{start=>qr{\[\[},key=>qr{(?:"(.*?)(?<!(?<!\\)\\)"|\'(.*?)(?<!(?<!\\)\\)\'|([^.\s\\\]]+))},sep=>qr{\.},end=>qr{\]\]},},key=>qr{(?:"(.*?)(?<!(?<!\\)\\)"|\'(.*?)(?<!(?<!\\)\\)\'|([^\s=]+))\s*=},value=>{datetime=>qr{([0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}(?:\.[0-9]+)?(?:Z|[-+][0-9]{2}:[0-9]{2}))},float=>qr{([-+]?(?:[0-9_]+(?:\.[0-9_]+)?[eE][-+]?[0-9_]+|[0-9_]*\.[0-9_]+))},integer=>qr{([-+]?[0-9_]+)},boolean=>qr{(true|false)},string=>qr{(?:"(.*?)(?<!(?<!\\)\\)"|\'(.*?)(?<!(?<!\\)\\)\')},mlstring=>qr{("""|''')},inline=>{start=>qr{\{},sep=>qr{\s*,\s*},end=>qr{\}},},array=>{start=>qr{\[},sep=>qr{\s*,\s*},end=>qr{\]},},},}}sub tokenize {my ($class,$src)=@_;local $_=$src;return$class->_tokenize()}sub _tokenize {my$class=shift;my$grammar_regexp=$class->grammar_regexp();my@tokens;until (/\G\z/mgco){if (/\G$grammar_regexp->{comment}/mgc){warn "[TOKEN] COMMENT: $1" if DEBUG;$class->_skip_whitespace();push@tokens=>[TOKEN_COMMENT,$1 || '']}elsif (/\G$grammar_regexp->{array_of_table}->{start}/mgc){push@tokens=>$class->_tokenize_array_of_table()}elsif (/\G$grammar_regexp->{table}->{start}/mgc){push@tokens=>$class->_tokenize_table()}elsif (my@t=$class->_tokenize_key_and_value()){push@tokens=>@t}elsif (/\G\s+/mgco){$class->_skip_whitespace()}else {$class->_syntax_error()}}return@tokens}sub _tokenize_key_and_value {my$class=shift;my$grammar_regexp=$class->grammar_regexp();my@tokens;if (/\G$grammar_regexp->{key}/mgc){my$key=$1 || $2 || $3;warn "[TOKEN] KEY: $key" if DEBUG;$class->_skip_whitespace();push@tokens=>[TOKEN_KEY,$key];push@tokens=>$class->_tokenize_value();return@tokens}return}sub _tokenize_value {my$class=shift;my$grammar_regexp=$class->grammar_regexp();warn "[CALL] _tokenize_value" if DEBUG;if (/\G$grammar_regexp->{comment}/mgc){warn "[TOKEN] COMMENT: $1" if DEBUG;$class->_skip_whitespace();return [TOKEN_COMMENT,$1 || '']}elsif (/\G$grammar_regexp->{value}->{datetime}/mgc){warn "[TOKEN] DATETIME: $1" if DEBUG;$class->_skip_whitespace();return [TOKEN_DATETIME,$1]}elsif (/\G$grammar_regexp->{value}->{float}/mgc){warn "[TOKEN] FLOAT: $1" if DEBUG;$class->_skip_whitespace();return [TOKEN_FLOAT,$1]}elsif (/\G$grammar_regexp->{value}->{integer}/mgc){warn "[TOKEN] INTEGER: $1" if DEBUG;$class->_skip_whitespace();return [TOKEN_INTEGER,$1]}elsif (/\G$grammar_regexp->{value}->{boolean}/mgc){warn "[TOKEN] BOOLEAN: $1" if DEBUG;$class->_skip_whitespace();return [TOKEN_BOOLEAN,$1]}elsif (/\G$grammar_regexp->{value}->{mlstring}/mgc){warn "[TOKEN] MULTI LINE STRING: $1" if DEBUG;return ([TOKEN_MULTI_LINE_STRING_BEGIN],$class->_extract_multi_line_string($1),[TOKEN_MULTI_LINE_STRING_END],)}elsif (/\G$grammar_regexp->{value}->{string}/mgc){warn "[TOKEN] STRING: $1" if DEBUG;$class->_skip_whitespace();my$is_raw=defined $2;return [TOKEN_STRING,defined $1 ? $1 : defined $2 ? $2 : '',$is_raw]}elsif (/\G$grammar_regexp->{value}->{inline}->{start}/mgc){warn "[TOKEN] INLINE TABLE" if DEBUG;$class->_skip_whitespace();return ([TOKEN_INLINE_TABLE_BEGIN],$class->_tokenize_inline_table(),[TOKEN_INLINE_TABLE_END],)}elsif (/\G$grammar_regexp->{value}->{array}->{start}/mgc){warn "[TOKEN] ARRAY" if DEBUG;$class->_skip_whitespace();return ([TOKEN_ARRAY_BEGIN],$class->_tokenize_array(),[TOKEN_ARRAY_END],)}$class->_syntax_error()}sub _tokenize_table {my$class=shift;my$grammar_regexp=$class->grammar_regexp()->{table};warn "[CALL] _tokenize_table" if DEBUG;$class->_skip_whitespace();my@expected=($grammar_regexp->{key});my@keys;LOOP: while (1){for my$rx (@expected){if (/\G$rx/smgc){if ($rx eq $grammar_regexp->{key}){my$key=$1 || $2 || $3;warn "[TOKEN] table key: $key" if DEBUG;push@keys=>$key;@expected=($grammar_regexp->{sep},$grammar_regexp->{end})}elsif ($rx eq $grammar_regexp->{sep}){warn "[TOKEN] table key separator" if DEBUG;@expected=($grammar_regexp->{key})}elsif ($rx eq $grammar_regexp->{end}){warn "[TOKEN] table key end" if DEBUG;@expected=();last LOOP}$class->_skip_whitespace();next LOOP}}$class->_syntax_error()}warn "[TOKEN] TABLE: @{[ join '.', @keys ]}" if DEBUG;return [TOKEN_TABLE,\@keys]}sub _tokenize_array_of_table {my$class=shift;my$grammar_regexp=$class->grammar_regexp()->{array_of_table};warn "[CALL] _tokenize_array_of_table" if DEBUG;$class->_skip_whitespace();my@expected=($grammar_regexp->{key});my@keys;LOOP: while (1){for my$rx (@expected){if (/\G$rx/smgc){if ($rx eq $grammar_regexp->{key}){my$key=$1 || $2 || $3;warn "[TOKEN] table key: $key" if DEBUG;push@keys=>$key;@expected=($grammar_regexp->{sep},$grammar_regexp->{end})}elsif ($rx eq $grammar_regexp->{sep}){warn "[TOKEN] table key separator" if DEBUG;@expected=($grammar_regexp->{key})}elsif ($rx eq $grammar_regexp->{end}){warn "[TOKEN] table key end" if DEBUG;@expected=();last LOOP}$class->_skip_whitespace();next LOOP}}$class->_syntax_error()}warn "[TOKEN] ARRAY_OF_TABLE: @{[ join '.', @keys ]}" if DEBUG;return [TOKEN_ARRAY_OF_TABLE,\@keys]}sub _extract_multi_line_string {my ($class,$delimiter)=@_;my$is_raw=$delimiter eq q{'''};if (/\G(.+?)\Q$delimiter/smgc){warn "[TOKEN] MULTI LINE STRING: $1" if DEBUG;$class->_skip_whitespace();return [TOKEN_STRING,$1,$is_raw]}$class->_syntax_error()}sub _tokenize_inline_table {my$class=shift;my$common_grammar_regexp=$class->grammar_regexp();my$grammar_regexp=$common_grammar_regexp->{value}->{inline};warn "[CALL] _tokenize_inline_table" if DEBUG;return if /\G(?:$grammar_regexp->{sep})?$grammar_regexp->{end}/smgc;my$need_sep=0;my@tokens;while (1){warn "[CONTEXT] _tokenize_inline_table [loop]" if DEBUG;$class->_skip_whitespace();if (/\G$common_grammar_regexp->{comment}/mgc){warn "[TOKEN] COMMENT: $1" if DEBUG;push@tokens=>[TOKEN_COMMENT,$1 || ''];next}elsif (/\G$grammar_regexp->{end}/mgc){last}if ($need_sep){if (/\G$grammar_regexp->{sep}/smgc){$need_sep=0;next}}else {if (my@t=$class->_tokenize_key_and_value()){push@tokens=>@t;$need_sep=1;next}}$class->_syntax_error()}return@tokens}sub _tokenize_array {my$class=shift;my$common_grammar_regexp=$class->grammar_regexp();my$grammar_regexp=$common_grammar_regexp->{value}->{array};warn "[CALL] _tokenize_array" if DEBUG;return if /\G(?:$grammar_regexp->{sep})?$grammar_regexp->{end}/smgc;my$need_sep=0;my@tokens;while (1){warn "[CONTEXT] _tokenize_inline_table [loop]" if DEBUG;$class->_skip_whitespace();if (/\G$common_grammar_regexp->{comment}/mgc){warn "[TOKEN] COMMENT: $1" if DEBUG;push@tokens=>[TOKEN_COMMENT,$1 || ''];next}elsif (/\G$grammar_regexp->{end}/mgc){last}if ($need_sep){if (/\G$grammar_regexp->{sep}/smgc){$need_sep=0;next}}else {if (my@t=$class->_tokenize_value()){push@tokens=>@t;$need_sep=1;next}}$class->_syntax_error()}return@tokens}sub _skip_whitespace {my$class=shift;if (/\G\s+/smgco){warn "[PASS] WHITESPACE" if DEBUG}}sub _syntax_error {shift->_error('Syntax Error')}sub _error {my ($class,$msg)=@_;my$src=$_;my$curr=pos || 0;my$line=1;my$start=pos$src || 0;while ($src =~ /$/smgco and pos$src <= $curr){$start=pos$src;$line++}my$end=pos$src;my$len=$curr - $start;$len-- if$len > 0;my$trace=join "\n","${msg}: line:$line",substr($src,$start || 0,$end - $start),(' ' x $len).'^';die$trace,"\n"}1; +TOML_PARSER_TOKENIZER + +$fatpacked{"TOML/Parser/Tokenizer/Strict.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TOML_PARSER_TOKENIZER_STRICT'; + package TOML::Parser::Tokenizer::Strict;use 5.010000;use strict;use warnings;use parent qw/TOML::Parser::Tokenizer/;BEGIN {import TOML::Parser::Tokenizer qw/:constant/}sub grammar_regexp {my$grammar_regexp={%{shift->SUPER::grammar_regexp()}};$grammar_regexp->{table}={%{$grammar_regexp->{table}}};$grammar_regexp->{array_of_table}={%{$grammar_regexp->{array_of_table}}};$grammar_regexp->{table}->{key}=qr{(?:"(.*?)(?<!(?<!\\)\\)"|([A-Za-z0-9_-]+))};$grammar_regexp->{array_of_table}->{key}=qr{(?:"(.*?)(?<!(?<!\\)\\)"|([A-Za-z0-9_-]+))};$grammar_regexp->{key}=qr{(?:"(.*?)(?<!(?<!\\)\\)"|([A-Za-z0-9_-]+))\s*=};return$grammar_regexp}1; +TOML_PARSER_TOKENIZER_STRICT + +$fatpacked{"TOML/Parser/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TOML_PARSER_UTIL'; + package TOML::Parser::Util;use 5.008005;use strict;use warnings;use Exporter 5.57 'import';our@EXPORT_OK=qw/unescape_str/;sub unescape_str {my$str=shift;$str =~ s!\\b !\x08!xmgo;$str =~ s!\\t !\x09!xmgo;$str =~ s!\\n !\x0A!xmgo;$str =~ s!\\f !\x0C!xmgo;$str =~ s!\\r !\x0D!xmgo;$str =~ s!\\" !\x22!xmgo;$str =~ s!\\/ !\x2F!xmgo;$str =~ s!\\\\!\x5C!xmgo;$str =~ s{\\u([0-9A-Fa-f]{4})}{# unicode (U+XXXX) + chr hex $1 + }xmgeo;$str =~ s{\\U([0-9A-Fa-f]{8})}{# unicode (U+XXXXXXXX) + chr hex $1 + }xmgeo;return$str}1; +TOML_PARSER_UTIL + +$fatpacked{"Test/TypeTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_TYPETINY'; + package Test::TypeTiny;use strict;use warnings;use Test::More qw();use Scalar::Util qw(blessed);use Types::TypeTiny qw(to_TypeTiny);require Exporter::Tiny;our@ISA='Exporter::Tiny';BEGIN {*EXTENDED_TESTING=$ENV{EXTENDED_TESTING}? sub(){!!1}: sub(){!!0}};our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.002001';our@EXPORT=qw(should_pass should_fail ok_subtype);our@EXPORT_OK=qw(EXTENDED_TESTING matchfor);sub matchfor {my@matchers=@_;bless \@matchers,do {package Test::TypeTiny::Internal::MATCHFOR;use overload q[==]=>'match',q[eq]=>'match',q[""]=>'to_string',fallback=>1;sub to_string {$_[0][0]}sub match {my ($self,$e)=@_;my$does=Scalar::Util::blessed($e)? ($e->can('DOES')|| $e->can('isa')): undef;for my$s (@$self){return 1 if ref($s)&& $e =~ $s;return 1 if!ref($s)&& $does && $e->$does($s)}return}__PACKAGE__}}sub _mk_message {require Type::Tiny;my ($template,$value)=@_;sprintf($template,Type::Tiny::_dd($value))}sub ok_subtype {my ($type,@s)=@_;@_=(not(scalar grep!$_->is_subtype_of($type),@s),sprintf("%s subtype: %s",$type,join q[, ],@s),);goto \&Test::More::ok}eval(EXTENDED_TESTING ? <<'SLOW' : <<'FAST');1; + + sub should_pass + { + my ($value, $type, $message) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + $type = to_TypeTiny($type) unless blessed($type) && $type->can("check"); + + my $strictures = $type->can("_strict_check"); + + my $test = "Test::Builder"->new->child( + $message || _mk_message("%s passes type constraint $type", $value), + ); + $test->plan(tests => ($strictures ? 2 : 1)); + $test->ok(!!$type->check($value), '->check'); + $test->ok(!!$type->_strict_check($value), '->_strict_check') if $strictures; + $test->finalize; + return $test->is_passing; + } + + sub should_fail + { + my ($value, $type, $message) = @_; + $type = to_TypeTiny($type) unless blessed($type) && $type->can("check"); + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my $strictures = $type->can("_strict_check"); + + my $test = "Test::Builder"->new->child( + $message || _mk_message("%s fails type constraint $type", $value), + ); + $test->plan(tests => ($strictures ? 2 : 1)); + $test->ok(!$type->check($value), '->check'); + $test->ok(!$type->_strict_check($value), '->_strict_check') if $strictures; + $test->finalize; + return $test->is_passing; + } + + SLOW + + sub should_pass + { + my ($value, $type, $message) = @_; + $type = to_TypeTiny($type) unless blessed($type) && $type->can("check"); + @_ = ( + !!$type->check($value), + $message || _mk_message("%s passes type constraint $type", $value), + ); + goto \&Test::More::ok; + } + + sub should_fail + { + my ($value, $type, $message) = @_; + $type = to_TypeTiny($type) unless blessed($type) && $type->can("check"); + @_ = ( + !$type->check($value), + $message || _mk_message("%s fails type constraint $type", $value), + ); + goto \&Test::More::ok; + } + + FAST +TEST_TYPETINY + +$fatpacked{"Text/Diff.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_DIFF'; + package Text::Diff;use 5.006;use strict;use warnings;use Carp qw/croak confess/;use Exporter ();use Algorithm::Diff ();our$VERSION='1.45';our@ISA=qw/Exporter/;our@EXPORT=qw/diff/;use constant A=>0;use constant B=>1;use constant OPCODE=>2;use constant FLAG=>3;my%internal_styles=(Unified=>undef,Context=>undef,OldStyle=>undef,Table=>undef,);sub diff {my@seqs=(shift,shift);my$options=shift || {};for my$i (0 .. 1){my$seq=$seqs[$i];my$type=ref$seq;while ($type eq "CODE"){$seqs[$i]=$seq=$seq->($options);$type=ref$seq}my$AorB=!$i ? "A" : "B";if ($type eq "ARRAY"){$options->{"OFFSET_$AorB"}=0 unless defined$options->{"OFFSET_$AorB"}}elsif ($type eq "SCALAR"){$seqs[$i]=[split(/^/m,$$seq)];$options->{"OFFSET_$AorB"}=1 unless defined$options->{"OFFSET_$AorB"}}elsif (!$type){$options->{"OFFSET_$AorB"}=1 unless defined$options->{"OFFSET_$AorB"};$options->{"FILENAME_$AorB"}=$seq unless defined$options->{"FILENAME_$AorB"};$options->{"MTIME_$AorB"}=(stat($seq))[9]unless defined$options->{"MTIME_$AorB"};local $/="\n";open F,"<$seq" or croak "$!: $seq";$seqs[$i]=[<F>];close F}elsif ($type eq "GLOB" || UNIVERSAL::isa($seq,"IO::Handle")){$options->{"OFFSET_$AorB"}=1 unless defined$options->{"OFFSET_$AorB"};local $/="\n";$seqs[$i]=[<$seq>]}else {confess "Can't handle input of type ",ref}}my$output;my$output_handler=$options->{OUTPUT};my$type=ref$output_handler ;if (!defined$output_handler){$output="";$output_handler=sub {$output .= shift}}elsif ($type eq "CODE"){}elsif ($type eq "SCALAR"){my$out_ref=$output_handler;$output_handler=sub {$$out_ref .= shift}}elsif ($type eq "ARRAY"){my$out_ref=$output_handler;$output_handler=sub {push @$out_ref,shift}}elsif ($type eq "GLOB" || UNIVERSAL::isa$output_handler,"IO::Handle"){my$output_handle=$output_handler;$output_handler=sub {print$output_handle shift}}else {croak "Unrecognized output type: $type"}my$style=$options->{STYLE};$style="Unified" unless defined$options->{STYLE};$style="Text::Diff::$style" if exists$internal_styles{$style};if (!$style->can("hunk")){eval "require $style; 1" or die $@}$style=$style->new if!ref$style && $style->can("new");my$ctx_lines=$options->{CONTEXT};$ctx_lines=3 unless defined$ctx_lines;$ctx_lines=0 if$style->isa("Text::Diff::OldStyle");my@keygen_args=$options->{KEYGEN_ARGS}? @{$options->{KEYGEN_ARGS}}: ();my$diffs=0;my$ctx=0;my@ops;my$hunks=0;my$emit_ops=sub {$output_handler->($style->file_header(@seqs,$options))unless$hunks++;$output_handler->($style->hunk_header(@seqs,@_,$options));$output_handler->($style->hunk (@seqs,@_,$options));$output_handler->($style->hunk_footer(@seqs,@_,$options))};my$dis_a=sub {push@ops,[@_[0,1],"-"];++$diffs ;$ctx=0};my$dis_b=sub {push@ops,[@_[0,1],"+"];++$diffs ;$ctx=0};Algorithm::Diff::traverse_sequences(@seqs,{MATCH=>sub {push@ops,[@_[0,1]," "];if ($diffs && ++$ctx > $ctx_lines * 2){$emit_ops->([splice@ops,0,$#ops - $ctx_lines ]);$ctx=$diffs=0}shift@ops if!$diffs && @ops > $ctx_lines},DISCARD_A=>$dis_a,DISCARD_B=>$dis_b,},$options->{KEYGEN},@keygen_args,);if ($diffs){$#ops -= $ctx - $ctx_lines if$ctx > $ctx_lines;$emit_ops->(\@ops)}$output_handler->($style->file_footer(@seqs,$options))if$hunks;return defined$output ? $output : $hunks}sub _header {my ($h)=@_;my ($p1,$fn1,$t1,$p2,$fn2,$t2)=@{$h}{"FILENAME_PREFIX_A","FILENAME_A","MTIME_A","FILENAME_PREFIX_B","FILENAME_B","MTIME_B" };return "" unless defined$fn1 && defined$fn2;return join("",$p1," ",$fn1,defined$t1 ? "\t" .localtime$t1 : (),"\n",$p2," ",$fn2,defined$t2 ? "\t" .localtime$t2 : (),"\n",)}sub _range {my ($ops,$a_or_b,$format)=@_;my$start=$ops->[0]->[$a_or_b];my$after=$ops->[-1]->[$a_or_b];++$after unless$ops->[-1]->[OPCODE]eq ($a_or_b==A ? "+" : "-");my$empty_range=$start==$after;++$start unless$empty_range;return $start==$after ? $format eq "unified" && $empty_range ? "$start,0" : $start : $format eq "unified" ? "$start,".($after-$start+1): "$start,$after"}sub _op_to_line {my ($seqs,$op,$a_or_b,$op_prefixes)=@_;my$opcode=$op->[OPCODE];return ()unless defined$op_prefixes->{$opcode};my$op_sym=defined$op->[FLAG]? $op->[FLAG]: $opcode;$op_sym=$op_prefixes->{$op_sym};return ()unless defined$op_sym;$a_or_b=$op->[OPCODE]ne "+" ? 0 : 1 unless defined$a_or_b;my@line=($op_sym,$seqs->[$a_or_b][$op->[$a_or_b]]);unless ($line[1]=~ /(?:\n|\r\n)$/){$line[1].= "\n\\ No newline at end of file\n"}return@line}SCOPE: {package Text::Diff::Base;sub new {my$proto=shift;return bless {@_ },ref$proto || $proto}sub file_header {return ""}sub hunk_header {return ""}sub hunk {return ""}sub hunk_footer {return ""}sub file_footer {return ""}}@Text::Diff::Unified::ISA=qw(Text::Diff::Base);sub Text::Diff::Unified::file_header {shift;my$options=pop ;_header({FILENAME_PREFIX_A=>"---",FILENAME_PREFIX_B=>"+++",%$options })}sub Text::Diff::Unified::hunk_header {shift;pop;my$ops=pop;return join("","@@ -",_range($ops,A,"unified")," +",_range($ops,B,"unified")," @@\n",)}sub Text::Diff::Unified::hunk {shift;pop;my$ops=pop;my$prefixes={"+"=>"+"," "=>" ","-"=>"-" };return join "",map _op_to_line(\@_,$_,undef,$prefixes),@$ops}@Text::Diff::Context::ISA=qw(Text::Diff::Base);sub Text::Diff::Context::file_header {_header {FILENAME_PREFIX_A=>"***",FILENAME_PREFIX_B=>"---",%{$_[-1]}}}sub Text::Diff::Context::hunk_header {return "***************\n"}sub Text::Diff::Context::hunk {shift;pop;my$ops=pop;my$a_range=_range($ops,A,"");my$b_range=_range($ops,B,"");my$after;for (my$start=0;$start <= $#$ops ;$start=$after ){$after=$start + 1;my$opcode=$ops->[$start]->[OPCODE];next if$opcode eq " ";my$bang_it;while ($after <= $#$ops && $ops->[$after]->[OPCODE]ne " "){$bang_it ||= $ops->[$after]->[OPCODE]ne $opcode;++$after}if ($bang_it){for my$i ($start..($after-1)){$ops->[$i]->[FLAG]="!"}}}my$b_prefixes={"+"=>"+ "," "=>" ","-"=>undef,"!"=>"! " };my$a_prefixes={"+"=>undef," "=>" ","-"=>"- ","!"=>"! " };return join("","*** ",$a_range," ****\n",map(_op_to_line(\@_,$_,A,$a_prefixes),@$ops),"--- ",$b_range," ----\n",map(_op_to_line(\@_,$_,B,$b_prefixes),@$ops),)}@Text::Diff::OldStyle::ISA=qw(Text::Diff::Base);sub _op {my$ops=shift;my$op=$ops->[0]->[OPCODE];$op="c" if grep $_->[OPCODE]ne $op,@$ops;$op="a" if$op eq "+";$op="d" if$op eq "-";return$op}sub Text::Diff::OldStyle::hunk_header {shift;pop;my$ops=pop;my$op=_op$ops;return join "",_range($ops,A,""),$op,_range($ops,B,""),"\n"}sub Text::Diff::OldStyle::hunk {shift;pop;my$ops=pop;my$a_prefixes={"+"=>undef," "=>undef,"-"=>"< " };my$b_prefixes={"+"=>"> "," "=>undef,"-"=>undef };my$op=_op$ops;return join("",map(_op_to_line(\@_,$_,A,$a_prefixes),@$ops),$op eq "c" ? "---\n" : (),map(_op_to_line(\@_,$_,B,$b_prefixes),@$ops),)}1; +TEXT_DIFF + +$fatpacked{"Text/Diff/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_DIFF_CONFIG'; + package Text::Diff::Config;use 5.006;use strict;use warnings;our$VERSION='1.44';our$Output_Unicode;BEGIN {$Output_Unicode=$ENV{'DIFF_OUTPUT_UNICODE'}}1; +TEXT_DIFF_CONFIG + +$fatpacked{"Text/Diff/Table.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_DIFF_TABLE'; + package Text::Diff::Table;use 5.006;use strict;use warnings;use Carp;use Text::Diff::Config;our$VERSION='1.44';our@ISA=qw(Text::Diff::Base Exporter);our@EXPORT_OK=qw(expand_tabs);my%escapes=map {my$c=$_ eq '"' || $_ eq '$' ? qq{'$_'} : $_ eq "\\" ? qq{"\\\\"} : qq{"$_"};(ord eval$c=>$_)}(map(chr,32..126),map(sprintf("\\x%02x",$_),(0..31,127..255)),"\\t","\\n","\\r","\\f","\\b","\\a","\\e");sub expand_tabs($) {my$s=shift;my$count=0;$s =~ s{(\t)(\t*)|([^\t]+)}{ + if ( $1 ) { + my $spaces = " " x ( 8 - $count % 8 + 8 * length $2 ); + $count = 0; + $spaces; + } + else { + $count += length $3; + $3; + } + }ge;return$s}sub trim_trailing_line_ends($) {my$s=shift;$s =~ s/[\r\n]+(?!\n)$//;return$s}sub escape($);SCOPE: {my$escaper=<<'EOCODE';unless (eval$escaper){$escaper =~ s/ *use *utf8 *;\n// or die "Can't drop use utf8;";eval$escaper or die $@}}sub new {my$proto=shift;return bless {@_ },$proto}my$missing_elt=["","" ];sub hunk {my$self=shift;my@seqs=(shift,shift);my$ops=shift;my$options=shift;my (@A,@B);for (@$ops){my$opcode=$_->[Text::Diff::OPCODE()];if ($opcode eq " "){push@A,$missing_elt while@A < @B;push@B,$missing_elt while@B < @A}push@A,[$_->[0]+ ($options->{OFFSET_A}|| 0),$seqs[0][$_->[0]]]if$opcode eq " " || $opcode eq "-";push@B,[$_->[1]+ ($options->{OFFSET_B}|| 0),$seqs[1][$_->[1]]]if$opcode eq " " || $opcode eq "+"}push@A,$missing_elt while@A < @B;push@B,$missing_elt while@B < @A;my@elts;for (0..$#A){my ($A,$B)=(shift@A,shift@B);my$elt_type=$B==$missing_elt ? "A" : $A==$missing_elt ? "B" : $A->[1]eq $B->[1]? "=" : "*";if ($elt_type ne "*"){if ($elt_type eq "=" || $A->[1]=~ /\S/ || $B->[1]=~ /\S/){$A->[1]=escape trim_trailing_line_ends expand_tabs$A->[1];$B->[1]=escape trim_trailing_line_ends expand_tabs$B->[1]}else {$A->[1]=escape$A->[1];$B->[1]=escape$B->[1]}}else {$A->[1]=~ /^(\s*?)([^ \t].*?)?(\s*)(?![\n\r])$/s;my ($l_ws_A,$body_A,$t_ws_A)=($1,$2,$3);$body_A="" unless defined$body_A;$B->[1]=~ /^(\s*?)([^ \t].*?)?(\s*)(?![\n\r])$/s;my ($l_ws_B,$body_B,$t_ws_B)=($1,$2,$3);$body_B="" unless defined$body_B;my$added_escapes;if ($l_ws_A ne $l_ws_B){$added_escapes=1 if$l_ws_A =~ s/\t/\\t/g;$added_escapes=1 if$l_ws_B =~ s/\t/\\t/g}if ($t_ws_A ne $t_ws_B){$added_escapes=1 if$t_ws_A =~ s/ /\\s/g;$added_escapes=1 if$t_ws_B =~ s/ /\\s/g;$added_escapes=1 if$t_ws_A =~ s/\t/\\t/g;$added_escapes=1 if$t_ws_B =~ s/\t/\\t/g}else {$t_ws_A=$t_ws_B=""}my$do_tab_escape=$added_escapes || do {my$expanded_A=expand_tabs join($body_A,$l_ws_A,$t_ws_A);my$expanded_B=expand_tabs join($body_B,$l_ws_B,$t_ws_B);$expanded_A eq $expanded_B};my$do_back_escape=$do_tab_escape || do {my ($unescaped_A,$escaped_A,$unescaped_B,$escaped_B)=map join("",/(\\.)/g),map {($_,escape $_)}expand_tabs join($body_A,$l_ws_A,$t_ws_A),expand_tabs join($body_B,$l_ws_B,$t_ws_B);$unescaped_A ne $unescaped_B && $escaped_A eq $escaped_B};if ($do_back_escape){$body_A =~ s/\\/\\\\/g;$body_B =~ s/\\/\\\\/g}my$line_A=join$body_A,$l_ws_A,$t_ws_A;my$line_B=join$body_B,$l_ws_B,$t_ws_B;unless ($do_tab_escape){$line_A=expand_tabs$line_A;$line_B=expand_tabs$line_B}$A->[1]=escape$line_A;$B->[1]=escape$line_B}push@elts,[@$A,@$B,$elt_type ]}push @{$self->{ELTS}},@elts,["bar"];return ""}sub _glean_formats {my$self=shift}sub file_footer {my$self=shift;my@seqs=(shift,shift);my$options=pop;my@heading_lines;if (defined$options->{FILENAME_A}|| defined$options->{FILENAME_B}){push@heading_lines,[map({("",escape(defined $_ ? $_ : "<undef>"))}(@{$options}{qw(FILENAME_A FILENAME_B)})),"=",]}if (defined$options->{MTIME_A}|| defined$options->{MTIME_B}){push@heading_lines,[map({("",escape((defined $_ && length $_)? localtime $_ : ""))}@{$options}{qw(MTIME_A MTIME_B)}),"=",]}if (defined$options->{INDEX_LABEL}){push@heading_lines,["","","","","=" ]unless@heading_lines;$heading_lines[-1]->[0]=$heading_lines[-1]->[2]=$options->{INDEX_LABEL}}my$four_column_mode=0;for my$cols (@heading_lines,@{$self->{ELTS}}){next if$cols->[-1]eq "bar";if ($cols->[0]ne $cols->[2]){$four_column_mode=1;last}}unless ($four_column_mode){for my$cols (@heading_lines,@{$self->{ELTS}}){next if$cols->[-1]eq "bar";splice @$cols,2,1}}my@w=(0,0,0,0);for my$cols (@heading_lines,@{$self->{ELTS}}){next if$cols->[-1]eq "bar";for my$i (0..($#$cols-1)){$w[$i]=length$cols->[$i]if defined$cols->[$i]&& length$cols->[$i]> $w[$i]}}my%fmts=$four_column_mode ? ("="=>"| %$w[0]s|%-$w[1]s | %$w[2]s|%-$w[3]s |\n","A"=>"* %$w[0]s|%-$w[1]s * %$w[2]s|%-$w[3]s |\n","B"=>"| %$w[0]s|%-$w[1]s * %$w[2]s|%-$w[3]s *\n","*"=>"* %$w[0]s|%-$w[1]s * %$w[2]s|%-$w[3]s *\n",): ("="=>"| %$w[0]s|%-$w[1]s |%-$w[2]s |\n","A"=>"* %$w[0]s|%-$w[1]s |%-$w[2]s |\n","B"=>"| %$w[0]s|%-$w[1]s |%-$w[2]s *\n","*"=>"* %$w[0]s|%-$w[1]s |%-$w[2]s *\n",);my@args=('','','');push(@args,'')if$four_column_mode;$fmts{bar}=sprintf$fmts{"="},@args;$fmts{bar}=~ s/\S/+/g;$fmts{bar}=~ s/ /-/g;no warnings;return join("",map {sprintf($fmts{$_->[-1]},@$_)}(["bar"],@heading_lines,@heading_lines ? ["bar"]: (),@{$self->{ELTS}},),);@{$self->{ELTS}}=[]}1; + sub escape($) { + use utf8; + join "", map { + my $c = $_; + $_ = ord; + exists $escapes{$_} + ? $escapes{$_} + : $Text::Diff::Config::Output_Unicode + ? $c + : sprintf( "\\x{%04x}", $_ ); + } split //, shift; + } + + 1; + EOCODE +TEXT_DIFF_TABLE + +$fatpacked{"Text/Template.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TEMPLATE'; + package Text::Template;$Text::Template::VERSION='1.47';require 5.004;use Exporter;@ISA=qw(Exporter);@EXPORT_OK=qw(fill_in_file fill_in_string TTerror);use vars '$ERROR';use strict;my%GLOBAL_PREPEND=('Text::Template'=>'');sub Version {$Text::Template::VERSION}sub _param {my$kk;my ($k,%h)=@_;for$kk ($k,"\u$k","\U$k","-$k","-\u$k","-\U$k"){return$h{$kk}if exists$h{$kk}}return}sub always_prepend {my$pack=shift;my$old=$GLOBAL_PREPEND{$pack};$GLOBAL_PREPEND{$pack}=shift;$old}{my%LEGAL_TYPE;BEGIN {%LEGAL_TYPE=map {$_=>1}qw(FILE FILEHANDLE STRING ARRAY)}sub new {my$pack=shift;my%a=@_;my$stype=uc(_param('type',%a)|| "FILE");my$source=_param('source',%a);my$untaint=_param('untaint',%a);my$prepend=_param('prepend',%a);my$alt_delim=_param('delimiters',%a);my$broken=_param('broken',%a);unless (defined$source){require Carp;Carp::croak("Usage: $ {pack}::new(TYPE => ..., SOURCE => ...)")}unless ($LEGAL_TYPE{$stype}){require Carp;Carp::croak("Illegal value `$stype' for TYPE parameter")}my$self={TYPE=>$stype,PREPEND=>$prepend,UNTAINT=>$untaint,BROKEN=>$broken,(defined$alt_delim ? (DELIM=>$alt_delim): ()),};$self->{SOURCE}=$source;bless$self=>$pack;return unless$self->_acquire_data;$self}}sub _acquire_data {my ($self)=@_;my$type=$self->{TYPE};if ($type eq 'STRING'){}elsif ($type eq 'FILE'){my$data=_load_text($self->{SOURCE});unless (defined$data){return undef}if ($self->{UNTAINT}&& _is_clean($self->{SOURCE})){_unconditionally_untaint($data)}$self->{TYPE}='STRING';$self->{FILENAME}=$self->{SOURCE};$self->{SOURCE}=$data}elsif ($type eq 'ARRAY'){$self->{TYPE}='STRING';$self->{SOURCE}=join '',@{$self->{SOURCE}}}elsif ($type eq 'FILEHANDLE'){$self->{TYPE}='STRING';local $/;my$fh=$self->{SOURCE};my$data=<$fh>;if ($self->{UNTAINT}){_unconditionally_untaint($data)}$self->{SOURCE}=$data}else {my$pack=ref$self;die "Can only acquire data for $pack objects of subtype STRING, but this is $type; aborting"}$self->{DATA_ACQUIRED}=1}sub source {my ($self)=@_;$self->_acquire_data unless$self->{DATA_ACQUIRED};return$self->{SOURCE}}sub set_source_data {my ($self,$newdata)=@_;$self->{SOURCE}=$newdata;$self->{DATA_ACQUIRED}=1;$self->{TYPE}='STRING';1}sub compile {my$self=shift;return 1 if$self->{TYPE}eq 'PREPARSED';return undef unless$self->_acquire_data;unless ($self->{TYPE}eq 'STRING'){my$pack=ref$self;die "Can only compile $pack objects of subtype STRING, but this is $self->{TYPE}; aborting"}my@tokens;my$delim_pats=shift()|| $self->{DELIM};my ($t_open,$t_close)=('{','}');my$DELIM;if (defined$delim_pats){($t_open,$t_close)=@$delim_pats;$DELIM="(?:(?:\Q$t_open\E)|(?:\Q$t_close\E))";@tokens=split /($DELIM|\n)/,$self->{SOURCE}}else {@tokens=split /(\\\\(?=\\*[{}])|\\[{}]|[{}\n])/,$self->{SOURCE}}my$state='TEXT';my$depth=0;my$lineno=1;my@content;my$cur_item='';my$prog_start;while (@tokens){my$t=shift@tokens;next if$t eq '';if ($t eq $t_open){if ($depth==0){push@content,[$state,$cur_item,$lineno]if$cur_item ne '';$cur_item='';$state='PROG';$prog_start=$lineno}else {$cur_item .= $t}$depth++}elsif ($t eq $t_close){$depth--;if ($depth < 0){$ERROR="Unmatched close brace at line $lineno";return undef}elsif ($depth==0){push@content,[$state,$cur_item,$prog_start]if$cur_item ne '';$state='TEXT';$cur_item=''}else {$cur_item .= $t}}elsif (!$delim_pats && $t eq '\\\\'){$cur_item .= '\\'}elsif (!$delim_pats && $t =~ /^\\([{}])$/){$cur_item .= $1}elsif ($t eq "\n"){$lineno++;$cur_item .= $t}else {$cur_item .= $t}}if ($state eq 'PROG'){$ERROR="End of data inside program text that began at line $prog_start";return undef}elsif ($state eq 'TEXT'){push@content,[$state,$cur_item,$lineno]if$cur_item ne ''}else {die "Can't happen error #1"}$self->{TYPE}='PREPARSED';$self->{SOURCE}=\@content;1}sub prepend_text {my ($self)=@_;my$t=$self->{PREPEND};unless (defined$t){$t=$GLOBAL_PREPEND{ref$self};unless (defined$t){$t=$GLOBAL_PREPEND{'Text::Template'}}}$self->{PREPEND}=$_[1]if $#_ >= 1;return$t}sub fill_in {my$fi_self=shift;my%fi_a=@_;unless ($fi_self->{TYPE}eq 'PREPARSED'){my$delims=_param('delimiters',%fi_a);my@delim_arg=(defined$delims ? ($delims): ());$fi_self->compile(@delim_arg)or return undef}my$fi_varhash=_param('hash',%fi_a);my$fi_package=_param('package',%fi_a);my$fi_broken=_param('broken',%fi_a)|| $fi_self->{BROKEN}|| \&_default_broken;my$fi_broken_arg=_param('broken_arg',%fi_a)|| [];my$fi_safe=_param('safe',%fi_a);my$fi_ofh=_param('output',%fi_a);my$fi_eval_package;my$fi_scrub_package=0;my$fi_filename=_param('filename')|| $fi_self->{FILENAME}|| 'template';my$fi_prepend=_param('prepend',%fi_a);unless (defined$fi_prepend){$fi_prepend=$fi_self->prepend_text}if (defined$fi_safe){$fi_eval_package='main'}elsif (defined$fi_package){$fi_eval_package=$fi_package}elsif (defined$fi_varhash){$fi_eval_package=_gensym();$fi_scrub_package=1}else {$fi_eval_package=caller}my$fi_install_package;if (defined$fi_varhash){if (defined$fi_package){$fi_install_package=$fi_package}elsif (defined$fi_safe){$fi_install_package=$fi_safe->root}else {$fi_install_package=$fi_eval_package}_install_hash($fi_varhash=>$fi_install_package)}if (defined$fi_package && defined$fi_safe){no strict 'refs';*{$fi_safe->root .'::'}=\%{$fi_package .'::'}}my$fi_r='';my$fi_item;for$fi_item (@{$fi_self->{SOURCE}}){my ($fi_type,$fi_text,$fi_lineno)=@$fi_item;if ($fi_type eq 'TEXT'){$fi_self->append_text_to_output(text=>$fi_text,handle=>$fi_ofh,out=>\$fi_r,type=>$fi_type,)}elsif ($fi_type eq 'PROG'){no strict;my$fi_lcomment="#line $fi_lineno $fi_filename";my$fi_progtext="package $fi_eval_package; $fi_prepend;\n$fi_lcomment\n$fi_text;";my$fi_res;my$fi_eval_err='';if ($fi_safe){$fi_safe->reval(q{undef $OUT});$fi_res=$fi_safe->reval($fi_progtext);$fi_eval_err=$@;my$OUT=$fi_safe->reval('$OUT');$fi_res=$OUT if defined$OUT}else {my$OUT;$fi_res=eval$fi_progtext;$fi_eval_err=$@;$fi_res=$OUT if defined$OUT}$fi_res='' unless defined$fi_res;if ($fi_eval_err){$fi_res=$fi_broken->(text=>$fi_text,error=>$fi_eval_err,lineno=>$fi_lineno,arg=>$fi_broken_arg,);if (defined$fi_res){$fi_self->append_text_to_output(text=>$fi_res,handle=>$fi_ofh,out=>\$fi_r,type=>$fi_type,)}else {return$fi_res}}else {$fi_self->append_text_to_output(text=>$fi_res,handle=>$fi_ofh,out=>\$fi_r,type=>$fi_type,)}}else {die "Can't happen error #2"}}_scrubpkg($fi_eval_package)if$fi_scrub_package;defined$fi_ofh ? 1 : $fi_r}sub append_text_to_output {my ($self,%arg)=@_;if (defined$arg{handle}){print {$arg{handle}}$arg{text}}else {${$arg{out}}.= $arg{text}}return}sub fill_this_in {my$pack=shift;my$text=shift;my$templ=$pack->new(TYPE=>'STRING',SOURCE=>$text,@_)or return undef;$templ->compile or return undef;my$result=$templ->fill_in(@_);$result}sub fill_in_string {my$string=shift;my$package=_param('package',@_);push @_,'package'=>scalar(caller)unless defined$package;Text::Template->fill_this_in($string,@_)}sub fill_in_file {my$fn=shift;my$templ=Text::Template->new(TYPE=>'FILE',SOURCE=>$fn,@_)or return undef;$templ->compile or return undef;my$text=$templ->fill_in(@_);$text}sub _default_broken {my%a=@_;my$prog_text=$a{text};my$err=$a{error};my$lineno=$a{lineno};chomp$err;"Program fragment delivered error ``$err''"}sub _load_text {my$fn=shift;local*F;unless (open F,$fn){$ERROR="Couldn't open file $fn: $!";return undef}local $/;<F>}sub _is_clean {my$z;eval {($z=join('',@_)),eval '#' .substr($z,0,0);1}}sub _unconditionally_untaint {for (@_){($_)=/(.*)/s}}{my$seqno=0;sub _gensym {__PACKAGE__ .'::GEN' .$seqno++}sub _scrubpkg {my$s=shift;$s =~ s/^Text::Template:://;no strict 'refs';my$hash=$Text::Template::{$s."::"};for my$key (keys %$hash){undef$hash->{$key}}%$hash=();delete$Text::Template::{$s."::"}}}sub _install_hash {my$hashlist=shift;my$dest=shift;if (UNIVERSAL::isa($hashlist,'HASH')){$hashlist=[$hashlist]}my$hash;for$hash (@$hashlist){my$name;for$name (keys %$hash){my$val=$hash->{$name};no strict 'refs';local*SYM=*{"$ {dest}::$name"};if (!defined$val){delete ${"$ {dest}::"}{$name}}elsif (ref$val){*SYM=$val}else {*SYM=\$val}}}}sub TTerror {$ERROR}1; +TEXT_TEMPLATE + +$fatpacked{"Text/Template/Preprocess.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TEMPLATE_PREPROCESS'; + package Text::Template::Preprocess;$Text::Template::Preprocess::VERSION='1.47';use Text::Template;@ISA=qw(Text::Template);sub fill_in {my$self=shift;my (%args)=@_;my$pp=$args{PREPROCESSOR}|| $self->{PREPROCESSOR};if ($pp){local $_=$self->source();&$pp;$self->set_source_data($_)}$self->SUPER::fill_in(@_)}sub preprocessor {my ($self,$pp)=@_;my$old_pp=$self->{PREPROCESSOR};$self->{PREPROCESSOR}=$pp if @_ > 1;$old_pp}1; +TEXT_TEMPLATE_PREPROCESS + +$fatpacked{"Try/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TRY_TINY'; + package Try::Tiny;use 5.006;our$VERSION='0.28';use strict;use warnings;use Exporter 5.57 'import';our@EXPORT=our@EXPORT_OK=qw(try catch finally);use Carp;$Carp::Internal{+__PACKAGE__}++;BEGIN {my$su=$INC{'Sub/Util.pm'}&& defined&Sub::Util::set_subname;my$sn=$INC{'Sub/Name.pm'}&& eval {Sub::Name->VERSION(0.08)};unless ($su || $sn){$su=eval {require Sub::Util}&& defined&Sub::Util::set_subname;unless ($su){$sn=eval {require Sub::Name;Sub::Name->VERSION(0.08)}}}*_subname=$su ? \&Sub::Util::set_subname : $sn ? \&Sub::Name::subname : sub {$_[1]};*_HAS_SUBNAME=($su || $sn)? sub(){1}: sub(){0}}my%_finally_guards;sub try (&;@) {my ($try,@code_refs)=@_;my$wantarray=wantarray;my ($catch,@finally)=();for my$code_ref (@code_refs){if (ref($code_ref)eq 'Try::Tiny::Catch'){croak 'A try() may not be followed by multiple catch() blocks' if$catch;$catch=${$code_ref}}elsif (ref($code_ref)eq 'Try::Tiny::Finally'){push@finally,${$code_ref}}else {croak('try() encountered an unexpected argument (' .(defined$code_ref ? $code_ref : 'undef').') - perhaps a missing semi-colon before or')}}my$caller=caller;_subname("${caller}::try {...} "=>$try)if _HAS_SUBNAME;local$_finally_guards{guards}=[map {Try::Tiny::ScopeGuard->_new($_)}@finally ];my$prev_error=$@;my (@ret,$error);my$failed=not eval {$@=$prev_error;if ($wantarray){@ret=$try->()}elsif (defined$wantarray){$ret[0]=$try->()}else {$try->()};return 1};$error=$@;$@=$prev_error;if ($failed){push @$_,$error for @{$_finally_guards{guards}};if ($catch){for ($error){return$catch->($error)}}return}else {return$wantarray ? @ret : $ret[0]}}sub catch (&;@) {my ($block,@rest)=@_;croak 'Useless bare catch()' unless wantarray;my$caller=caller;_subname("${caller}::catch {...} "=>$block)if _HAS_SUBNAME;return (bless(\$block,'Try::Tiny::Catch'),@rest,)}sub finally (&;@) {my ($block,@rest)=@_;croak 'Useless bare finally()' unless wantarray;my$caller=caller;_subname("${caller}::finally {...} "=>$block)if _HAS_SUBNAME;return (bless(\$block,'Try::Tiny::Finally'),@rest,)}{package Try::Tiny::ScopeGuard;use constant UNSTABLE_DOLLARAT=>("$]" < '5.013002')? 1 : 0;sub _new {shift;bless [@_ ]}sub DESTROY {my ($code,@args)=@{$_[0]};local $@ if UNSTABLE_DOLLARAT;eval {$code->(@args);1}or do {warn "Execution of finally() block $code resulted in an exception, which " .'*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. ' .'Your program will continue as if this event never took place. ' ."Original exception text follows:\n\n" .(defined $@ ? $@ : '$@ left undefined...')."\n" }}}__PACKAGE__ +TRY_TINY + +$fatpacked{"Type/Coercion.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_COERCION'; + package Type::Coercion;use 5.006001;use strict;use warnings;BEGIN {$Type::Coercion::AUTHORITY='cpan:TOBYINK';$Type::Coercion::VERSION='1.002001'}use Eval::TypeTiny qw<>;use Scalar::Util qw<blessed>;use Types::TypeTiny qw<>;sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}use overload q("")=>sub {caller =~ m{^(Moo::HandleMoose|Sub::Quote)} ? overload::StrVal($_[0]): $_[0]->display_name},q(bool)=>sub {1},q(&{})=>"_overload_coderef",fallback=>1,;BEGIN {require Type::Tiny;overload->import(q(~~)=>sub {$_[0]->has_coercion_for_value($_[1])},fallback=>1,)if Type::Tiny::SUPPORT_SMARTMATCH()}sub _overload_coderef {my$self=shift;if ("Sub::Quote"->can("quote_sub")&& $self->can_be_inlined){$self->{_overload_coderef}=Sub::Quote::quote_sub($self->inline_coercion('$_[0]'))if!$self->{_overload_coderef}||!$self->{_sub_quoted}++}else {$self->{_overload_coderef}||= sub {$self->coerce(@_)}}$self->{_overload_coderef}}sub new {my$class=shift;my%params=(@_==1)? %{$_[0]}: @_;$params{name}='__ANON__' unless exists($params{name});my$C=delete($params{type_coercion_map})|| [];my$F=delete($params{frozen});my$self=bless \%params,$class;$self->add_type_coercions(@$C)if @$C;$self->_preserve_type_constraint;Scalar::Util::weaken($self->{type_constraint});$self->{frozen}=$F if$F;unless ($self->is_anon){$self->name =~ /^_{0,2}[A-Z][A-Za-z0-9_]+$/sm or eval q( use 5.008; $self->name =~ /^_{0,2}\p{Lu}[\p{L}0-9_]+$/sm ) or _croak '"%s" is not a valid coercion name',$self->name}return$self}sub name {$_[0]{name}}sub display_name {$_[0]{display_name}||= $_[0]->_build_display_name}sub library {$_[0]{library}}sub type_constraint {$_[0]{type_constraint}||= $_[0]->_maybe_restore_type_constraint}sub type_coercion_map {$_[0]{type_coercion_map}||= []}sub moose_coercion {$_[0]{moose_coercion}||= $_[0]->_build_moose_coercion}sub compiled_coercion {$_[0]{compiled_coercion}||= $_[0]->_build_compiled_coercion}sub frozen {$_[0]{frozen}||= 0}sub coercion_generator {$_[0]{coercion_generator}}sub parameters {$_[0]{parameters}}sub parameterized_from {$_[0]{parameterized_from}}sub has_library {exists $_[0]{library}}sub has_type_constraint {defined $_[0]->type_constraint}sub has_coercion_generator {exists $_[0]{coercion_generator}}sub has_parameters {exists $_[0]{parameters}}sub _preserve_type_constraint {my$self=shift;$self->{_compiled_type_constraint_check}=$self->{type_constraint}->compiled_check if$self->{type_constraint}}sub _maybe_restore_type_constraint {my$self=shift;if (my$check=$self->{_compiled_type_constraint_check}){return Type::Tiny->new(constraint=>$check)}return}sub add {my$class=shift;my ($x,$y,$swap)=@_;Types::TypeTiny::TypeTiny->check($x)and return$x->plus_fallback_coercions($y);Types::TypeTiny::TypeTiny->check($y)and return$y->plus_coercions($x);_croak "Attempt to add $class to something that is not a $class" unless blessed($x)&& blessed($y)&& $x->isa($class)&& $y->isa($class);($y,$x)=($x,$y)if$swap;my%opts;if ($x->has_type_constraint and $y->has_type_constraint and $x->type_constraint==$y->type_constraint){$opts{type_constraint}=$x->type_constraint}elsif ($x->has_type_constraint and $y->has_type_constraint){}$opts{display_name}||= "$x+$y";delete$opts{display_name}if$opts{display_name}eq '__ANON__+__ANON__';my$new=$class->new(%opts);$new->add_type_coercions(@{$x->type_coercion_map});$new->add_type_coercions(@{$y->type_coercion_map});return$new}sub _build_display_name {shift->name}sub qualified_name {my$self=shift;if ($self->has_library and not $self->is_anon){return sprintf("%s::%s",$self->library,$self->name)}return$self->name}sub is_anon {my$self=shift;$self->name eq "__ANON__"}sub _clear_compiled_coercion {delete $_[0]{_overload_coderef};delete $_[0]{compiled_coercion}}sub freeze {$_[0]{frozen}=1;$_[0]}sub i_really_want_to_unfreeze {$_[0]{frozen}=0;$_[0]}sub coerce {my$self=shift;return$self->compiled_coercion->(@_)}sub assert_coerce {my$self=shift;my$r=$self->coerce(@_);$self->type_constraint->assert_valid($r)if$self->has_type_constraint;return$r}sub has_coercion_for_type {my$self=shift;my$type=Types::TypeTiny::to_TypeTiny($_[0]);return "0 but true" if$self->has_type_constraint && $type->is_a_type_of($self->type_constraint);my$c=$self->type_coercion_map;for (my$i=0;$i <= $#$c;$i += 2){return!!1 if$type->is_a_type_of($c->[$i])}return}sub has_coercion_for_value {my$self=shift;local $_=$_[0];return "0 but true" if$self->has_type_constraint && $self->type_constraint->check(@_);my$c=$self->type_coercion_map;for (my$i=0;$i <= $#$c;$i += 2){return!!1 if$c->[$i]->check(@_)}return}sub add_type_coercions {my$self=shift;my@args=@_;_croak "Attempt to add coercion code to a Type::Coercion which has been frozen" if$self->frozen;while (@args){my$type=Types::TypeTiny::to_TypeTiny(shift@args);my$coercion=shift@args;_croak "Types must be blessed Type::Tiny objects" unless Types::TypeTiny::TypeTiny->check($type);_croak "Coercions must be code references or strings" unless Types::TypeTiny::StringLike->check($coercion)|| Types::TypeTiny::CodeLike->check($coercion);push @{$self->type_coercion_map},$type,$coercion}$self->_clear_compiled_coercion;return$self}sub _build_compiled_coercion {my$self=shift;my@mishmash=@{$self->type_coercion_map};return sub {$_[0]}unless@mishmash;if ($self->can_be_inlined){return Eval::TypeTiny::eval_closure(source=>sprintf('sub ($) { %s }',$self->inline_coercion('$_[0]')),description=>sprintf("compiled coercion '%s'",$self),)}my (@types,@codes);while (@mishmash){push@types,shift@mishmash;push@codes,shift@mishmash}if ($self->has_type_constraint){unshift@types,$self->type_constraint;unshift@codes,undef}my@sub;for my$i (0..$#types){push@sub,$types[$i]->can_be_inlined ? sprintf('if (%s)',$types[$i]->inline_check('$_[0]')): sprintf('if ($checks[%d]->(@_))',$i);push@sub,!defined($codes[$i])? sprintf(' { return $_[0] }'): Types::TypeTiny::StringLike->check($codes[$i])? sprintf(' { local $_ = $_[0]; return scalar(%s); }',$codes[$i]): sprintf(' { local $_ = $_[0]; return scalar($codes[%d]->(@_)) }',$i)}push@sub,'return $_[0];';return Eval::TypeTiny::eval_closure(source=>sprintf('sub ($) { %s }',join qq[\n],@sub),description=>sprintf("compiled coercion '%s'",$self),environment=>{'@checks'=>[map $_->compiled_check,@types ],'@codes'=>\@codes,},)}sub can_be_inlined {my$self=shift;return unless$self->frozen;return if$self->has_type_constraint &&!$self->type_constraint->can_be_inlined;my@mishmash=@{$self->type_coercion_map};while (@mishmash){my ($type,$converter)=splice(@mishmash,0,2);return unless$type->can_be_inlined;return unless Types::TypeTiny::StringLike->check($converter)}return!!1}sub _source_type_union {my$self=shift;my@r;push@r,$self->type_constraint if$self->has_type_constraint;my@mishmash=@{$self->type_coercion_map};while (@mishmash){my ($type)=splice(@mishmash,0,2);push@r,$type}require Type::Tiny::Union;return "Type::Tiny::Union"->new(type_constraints=>\@r,tmp=>1)}sub inline_coercion {my$self=shift;my$varname=$_[0];_croak "This coercion cannot be inlined" unless$self->can_be_inlined;my@mishmash=@{$self->type_coercion_map};return "($varname)" unless@mishmash;my (@types,@codes);while (@mishmash){push@types,shift@mishmash;push@codes,shift@mishmash}if ($self->has_type_constraint){unshift@types,$self->type_constraint;unshift@codes,undef}my@sub;for my$i (0..$#types){push@sub,sprintf('(%s) ?',$types[$i]->inline_check($varname));push@sub,(defined($codes[$i])&& ($varname eq '$_'))? sprintf('scalar(do { %s }) :',$codes[$i]): defined($codes[$i])? sprintf('scalar(do { local $_ = %s; %s }) :',$varname,$codes[$i]): sprintf('%s :',$varname)}push@sub,"$varname";"@sub"}sub _build_moose_coercion {my$self=shift;my%options=();$options{type_coercion_map}=[$self->freeze->_codelike_type_coercion_map('moose_type')];$options{type_constraint}=$self->type_constraint if$self->has_type_constraint;require Moose::Meta::TypeCoercion;my$r="Moose::Meta::TypeCoercion"->new(%options);return$r}sub _codelike_type_coercion_map {my$self=shift;my$modifier=$_[0];my@orig=@{$self->type_coercion_map};my@new;while (@orig){my ($type,$converter)=splice(@orig,0,2);push@new,$modifier ? $type->$modifier : $type;if (Types::TypeTiny::CodeLike->check($converter)){push@new,$converter}else {push@new,Eval::TypeTiny::eval_closure(source=>sprintf('sub { local $_ = $_[0]; %s }',$converter),description=>sprintf("temporary compiled converter from '%s'",$type),)}}return@new}sub is_parameterizable {shift->has_coercion_generator}sub is_parameterized {shift->has_parameters}sub parameterize {my$self=shift;return$self unless @_;$self->is_parameterizable or _croak "Constraint '%s' does not accept parameters","$self";@_=map Types::TypeTiny::to_TypeTiny($_),@_;return ref($self)->new(type_constraint=>$self->type_constraint,type_coercion_map=>[$self->coercion_generator->($self,$self->type_constraint,@_)],parameters=>\@_,frozen=>1,parameterized_from=>$self,)}sub _reparameterize {my$self=shift;my ($target_type)=@_;$self->is_parameterized or return$self;my$parent=$self->parameterized_from;return ref($self)->new(type_constraint=>$target_type,type_coercion_map=>[$parent->coercion_generator->($parent,$target_type,@{$self->parameters})],parameters=>\@_,frozen=>1,parameterized_from=>$parent,)}sub isa {my$self=shift;if ($INC{"Moose.pm"}and blessed($self)and $_[0]eq 'Moose::Meta::TypeCoercion'){return!!1}if ($INC{"Moose.pm"}and blessed($self)and $_[0]=~ /^(Class::MOP|MooseX?)::/){my$r=$self->moose_coercion->isa(@_);return$r if$r}$self->SUPER::isa(@_)}sub can {my$self=shift;my$can=$self->SUPER::can(@_);return$can if$can;if ($INC{"Moose.pm"}and blessed($self)and my$method=$self->moose_coercion->can(@_)){return sub {$method->(shift->moose_coercion,@_)}}return}sub AUTOLOAD {my$self=shift;my ($m)=(our$AUTOLOAD =~ /::(\w+)$/);return if$m eq 'DESTROY';if ($INC{"Moose.pm"}and blessed($self)and my$method=$self->moose_coercion->can($m)){return$method->($self->moose_coercion,@_)}_croak q[Can't locate object method "%s" via package "%s"],$m,ref($self)||$self}sub _compiled_type_coercion {my$self=shift;if (@_){my$thing=$_[0];if (blessed($thing)and $thing->isa("Type::Coercion")){$self->add_type_coercions(@{$thing->type_coercion_map})}elsif (Types::TypeTiny::CodeLike->check($thing)){require Types::Standard;$self->add_type_coercions(Types::Standard::Any(),$thing)}}$self->compiled_coercion}*compile_type_coercion=\&compiled_coercion;sub meta {_croak("Not really a Moose::Meta::TypeCoercion. Sorry!")}1; +TYPE_COERCION + +$fatpacked{"Type/Coercion/FromMoose.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_COERCION_FROMMOOSE'; + package Type::Coercion::FromMoose;use 5.006001;use strict;use warnings;BEGIN {$Type::Coercion::FromMoose::AUTHORITY='cpan:TOBYINK';$Type::Coercion::FromMoose::VERSION='1.002001'}use Scalar::Util qw<blessed>;use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}require Type::Coercion;our@ISA='Type::Coercion';sub type_coercion_map {my$self=shift;my@from;if ($self->type_constraint){my$moose=$self->type_constraint->{moose_type};@from=@{$moose->coercion->type_coercion_map}if$moose && $moose->has_coercion}else {_croak "The type constraint attached to this coercion has been garbage collected... PANIC"}my@return;while (@from){my ($type,$code)=splice(@from,0,2);$type=Moose::Util::TypeConstraints::find_type_constraint($type)unless ref$type;push@return,Types::TypeTiny::to_TypeTiny($type),$code}return \@return}sub add_type_coercions {my$self=shift;_croak "Adding coercions to Type::Coercion::FromMoose not currently supported" if @_}sub _build_moose_coercion {my$self=shift;if ($self->type_constraint){my$moose=$self->type_constraint->{moose_type};return$moose->coercion if$moose && $moose->has_coercion}$self->SUPER::_build_moose_coercion(@_)}sub can_be_inlined {0}1; +TYPE_COERCION_FROMMOOSE + +$fatpacked{"Type/Coercion/Union.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_COERCION_UNION'; + package Type::Coercion::Union;use 5.006001;use strict;use warnings;BEGIN {$Type::Coercion::Union::AUTHORITY='cpan:TOBYINK';$Type::Coercion::Union::VERSION='1.002001'}use Scalar::Util qw<blessed>;use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}require Type::Coercion;our@ISA='Type::Coercion';sub _preserve_type_constraint {my$self=shift;$self->{_union_of}=$self->{type_constraint}->type_constraints if$self->{type_constraint}}sub _maybe_restore_type_constraint {my$self=shift;if (my$union=$self->{_union_of}){return Type::Tiny::Union->new(type_constraints=>$union)}return}sub type_coercion_map {my$self=shift;Types::TypeTiny::TypeTiny->assert_valid(my$type=$self->type_constraint);$type->isa('Type::Tiny::Union')or _croak "Type::Coercion::Union must be used in conjunction with Type::Tiny::Union";my@c;for my$tc (@$type){next unless$tc->has_coercion;push@c,@{$tc->coercion->type_coercion_map}}return \@c}sub add_type_coercions {my$self=shift;_croak "Adding coercions to Type::Coercion::Union not currently supported" if @_}sub _build_moose_coercion {my$self=shift;my%options=();$options{type_constraint}=$self->type_constraint if$self->has_type_constraint;require Moose::Meta::TypeCoercion::Union;my$r="Moose::Meta::TypeCoercion::Union"->new(%options);return$r}sub can_be_inlined {my$self=shift;Types::TypeTiny::TypeTiny->assert_valid(my$type=$self->type_constraint);for my$tc (@$type){next unless$tc->has_coercion;return!!0 unless$tc->coercion->can_be_inlined}!!1}1; +TYPE_COERCION_UNION + +$fatpacked{"Type/Library.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_LIBRARY'; + package Type::Library;use 5.006001;use strict;use warnings;BEGIN {$Type::Library::AUTHORITY='cpan:TOBYINK';$Type::Library::VERSION='1.002001'}use Eval::TypeTiny qw<eval_closure>;use Scalar::Util qw<blessed refaddr>;use Type::Tiny;use Types::TypeTiny qw<TypeTiny to_TypeTiny>;require Exporter::Tiny;our@ISA='Exporter::Tiny';BEGIN {*NICE_PROTOTYPES=($] >= 5.014)? sub () {!!1}: sub () {!!0}};sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}{my$subname;my%already;sub _subname ($$) {$subname=eval {require Sub::Util}? \&Sub::Util::set_subname : eval {require Sub::Name}? \&Sub::Name::subname : 0 if not defined$subname;!$already{refaddr($_[1])}++ and return($subname->(@_))if$subname;return $_[1]}}sub _exporter_validate_opts {my$class=shift;no strict "refs";my$into=$_[0]{into};push @{"$into\::ISA"},$class if $_[0]{base};return$class->SUPER::_exporter_validate_opts(@_)}sub _exporter_expand_tag {my$class=shift;my ($name,$value,$globals)=@_;$name eq 'types' and return map ["$_"=>$value ],$class->type_names;$name eq 'is' and return map ["is_$_"=>$value ],$class->type_names;$name eq 'assert' and return map ["assert_$_"=>$value ],$class->type_names;$name eq 'to' and return map ["to_$_"=>$value ],$class->type_names;$name eq 'coercions' and return map ["$_"=>$value ],$class->coercion_names;if ($name eq 'all'){no strict "refs";return (map(["+$_"=>$value ],$class->type_names,),map([$_=>$value ],$class->coercion_names,@{"$class\::EXPORT"},@{"$class\::EXPORT_OK"},),)}return$class->SUPER::_exporter_expand_tag(@_)}sub _mksub {my$class=shift;my ($type,$post_method)=@_;$post_method ||= q();my$source=$type->is_parameterizable ? sprintf(q{ + sub (%s) { + return $_[0]->complete($type) if ref($_[0]) eq 'Type::Tiny::_HalfOp'; + my $params; $params = shift if ref($_[0]) eq q(ARRAY); + my $t = $params ? $type->parameterize(@$params) : $type; + @_ && wantarray ? return($t%s, @_) : return $t%s; + } + },NICE_PROTOTYPES ? q(;$) : q(;@),$post_method,$post_method,): sprintf(q{ sub () { $type%s if $] } },$post_method,);return _subname($type->qualified_name,eval_closure(source=>$source,description=>sprintf("exportable function '%s'",$type),environment=>{'$type'=>\$type},),)}sub _exporter_permitted_regexp {my$class=shift;my$inherited=$class->SUPER::_exporter_permitted_regexp(@_);my$types=join "|",map quotemeta,sort {length($b)<=> length($a)or $a cmp $b}$class->type_names;my$coercions=join "|",map quotemeta,sort {length($b)<=> length($a)or $a cmp $b}$class->coercion_names;qr{^(?: + $inherited + | (?: (?:is_|to_|assert_)? (?:$types) ) + | (?:$coercions) + )$}xms}sub _exporter_expand_sub {my$class=shift;my ($name,$value,$globals)=@_;if ($name =~ /^\+(.+)/ and $class->has_type($1)){my$type=$1;my$value2=+{%{$value||{}}};return map$class->_exporter_expand_sub($_,$value2,$globals),$type,"is_$type","assert_$type","to_$type"}if (my$type=$class->get_type($name)){my$post_method=q();$post_method='->mouse_type' if$globals->{mouse};$post_method='->moose_type' if$globals->{moose};return ($name=>$class->_mksub($type,$post_method))if$post_method}return$class->SUPER::_exporter_expand_sub(@_)}sub _exporter_install_sub {my$class=shift;my ($name,$value,$globals,$sym)=@_;my$package=$globals->{into};if (!ref$package and my$type=$class->get_type($name)){my ($prefix)=grep defined,$value->{-prefix},$globals->{prefix},q();my ($suffix)=grep defined,$value->{-suffix},$globals->{suffix},q();my$as=$prefix .($value->{-as}|| $name).$suffix;$INC{'Type/Registry.pm'}? 'Type::Registry'->for_class($package)->add_type($type,$as): ($Type::Registry::DELAYED{$package}{$as}=$type)}$class->SUPER::_exporter_install_sub(@_)}sub _exporter_fail {my$class=shift;my ($name,$value,$globals)=@_;my$into=$globals->{into}or _croak("Parameter 'into' not supplied");if ($globals->{declare}){my$declared=sub (;$) {my$params;$params=shift if ref($_[0])eq "ARRAY";my$type=$into->get_type($name);unless ($type){_croak "Cannot parameterize a non-existant type" if$params;$type=$name}my$t=$params ? $type->parameterize(@$params): $type;@_ && wantarray ? return($t,@_): return$t};return($name,_subname("$class\::$name",NICE_PROTOTYPES ? sub (;$) {goto$declared}: sub (;@) {goto$declared},),)}return$class->SUPER::_exporter_fail(@_)}sub meta {no strict "refs";no warnings "once";return $_[0]if blessed $_[0];${"$_[0]\::META"}||= bless {},$_[0]}sub add_type {my$meta=shift->meta;my$class=blessed($meta);my$type=ref($_[0])=~ /^Type::Tiny\b/ ? $_[0]: blessed($_[0])? to_TypeTiny($_[0]): ref($_[0])eq q(HASH) ? "Type::Tiny"->new(library=>$class,%{$_[0]}): "Type::Tiny"->new(library=>$class,@_);my$name=$type->{name};$meta->{types}||= {};_croak 'Type %s already exists in this library',$name if$meta->has_type($name);_croak 'Type %s conflicts with coercion of same name',$name if$meta->has_coercion($name);_croak 'Cannot add anonymous type to a library' if$type->is_anon;$meta->{types}{$name}=$type;no strict "refs";no warnings "redefine","prototype";my$to_type=$type->has_coercion && $type->coercion->frozen ? $type->coercion->compiled_coercion : sub ($) {$type->coerce($_[0])};*{"$class\::$name"}=$class->_mksub($type);*{"$class\::is_$name"}=_subname "$class\::is_$name",$type->compiled_check;*{"$class\::to_$name"}=_subname "$class\::to_$name",$to_type;*{"$class\::assert_$name"}=_subname "$class\::assert_$name",$type->_overload_coderef;return$type}sub get_type {my$meta=shift->meta;$meta->{types}{$_[0]}}sub has_type {my$meta=shift->meta;exists$meta->{types}{$_[0]}}sub type_names {my$meta=shift->meta;keys %{$meta->{types}}}sub add_coercion {require Type::Coercion;my$meta=shift->meta;my$c=blessed($_[0])? $_[0]: "Type::Coercion"->new(@_);my$name=$c->name;$meta->{coercions}||= {};_croak 'Coercion %s already exists in this library',$name if$meta->has_coercion($name);_croak 'Coercion %s conflicts with type of same name',$name if$meta->has_type($name);_croak 'Cannot add anonymous type to a library' if$c->is_anon;$meta->{coercions}{$name}=$c;no strict "refs";no warnings "redefine","prototype";my$class=blessed($meta);*{"$class\::$name"}=$class->_mksub($c);return$c}sub get_coercion {my$meta=shift->meta;$meta->{coercions}{$_[0]}}sub has_coercion {my$meta=shift->meta;exists$meta->{coercions}{$_[0]}}sub coercion_names {my$meta=shift->meta;keys %{$meta->{coercions}}}sub make_immutable {my$meta=shift->meta;my$class=ref($meta);for my$type (values %{$meta->{types}}){$type->coercion->freeze;no strict "refs";no warnings "redefine","prototype";my$to_type=$type->has_coercion && $type->coercion->frozen ? $type->coercion->compiled_coercion : sub ($) {$type->coerce($_[0])};my$name=$type->name;*{"$class\::to_$name"}=_subname "$class\::to_$name",$to_type}1}1; +TYPE_LIBRARY + +$fatpacked{"Type/Params.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_PARAMS'; + package Type::Params;use 5.006001;use strict;use warnings;BEGIN {if ($] < 5.008){require Devel::TypeTiny::Perl56Compat}}BEGIN {$Type::Params::AUTHORITY='cpan:TOBYINK';$Type::Params::VERSION='1.002001'}use B qw();use Eval::TypeTiny;use Scalar::Util qw(refaddr);use Error::TypeTiny;use Error::TypeTiny::Assertion;use Error::TypeTiny::WrongNumberOfParameters;use Types::Standard -types;use Types::TypeTiny qw(CodeLike ArrayLike to_TypeTiny);require Exporter::Tiny;our@ISA='Exporter::Tiny';our@EXPORT=qw(compile compile_named);our@EXPORT_OK=qw(multisig validate validate_named Invocant);sub english_list {require Type::Utils;goto \&Type::Utils::english_list}my$QUOTE=($^V < 5.010 && exists(&B::cstring))? \&B::cstring : \&B::perlstring;{my$Invocant;sub Invocant () {$Invocant ||= do {require Type::Tiny::Union;require Types::Standard;'Type::Tiny::Union'->new(name=>'Invocant',type_constraints=>[Types::Standard::Object(),Types::Standard::ClassName(),],)}}}sub _mkslurpy {my ($name,$type,$tc,$i)=@_;$name='local $_' if$name eq '$_';$type eq '@' ? sprintf('%s = [ @_[%d..$#_] ];',$name,$i,): sprintf('%s = (($#_-%d)%%2)==0 ? "Error::TypeTiny::WrongNumberOfParameters"->throw(message => sprintf("Odd number of elements in %%s", %s)) : +{ @_[%d..$#_] };',$name,$i,$QUOTE->("$tc"),$i,)}sub compile {my (@code,%env);push@code,'#placeholder','#placeholder';my%options=(ref($_[0])eq "HASH" &&!$_[0]{slurpy})? %{+shift}: ();my$arg=-1;my$saw_slurpy=0;my$min_args=0;my$max_args=0;my$saw_opt=0;my$return_default_list=!!1;$code[0]='my (%tmp, $tmp);';PARAM: for my$param (@_){if (HashRef->check($param)){$code[0]='my (@R, %tmp, $tmp);';$return_default_list=!!0;last PARAM}elsif (not Bool->check($param)){if ($param->has_coercion){$code[0]='my (@R, %tmp, $tmp);';$return_default_list=!!0;last PARAM}}}while (@_){++$arg;my$constraint=shift;my$is_optional;my$really_optional;my$is_slurpy;my$varname;if (Bool->check($constraint)){$constraint=$constraint ? Any : Optional[Any]}if (HashRef->check($constraint)){$constraint=to_TypeTiny($constraint->{slurpy}or Error::TypeTiny::croak("Slurpy parameter malformed"));push@code,$constraint->is_a_type_of(Dict)? _mkslurpy('$_','%',$constraint=>$arg): $constraint->is_a_type_of(Map)? _mkslurpy('$_','%',$constraint=>$arg): $constraint->is_a_type_of(Tuple)? _mkslurpy('$_','@',$constraint=>$arg): $constraint->is_a_type_of(HashRef)? _mkslurpy('$_','%',$constraint=>$arg): $constraint->is_a_type_of(ArrayRef)? _mkslurpy('$_','@',$constraint=>$arg): Error::TypeTiny::croak("Slurpy parameter not of type HashRef or ArrayRef");$varname='$_';$is_slurpy++;$saw_slurpy++}else {Error::TypeTiny::croak("Parameter following slurpy parameter")if$saw_slurpy;$is_optional=grep $_->{uniq}==Optional->{uniq},$constraint->parents;$really_optional=$is_optional && $constraint->parent->{uniq}eq Optional->{uniq}&& $constraint->type_parameter;if ($is_optional){push@code,sprintf('return %s if $#_ < %d;',$return_default_list ? '@_' : '@R',$arg,);$saw_opt++;$max_args++}else {Error::TypeTiny::croak("Non-Optional parameter following Optional parameter")if$saw_opt;$min_args++;$max_args++}$varname=sprintf '$_[%d]',$arg}if ($constraint->has_coercion and $constraint->coercion->can_be_inlined){push@code,sprintf('$tmp%s = %s;',($is_optional ? '{x}' : ''),$constraint->coercion->inline_coercion($varname));$varname='$tmp'.($is_optional ? '{x}' : '')}elsif ($constraint->has_coercion){$env{'@coerce'}[$arg]=$constraint->coercion->compiled_coercion;push@code,sprintf('$tmp%s = $coerce[%d]->(%s);',($is_optional ? '{x}' : ''),$arg,$varname,);$varname='$tmp'.($is_optional ? '{x}' : '')}if ($constraint->can_be_inlined){push@code,sprintf('(%s) or Type::Tiny::_failed_check(%d, %s, %s, varname => %s);',$really_optional ? $constraint->type_parameter->inline_check($varname): $constraint->inline_check($varname),$constraint->{uniq},$QUOTE->($constraint),$varname,$is_slurpy ? 'q{$SLURPY}' : sprintf('q{$_[%d]}',$arg),)}else {$env{'@check'}[$arg]=$really_optional ? $constraint->type_parameter->compiled_check : $constraint->compiled_check;push@code,sprintf('%s or Type::Tiny::_failed_check(%d, %s, %s, varname => %s);',sprintf(sprintf '$check[%d]->(%s)',$arg,$varname),$constraint->{uniq},$QUOTE->($constraint),$varname,$is_slurpy ? 'q{$SLURPY}' : sprintf('q{$_[%d]}',$arg),)}unless ($return_default_list){push@code,sprintf 'push @R, %s;',$varname}}if ($min_args==$max_args and not $saw_slurpy){$code[1]=sprintf('"Error::TypeTiny::WrongNumberOfParameters"->throw(got => scalar(@_), minimum => %d, maximum => %d) if @_ != %d;',$min_args,$max_args,$min_args,)}elsif ($min_args < $max_args and not $saw_slurpy){$code[1]=sprintf('"Error::TypeTiny::WrongNumberOfParameters"->throw(got => scalar(@_), minimum => %d, maximum => %d) if @_ < %d || @_ > %d;',$min_args,$max_args,$min_args,$max_args,)}elsif ($min_args and $saw_slurpy){$code[1]=sprintf('"Error::TypeTiny::WrongNumberOfParameters"->throw(got => scalar(@_), minimum => %d) if @_ < %d;',$min_args,$min_args,)}if ($return_default_list){push@code,'@_;'}else {push@code,'@R;'}my$source="sub { no warnings; ".join("\n",@code)." };";return$source if$options{want_source};my$closure=eval_closure(source=>$source,description=>sprintf("parameter validation for '%s'",[caller(1+($options{caller_level}||0))]->[3]|| '__ANON__'),environment=>\%env,);return {min_args=>$min_args,max_args=>$saw_slurpy ? undef : $max_args,closure=>$closure,}if$options{want_details};return$closure}sub compile_named {my (@code,%env);@code='my (%R, %tmp, $tmp);';push@code,'#placeholder';my%options=(ref($_[0])eq "HASH" &&!$_[0]{slurpy})? %{+shift}: ();my$arg=-1;my$had_slurpy;push@code,'my %in = ((@_==1) && ref($_[0]) eq "HASH") ? %{$_[0]} : (@_ % 2) ? "Error::TypeTiny::WrongNumberOfParameters"->throw(message => "Odd number of elements in hash") : @_;';while (@_){++$arg;my ($name,$constraint)=splice(@_,0,2);my$is_optional;my$really_optional;my$is_slurpy;my$varname;if (Bool->check($constraint)){$constraint=$constraint ? Any : Optional[Any]}if (HashRef->check($constraint)){$constraint=to_TypeTiny($constraint->{slurpy});++$is_slurpy;++$had_slurpy}else {$is_optional=grep $_->{uniq}==Optional->{uniq},$constraint->parents;$really_optional=$is_optional && $constraint->parent->{uniq}eq Optional->{uniq}&& $constraint->type_parameter;$constraint=$constraint->type_parameter if$really_optional}unless ($is_optional or $is_slurpy){push@code,sprintf('exists($in{%s}) or "Error::TypeTiny::WrongNumberOfParameters"->throw(message => sprintf "Missing required parameter: %%s", %s);',$QUOTE->($name),$QUOTE->($name),)}my$need_to_close_if=0;if ($is_slurpy){$varname='\\%in'}elsif ($is_optional){push@code,sprintf('if (exists($in{%s})) {',$QUOTE->($name));push@code,sprintf('$tmp = delete($in{%s});',$QUOTE->($name));$varname='$tmp';++$need_to_close_if}else {push@code,sprintf('$tmp = delete($in{%s});',$QUOTE->($name));$varname='$tmp'}if ($constraint->has_coercion){if ($constraint->coercion->can_be_inlined){push@code,sprintf('$tmp = %s;',$constraint->coercion->inline_coercion($varname))}else {$env{'@coerce'}[$arg]=$constraint->coercion->compiled_coercion;push@code,sprintf('$tmp = $coerce[%d]->(%s);',$arg,$varname,)}$varname='$tmp'}if ($constraint->can_be_inlined){push@code,sprintf('(%s) or Type::Tiny::_failed_check(%d, %s, %s, varname => %s);',$constraint->inline_check($varname),$constraint->{uniq},$QUOTE->($constraint),$varname,$is_slurpy ? 'q{$SLURPY}' : sprintf('q{$_{%s}}',$QUOTE->($name)),)}else {$env{'@check'}[$arg]=$constraint->compiled_check;push@code,sprintf('%s or Type::Tiny::_failed_check(%d, %s, %s, varname => %s);',sprintf(sprintf '$check[%d]->(%s)',$arg,$varname),$constraint->{uniq},$QUOTE->($constraint),$varname,$is_slurpy ? 'q{$SLURPY}' : sprintf('q{$_{%s}}',$QUOTE->($name)),)}push@code,sprintf('$R{%s} = %s;',$QUOTE->($name),$varname);push@code,'}' if$need_to_close_if}if (!$had_slurpy){push@code,'keys(%in) and "Error::TypeTiny"->throw(message => sprintf "Unrecognized parameter%s: %s", keys(%in)>1?"s":"", Type::Params::english_list(sort keys %in));'}push@code,'\\%R;';my$source="sub { no warnings; ".join("\n",@code)." };";return$source if$options{want_source};my$closure=eval_closure(source=>$source,description=>sprintf("parameter validation for '%s'",[caller(1+($options{caller_level}||0))]->[3]|| '__ANON__'),environment=>\%env,);return {min_args=>undef,max_args=>undef,closure=>$closure,}if$options{want_details};return$closure}my%compiled;sub validate {my$arr=shift;my$sub=($compiled{join ":",map($_->{uniq}||"\@$_->{slurpy}",@_)}||= compile({caller_level=>1 },@_));@_=@$arr;goto$sub}my%compiled_named;sub validate_named {my$arr=shift;my$sub=($compiled_named{join ":",map(ref($_)?($_->{uniq}||"\@$_->{slurpy}"):$QUOTE->($_),@_)}||= compile_named({caller_level=>1 },@_));@_=@$arr;goto$sub}sub multisig {my%options=(ref($_[0])eq "HASH" &&!$_[0]{slurpy})? %{+shift}: ();my@multi=map {CodeLike->check($_)? {closure=>$_ }: ArrayLike->check($_)? compile({want_details=>1 },@$_): $_}@_;my@code='sub { my $r; ';for my$i (0 .. $#multi){my$flag=sprintf('${^TYPE_PARAMS_MULTISIG} = %d',$i);my$sig=$multi[$i];my@cond;push@cond,sprintf('@_ >= %s',$sig->{min_args})if defined$sig->{min_args};push@cond,sprintf('@_ <= %s',$sig->{max_args})if defined$sig->{max_args};if (defined$sig->{max_args}and defined$sig->{min_args}){@cond=sprintf('@_ == %s',$sig->{min_args})if$sig->{max_args}==$sig->{min_args}}push@code,sprintf('if (%s){',join(' and ',@cond))if@cond;push@code,sprintf('eval { $r = [ $multi[%d]{closure}->(@_) ]; %s };',$i,$flag);push@code,'return(@$r) if $r;';push@code,'}' if@cond}push@code,'"Error::TypeTiny"->throw(message => "Parameter validation failed");';push@code,'}';eval_closure(source=>\@code,description=>sprintf("parameter validation for '%s'",[caller(1+($options{caller_level}||0))]->[3]|| '__ANON__'),environment=>{'@multi'=>\@multi },)}1; +TYPE_PARAMS + +$fatpacked{"Type/Parser.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_PARSER'; + package Type::Parser;use strict;use warnings;sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.002001';sub TYPE () {"TYPE"};sub QUOTELIKE () {"QUOTELIKE"};sub STRING () {"STRING"};sub CLASS () {"CLASS"};sub L_BRACKET () {"L_BRACKET"};sub R_BRACKET () {"R_BRACKET"};sub COMMA () {"COMMA"};sub SLURPY () {"SLURPY"};sub UNION () {"UNION"};sub INTERSECT () {"INTERSECT"};sub NOT () {"NOT"};sub L_PAREN () {"L_PAREN"};sub R_PAREN () {"R_PAREN"};sub MYSTERY () {"MYSTERY"};our@EXPORT_OK=qw(eval_type _std_eval parse extract_type);require Exporter::Tiny;our@ISA='Exporter::Tiny';Evaluate: {sub parse {my$str=$_[0];my$parser="Type::Parser::AstBuilder"->new(input=>$str);$parser->build;wantarray ? ($parser->ast,$parser->remainder): $parser->ast}sub extract_type {my ($str,$reg)=@_;my ($parsed,$tail)=parse($str);wantarray ? (_eval_type($parsed,$reg),$tail): _eval_type($parsed,$reg)}sub eval_type {my ($str,$reg)=@_;my ($parsed,$tail)=parse($str);_croak("Unexpected tail on type expression: $tail")if$tail =~ /\S/sm;return _eval_type($parsed,$reg)}my$std;sub _std_eval {require Type::Registry;unless ($std){$std="Type::Registry"->new;$std->add_types(-Standard)}eval_type($_[0],$std)}sub _eval_type {my ($node,$reg)=@_;$node=_simplify_expression($node);if ($node->{type}eq "list"){return map _eval_type($_,$reg),@{$node->{list}}}if ($node->{type}eq "union"){return$reg->make_union(map _eval_type($_,$reg),@{$node->{union}})}if ($node->{type}eq "intersect"){return$reg->make_intersection(map _eval_type($_,$reg),@{$node->{intersect}})}if ($node->{type}eq "slurpy"){return +{slurpy=>_eval_type($node->{of},$reg)}}if ($node->{type}eq "complement"){return _eval_type($node->{of},$reg)->complementary_type}if ($node->{type}eq "parameterized"){my$base=_eval_type($node->{base},$reg);return$base unless$base->is_parameterizable || $node->{params};return$base->parameterize($node->{params}? _eval_type($node->{params},$reg): ())}if ($node->{type}eq "primary" and $node->{token}->type eq CLASS){my$class=substr($node->{token}->spelling,0,length($node->{token}->spelling)- 2);return$reg->make_class_type($class)}if ($node->{type}eq "primary" and $node->{token}->type eq QUOTELIKE){return eval($node->{token}->spelling)}if ($node->{type}eq "primary" and $node->{token}->type eq STRING){return$node->{token}->spelling}if ($node->{type}eq "primary" and $node->{token}->type eq TYPE){my$t=$node->{token}->spelling;my$r=($t =~ /^(.+)::(\w+)$/)? $reg->foreign_lookup($t,1): $reg->simple_lookup($t,1);$r or _croak("%s is not a known type constraint",$node->{token}->spelling);return$r}}sub _simplify_expression {my$expr=shift;if ($expr->{type}eq "expression" and $expr->{op}[0]eq COMMA){return _simplify("list",COMMA,$expr)}if ($expr->{type}eq "expression" and $expr->{op}[0]eq UNION){return _simplify("union",UNION,$expr)}if ($expr->{type}eq "expression" and $expr->{op}[0]eq INTERSECT){return _simplify("intersect",INTERSECT,$expr)}return$expr}sub _simplify {my$type=shift;my$op=shift;my@list;for my$expr ($_[0]{lhs},$_[0]{rhs}){if ($expr->{type}eq "expression" and $expr->{op}[0]eq $op){my$simple=_simplify($type,$op,$expr);push@list,@{$simple->{$type}}}else {push@list,$expr}}return {type=>$type,$type=>\@list }}}{package Type::Parser::AstBuilder;sub new {my$class=shift;bless {@_ },$class}our%precedence=(Type::Parser::UNION(),2,Type::Parser::INTERSECT(),3,Type::Parser::NOT(),4,);sub _parse_primary {my$self=shift;my$tokens=$self->{tokens};$tokens->assert_not_empty;if ($tokens->peek(0)->type eq Type::Parser::NOT){$tokens->eat(Type::Parser::NOT);$tokens->assert_not_empty;return {type=>"complement",of=>$self->_parse_primary,}}if ($tokens->peek(0)->type eq Type::Parser::SLURPY){$tokens->eat(Type::Parser::SLURPY);$tokens->assert_not_empty;return {type=>"slurpy",of=>$self->_parse_primary,}}if ($tokens->peek(0)->type eq Type::Parser::L_PAREN){$tokens->eat(Type::Parser::L_PAREN);my$r=$self->_parse_expression;$tokens->eat(Type::Parser::R_PAREN);return$r}if ($tokens->peek(1)and $tokens->peek(0)->type eq Type::Parser::TYPE and $tokens->peek(1)->type eq Type::Parser::L_BRACKET){my$base={type=>"primary",token=>$tokens->eat(Type::Parser::TYPE)};$tokens->eat(Type::Parser::L_BRACKET);$tokens->assert_not_empty;local$precedence{Type::Parser::COMMA()}=1;my$params=undef;if ($tokens->peek(0)->type eq Type::Parser::R_BRACKET){$tokens->eat(Type::Parser::R_BRACKET)}else {$params=$self->_parse_expression;$params={type=>"list",list=>[$params]}unless$params->{type}eq "list";$tokens->eat(Type::Parser::R_BRACKET)}return {type=>"parameterized",base=>$base,params=>$params,}}my$type=$tokens->peek(0)->type;if ($type eq Type::Parser::TYPE or $type eq Type::Parser::QUOTELIKE or $type eq Type::Parser::STRING or $type eq Type::Parser::CLASS){return {type=>"primary",token=>$tokens->eat }}Type::Parser::_croak("Unexpected token in primary type expression; got '%s'",$tokens->peek(0)->spelling)}sub _parse_expression_1 {my$self=shift;my$tokens=$self->{tokens};my ($lhs,$min_p)=@_;while (!$tokens->empty and defined($precedence{$tokens->peek(0)->type})and $precedence{$tokens->peek(0)->type}>= $min_p){my$op=$tokens->eat;my$rhs=$self->_parse_primary;while (!$tokens->empty and defined($precedence{$tokens->peek(0)->type})and $precedence{$tokens->peek(0)->type}> $precedence{$op->type}){my$lookahead=$tokens->peek(0);$rhs=$self->_parse_expression_1($rhs,$precedence{$lookahead->type})}$lhs={type=>"expression",op=>$op,lhs=>$lhs,rhs=>$rhs,}}return$lhs}sub _parse_expression {my$self=shift;my$tokens=$self->{tokens};return$self->_parse_expression_1($self->_parse_primary,0)}sub build {my$self=shift;$self->{tokens}="Type::Parser::TokenStream"->new(remaining=>$self->{input});$self->{ast}=$self->_parse_expression}sub ast {$_[0]{ast}}sub remainder {$_[0]{tokens}->remainder}}{package Type::Parser::Token;sub type {$_[0][0]}sub spelling {$_[0][1]}}{package Type::Parser::TokenStream;use Scalar::Util qw(looks_like_number);sub new {my$class=shift;bless {stack=>[],done=>[],@_ },$class}sub peek {my$self=shift;my$ahead=$_[0];while ($self->_stack_size <= $ahead and length$self->{remaining}){$self->_stack_extend}my@tokens=grep ref,@{$self->{stack}};return$tokens[$ahead]}sub empty {my$self=shift;not $self->peek(0)}sub eat {my$self=shift;$self->_stack_extend unless$self->_stack_size;my$r;while (defined(my$item=shift @{$self->{stack}})){push @{$self->{done}},$item;if (ref$item){$r=$item;last}}if (@_ and $_[0]ne $r->type){unshift @{$self->{stack}},pop @{$self->{done}};Type::Parser::_croak("Expected $_[0]; got ".$r->type)}return$r}sub assert_not_empty {my$self=shift;Type::Parser::_croak("Expected token; got empty string")if$self->empty}sub _stack_size {my$self=shift;scalar grep ref,@{$self->{stack}}}sub _stack_extend {my$self=shift;push @{$self->{stack}},$self->_read_token;my ($space)=($self->{remaining}=~ m/^([\s\n\r]*)/sm);return unless length$space;push @{$self->{stack}},$space;substr($self->{remaining},0,length$space)=""}sub remainder {my$self=shift;return join "",map {ref($_)? $_->spelling : $_}(@{$self->{stack}},$self->{remaining})}my%punctuation=('['=>bless([Type::Parser::L_BRACKET,"[" ],"Type::Parser::Token"),']'=>bless([Type::Parser::R_BRACKET,"]" ],"Type::Parser::Token"),'('=>bless([Type::Parser::L_PAREN,"[" ],"Type::Parser::Token"),')'=>bless([Type::Parser::R_PAREN,"]" ],"Type::Parser::Token"),','=>bless([Type::Parser::COMMA,"," ],"Type::Parser::Token"),'=>'=>bless([Type::Parser::COMMA,"=>" ],"Type::Parser::Token"),'slurpy'=>bless([Type::Parser::SLURPY,"slurpy" ],"Type::Parser::Token"),'|'=>bless([Type::Parser::UNION,"|" ],"Type::Parser::Token"),'&'=>bless([Type::Parser::INTERSECT,"&" ],"Type::Parser::Token"),'~'=>bless([Type::Parser::NOT,"~" ],"Type::Parser::Token"),);sub _read_token {my$self=shift;return if$self->{remaining}eq "";if ($self->{remaining}=~ /^( => | [()\]\[|&~,] )/xsm){my$spelling=$1;substr($self->{remaining},0,length$spelling)="";return$punctuation{$spelling}}if ($self->{remaining}=~ /\A\s*[q'"]/sm){require Text::Balanced;if (my$quotelike=Text::Balanced::extract_quotelike($self->{remaining})){return bless([Type::Parser::QUOTELIKE,$quotelike ],"Type::Parser::Token"),}}if ($self->{remaining}=~ /^([+-]?[\w:.+]+)/sm){my$spelling=$1;substr($self->{remaining},0,length$spelling)="";if ($spelling =~ /::$/sm){return bless([Type::Parser::CLASS,$spelling ],"Type::Parser::Token"),}elsif (looks_like_number($spelling)){return bless([Type::Parser::STRING,$spelling ],"Type::Parser::Token"),}elsif ($self->{remaining}=~ /^\s*=>/sm){return bless([Type::Parser::STRING,$spelling ],"Type::Parser::Token"),}elsif ($spelling eq "slurpy"){return$punctuation{$spelling}}return bless([Type::Parser::TYPE,$spelling ],"Type::Parser::Token")}my$rest=$self->{remaining};$self->{remaining}="";return bless([Type::Parser::MYSTERY,$rest ],"Type::Parser::Token")}}1; +TYPE_PARSER + +$fatpacked{"Type/Registry.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_REGISTRY'; + package Type::Registry;use 5.006001;use strict;use warnings;BEGIN {$Type::Registry::AUTHORITY='cpan:TOBYINK';$Type::Registry::VERSION='1.002001'}use Exporter::Tiny qw(mkopt);use Scalar::Util qw(refaddr);use Type::Parser qw(eval_type);use Types::TypeTiny qw(CodeLike ArrayLike to_TypeTiny);our@ISA='Exporter::Tiny';our@EXPORT_OK=qw(t);sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}sub _exporter_expand_sub {my$class=shift;my ($name,$value,$globals,$permitted)=@_;if ($name eq "t"){my$caller=$globals->{into};my$reg=$class->for_class(ref($caller)? sprintf('HASH(0x%08X)',refaddr($caller)): $caller);return t=>sub (;$) {@_ ? $reg->lookup(@_): $reg}}return$class->SUPER::_exporter_expand_sub(@_)}sub new {my$class=shift;ref($class)and _croak("Not an object method");bless {},$class}{my%registries;sub for_class {my$class=shift;my ($for)=@_;$registries{$for}||= $class->new}sub for_me {my$class=shift;my$for=caller;$registries{$for}||= $class->new}}sub add_types {my$self=shift;my$opts=mkopt(\@_);for my$opt (@$opts){my ($library,$types)=@_;$library =~ s/^-/Types::/;{local$SIG{__DIE__}=sub {};eval "require $library"};my%hash;if ($library->isa("Type::Library")or $library eq 'Types::TypeTiny'){$types ||= [qw/-types/];ArrayLike->check($types)or _croak("Expected arrayref following '%s'; got %s",$library,$types);$library->import({into=>\%hash},@$types);$hash{$_}=&{$hash{$_}}()for keys%hash}elsif ($library->isa("MooseX::Types::Base")){$types ||= [];ArrayLike->check($types)&& (@$types==0)or _croak("Library '%s' is a MooseX::Types type constraint library. No import options currently supported",$library);require Moose::Util::TypeConstraints;my$moosextypes=$library->type_storage;for my$name (sort keys %$moosextypes){my$tt=to_TypeTiny(Moose::Util::TypeConstraints::find_type_constraint($moosextypes->{$name}));$hash{$name}=$tt}}elsif ($library->isa("MouseX::Types::Base")){$types ||= [];ArrayLike->check($types)&& (@$types==0)or _croak("Library '%s' is a MouseX::Types type constraint library. No import options currently supported",$library);require Mouse::Util::TypeConstraints;my$moosextypes=$library->type_storage;for my$name (sort keys %$moosextypes){my$tt=to_TypeTiny(Mouse::Util::TypeConstraints::find_type_constraint($moosextypes->{$name}));$hash{$name}=$tt}}else {_croak("%s is not a type library",$library)}for my$key (sort keys%hash){exists($self->{$key})and $self->{$key}{uniq}!=$hash{$key}{uniq}and _croak("Duplicate type name: %s",$key);$self->{$key}=$hash{$key}}}$self}sub add_type {my$self=shift;my ($type,$name)=@_;$type=to_TypeTiny($type);$name ||= do {$type->is_anon and _croak("Expected named type constraint; got anonymous type constraint");$type->name};exists($self->{$name})and $self->{$name}{uniq}!=$type->{uniq}and _croak("Duplicate type name: %s",$name);$self->{$name}=$type;$self}sub alias_type {my$self=shift;my ($old,@new)=@_;my$lookup=eval {$self->lookup($old)}or _croak("Expected existing type constraint name; got '$old'");$self->{$_}=$lookup for@new;$self}sub simple_lookup {my$self=shift;my ($tc)=@_;$tc =~ s/(^\s+|\s+$)//g;if (exists$self->{$tc}){return$self->{$tc}}return}sub foreign_lookup {my$self=shift;return $_[1]? (): $self->simple_lookup($_[0],1)unless $_[0]=~ /^(.+)::(\w+)$/;my$library=$1;my$typename=$2;{local$SIG{__DIE__}=sub {};eval "require $library;"};if ($library->isa('MooseX::Types::Base')){require Moose::Util::TypeConstraints;my$type=Moose::Util::TypeConstraints::find_type_constraint($library->get_type($typename))or return;return to_TypeTiny($type)}if ($library->isa('MouseX::Types::Base')){require Mouse::Util::TypeConstraints;my$sub=$library->can($typename)or return;my$type=Mouse::Util::TypeConstraints::find_type_constraint($sub->())or return;return to_TypeTiny($type)}if ($library->can("get_type")){my$type=$library->get_type($typename);return to_TypeTiny($type)}return}sub lookup {my$self=shift;$self->simple_lookup(@_)or eval_type($_[0],$self)}sub make_union {my$self=shift;my (@types)=@_;require Type::Tiny::Union;return "Type::Tiny::Union"->new(type_constraints=>\@types)}sub make_intersection {my$self=shift;my (@types)=@_;require Type::Tiny::Intersection;return "Type::Tiny::Intersection"->new(type_constraints=>\@types)}sub make_class_type {my$self=shift;my ($class)=@_;require Type::Tiny::Class;return "Type::Tiny::Class"->new(class=>$class)}sub make_role_type {my$self=shift;my ($role)=@_;require Type::Tiny::Role;return "Type::Tiny::Role"->new(role=>$role)}sub AUTOLOAD {my$self=shift;my ($method)=(our$AUTOLOAD =~ /(\w+)$/);my$type=$self->simple_lookup($method);return$type if$type;_croak(q[Can't locate object method "%s" via package "%s"],$method,ref($self))}sub DESTROY {return}DELAYED: {our%DELAYED;for my$package (sort keys%DELAYED){my$reg=__PACKAGE__->for_class($package);my$types=$DELAYED{$package};for my$name (sort keys %$types){$reg->add_type($types->{$name},$name)}}}1; +TYPE_REGISTRY + +$fatpacked{"Type/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_TINY'; + package Type::Tiny;use 5.006001;use strict;use warnings;BEGIN {if ($] < 5.008){require Devel::TypeTiny::Perl56Compat}}BEGIN {$Type::Tiny::AUTHORITY='cpan:TOBYINK';$Type::Tiny::VERSION='1.002001';$Type::Tiny::XS_VERSION='0.011'}use Eval::TypeTiny ();use Scalar::Util qw(blessed weaken refaddr isweak);use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}sub _swap {$_[2]? @_[1,0]: @_[0,1]}BEGIN {($] < 5.010001)? eval q{ sub SUPPORT_SMARTMATCH () { !!0 } } : eval q{ sub SUPPORT_SMARTMATCH () { !!1 } };($] >= 5.014)? eval q{ sub _FIXED_PRECEDENCE () { !!1 } } : eval q{ sub _FIXED_PRECEDENCE () { !!0 } }};BEGIN {my$try_xs=exists($ENV{PERL_TYPE_TINY_XS})?!!$ENV{PERL_TYPE_TINY_XS}: exists($ENV{PERL_ONLY})?!$ENV{PERL_ONLY}: 1;my$use_xs=0;$try_xs and eval {require Type::Tiny::XS;'Type::Tiny::XS'->VERSION($Type::Tiny::XS_VERSION);$use_xs++};*_USE_XS=$use_xs ? sub () {!!1}: sub () {!!0};*_USE_MOUSE=$try_xs ? sub () {$INC{'Mouse/Util.pm'}and Mouse::Util::MOUSE_XS()}: sub () {!!0}};sub __warn__ {my ($msg,$thing)=@_==2 ? @_ : (Thing=>@_);my$string=do {blessed($thing)&& $thing->isa('Type::Tiny::Union')? sprintf('Union[%s]',join q{, },map $_->name,@{$thing->type_constraints}): blessed($thing)&& $thing->isa('Type::Tiny')? $thing->name : blessed($thing)&& $thing->isa('Type::Tiny::_HalfOp')? sprintf('HalfOp[ q{%s}, %s, %s ]',$thing->{op},$thing->{type}->name,$thing->{param}): !defined($thing)? 'NIL' : "$thing"};warn "$msg => $string\n";$thing}use overload q("")=>sub {caller =~ m{^(Moo::HandleMoose|Sub::Quote)} ? overload::StrVal($_[0]): $_[0]->display_name},q(bool)=>sub {1},q(&{})=>"_overload_coderef",q(|)=>sub {my@tc=_swap @_;if (!_FIXED_PRECEDENCE && $_[2]){if (blessed$tc[0]){if (blessed$tc[0]eq "Type::Tiny::_HalfOp"){my$type=$tc[0]->{type};my$param=$tc[0]->{param};my$op=$tc[0]->{op};require Type::Tiny::Union;return "Type::Tiny::_HalfOp"->new($op,$param,"Type::Tiny::Union"->new(type_constraints=>[$type,$tc[1]]),)}}elsif (ref$tc[0]eq 'ARRAY'){require Type::Tiny::_HalfOp;return "Type::Tiny::_HalfOp"->new('|',@tc)}}require Type::Tiny::Union;return "Type::Tiny::Union"->new(type_constraints=>\@tc)},q(&)=>sub {my@tc=_swap @_;if (!_FIXED_PRECEDENCE && $_[2]){if (blessed$tc[0]){if (blessed$tc[0]eq "Type::Tiny::_HalfOp"){my$type=$tc[0]->{type};my$param=$tc[0]->{param};my$op=$tc[0]->{op};require Type::Tiny::Intersection;return "Type::Tiny::_HalfOp"->new($op,$param,"Type::Tiny::Intersection"->new(type_constraints=>[$type,$tc[1]]),)}}elsif (ref$tc[0]eq 'ARRAY'){require Type::Tiny::_HalfOp;return "Type::Tiny::_HalfOp"->new('&',@tc)}}require Type::Tiny::Intersection;"Type::Tiny::Intersection"->new(type_constraints=>\@tc)},q(~)=>sub {shift->complementary_type},q(==)=>sub {$_[0]->equals($_[1])},q(!=)=>sub {not $_[0]->equals($_[1])},q(<)=>sub {my$m=$_[0]->can('is_subtype_of');$m->(_swap @_)},q(>)=>sub {my$m=$_[0]->can('is_subtype_of');$m->(reverse _swap @_)},q(<=)=>sub {my$m=$_[0]->can('is_a_type_of');$m->(_swap @_)},q(>=)=>sub {my$m=$_[0]->can('is_a_type_of');$m->(reverse _swap @_)},q(eq)=>sub {"$_[0]" eq "$_[1]"},q(cmp)=>sub {$_[2]? ("$_[1]" cmp "$_[0]"): ("$_[0]" cmp "$_[1]")},fallback=>1,;BEGIN {overload->import(q(~~)=>sub {$_[0]->check($_[1])},fallback=>1,)if Type::Tiny::SUPPORT_SMARTMATCH}sub _overload_coderef {my$self=shift;$self->message unless exists$self->{message};if (!exists($self->{message})&& exists(&Sub::Quote::quote_sub)&& $self->can_be_inlined){$self->{_overload_coderef}=Sub::Quote::quote_sub($self->inline_assert('$_[0]'))if!$self->{_overload_coderef}||!$self->{_sub_quoted}++}else {$self->{_overload_coderef}||= sub {$self->assert_return(@_)}}$self->{_overload_coderef}}our%ALL_TYPES;my$QFS;my$uniq=1;my$subname;sub new {my$class=shift;my%params=(@_==1)? %{$_[0]}: @_;if (exists$params{constraint}and not ref$params{constraint}and not exists$params{constraint_generator}and not exists$params{inline_generator}){my$code=$params{constraint};$params{constraint}=Eval::TypeTiny::eval_closure(source=>sprintf('sub ($) { %s }',$code),description=>"anonymous check",);$params{inlined}||= sub {my ($type)=@_;my$inlined=$_ eq '$_' ? "do { $code }" : "do { local \$_ = $_; $code }";$type->has_parent ? (undef,$inlined): $inlined}}if (exists$params{parent}){$params{parent}=ref($params{parent})=~ /^Type::Tiny\b/ ? $params{parent}: Types::TypeTiny::to_TypeTiny($params{parent});_croak "Parent must be an instance of %s",__PACKAGE__ unless blessed($params{parent})&& $params{parent}->isa(__PACKAGE__)}$params{name}="__ANON__" unless exists$params{name};$params{uniq}=$uniq++;if ($params{name}ne "__ANON__"){$params{name}=~ /^_{0,2}[A-Z][A-Za-z0-9_]+$/sm or eval q( use 5.008; $params{name} =~ /^_{0,2}\p{Lu}[\p{L}0-9_]+$/sm ) or _croak '"%s" is not a valid type name',$params{name}}if (exists$params{coercion}and!ref$params{coercion}and $params{coercion}){$params{parent}->has_coercion or _croak "coercion => 1 requires type to have a direct parent with a coercion";$params{coercion}=$params{parent}->coercion->type_coercion_map}if (!exists$params{inlined}and exists$params{constraint}and (!exists$params{parent}or $params{parent}->can_be_inlined)and $QFS ||= "Sub::Quote"->can("quoted_from_sub")){my (undef,$perlstring,$captures)=@{$QFS->($params{constraint})|| []};$params{inlined}=sub {my ($self,$var)=@_;my$code=Sub::Quote::inlinify($perlstring,$var,$var eq q($_) ? '' : "local \$_ = $var;",1,);$code=sprintf('%s and %s',$self->parent->inline_check($var),$code)if$self->has_parent;return$code}if$perlstring &&!$captures}my$self=bless \%params,$class;unless ($params{tmp}){my$uniq=$self->{uniq};$ALL_TYPES{$uniq}=$self;weaken($ALL_TYPES{$uniq});package Moo::HandleMoose;my$tmp=$self;Scalar::Util::weaken($tmp);$Moo::HandleMoose::TYPE_MAP{$self}=sub {$tmp}}if (ref($params{coercion})eq q(CODE)){require Types::Standard;my$code=delete($params{coercion});$self->{coercion}=$self->_build_coercion;$self->coercion->add_type_coercions(Types::Standard::Any(),$code)}elsif (ref($params{coercion})eq q(ARRAY)){my$arr=delete($params{coercion});$self->{coercion}=$self->_build_coercion;$self->coercion->add_type_coercions(@$arr)}if ($params{my_methods}){$subname=eval {require Sub::Util}? \&Sub::Util::set_subname : eval {require Sub::Name}? \&Sub::Name::subname : 0 if not defined$subname;if ($subname){$subname->(sprintf("%s::my_%s",$self->qualified_name,$_),$params{my_methods}{$_},)for keys %{$params{my_methods}}}}return$self}sub DESTROY {my$self=shift;delete($ALL_TYPES{$self->{uniq}});package Moo::HandleMoose;delete($Moo::HandleMoose::TYPE_MAP{$self});return}sub _clone {my$self=shift;my%opts;$opts{$_}=$self->{$_}for qw<name display_name message>;$self->create_child_type(%opts)}our$DD;sub _dd {@_=$_ unless @_;my ($value)=@_;goto$DD if ref($DD)eq q(CODE);require B;!defined$value ? 'Undef' : !ref$value ? sprintf('Value %s',B::perlstring($value)): do {my$N=0 + (defined($DD)? $DD : 72);require Data::Dumper;local$Data::Dumper::Indent=0;local$Data::Dumper::Useqq=1;local$Data::Dumper::Terse=1;local$Data::Dumper::Sortkeys=1;local$Data::Dumper::Maxdepth=2;my$str=Data::Dumper::Dumper($value);$str=substr($str,0,$N - 12).'...'.substr($str,-1,1)if length($str)>= $N;"Reference $str"}}sub _loose_to_TypeTiny {map +(ref($_)? Types::TypeTiny::to_TypeTiny($_): do {require Type::Utils;Type::Utils::dwim_type($_)}),@_}sub name {$_[0]{name}}sub display_name {$_[0]{display_name}||= $_[0]->_build_display_name}sub parent {$_[0]{parent}}sub constraint {$_[0]{constraint}||= $_[0]->_build_constraint}sub compiled_check {$_[0]{compiled_type_constraint}||= $_[0]->_build_compiled_check}sub coercion {$_[0]{coercion}||= $_[0]->_build_coercion}sub message {$_[0]{message}}sub library {$_[0]{library}}sub inlined {$_[0]{inlined}}sub constraint_generator {$_[0]{constraint_generator}}sub inline_generator {$_[0]{inline_generator}}sub name_generator {$_[0]{name_generator}||= $_[0]->_build_name_generator}sub coercion_generator {$_[0]{coercion_generator}}sub parameters {$_[0]{parameters}}sub moose_type {$_[0]{moose_type}||= $_[0]->_build_moose_type}sub mouse_type {$_[0]{mouse_type}||= $_[0]->_build_mouse_type}sub deep_explanation {$_[0]{deep_explanation}}sub my_methods {$_[0]{my_methods}||= $_[0]->_build_my_methods}sub has_parent {exists $_[0]{parent}}sub has_library {exists $_[0]{library}}sub has_coercion {$_[0]{coercion}and!!@{$_[0]{coercion}->type_coercion_map}}sub has_inlined {exists $_[0]{inlined}}sub has_constraint_generator {exists $_[0]{constraint_generator}}sub has_inline_generator {exists $_[0]{inline_generator}}sub has_coercion_generator {exists $_[0]{coercion_generator}}sub has_parameters {exists $_[0]{parameters}}sub has_message {defined $_[0]{message}}sub has_deep_explanation {exists $_[0]{deep_explanation}}sub _default_message {$_[0]{_default_message}||= $_[0]->_build_default_message}sub _assert_coercion {my$self=shift;_croak "No coercion for this type constraint" unless$self->has_coercion && @{$self->coercion->type_coercion_map};return$self->coercion}my$null_constraint=sub {!!1};sub _build_display_name {shift->name}sub _build_constraint {return$null_constraint}sub _is_null_constraint {shift->constraint==$null_constraint}sub _build_coercion {require Type::Coercion;my$self=shift;my%opts=(type_constraint=>$self);$opts{display_name}="to_$self" unless$self->is_anon;return "Type::Coercion"->new(%opts)}sub _build_default_message {my$self=shift;return sub {sprintf '%s did not pass type constraint',_dd($_[0])}if "$self" eq "__ANON__";my$name="$self";return sub {sprintf '%s did not pass type constraint "%s"',_dd($_[0]),$name}}sub _build_name_generator {my$self=shift;return sub {my ($s,@a)=@_;sprintf('%s[%s]',$s,join q[,],@a)}}sub _build_compiled_check {my$self=shift;if ($self->_is_null_constraint and $self->has_parent){return$self->parent->compiled_check}return Eval::TypeTiny::eval_closure(source=>sprintf('sub ($) { %s }',$self->inline_check('$_[0]')),description=>sprintf("compiled check '%s'",$self),)if$self->can_be_inlined;my@constraints;push@constraints,$self->parent->compiled_check if$self->has_parent;push@constraints,$self->constraint if!$self->_is_null_constraint;return$null_constraint unless@constraints;return sub ($) {local $_=$_[0];for my$c (@constraints){return unless$c->(@_)}return!!1}}sub equals {my ($self,$other)=_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");return!!1 if refaddr($self)==refaddr($other);return!!1 if$self->has_parent && $self->_is_null_constraint && $self->parent==$other;return!!1 if$other->has_parent && $other->_is_null_constraint && $other->parent==$self;return!!1 if refaddr($self->compiled_check)==refaddr($other->compiled_check);return$self->qualified_name eq $other->qualified_name if$self->has_library &&!$self->is_anon && $other->has_library &&!$other->is_anon;return$self->inline_check('$x')eq $other->inline_check('$x')if$self->can_be_inlined && $other->can_be_inlined;return}sub is_subtype_of {my ($self,$other)=_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");return unless$self->has_parent;$self->parent->equals($other)or $self->parent->is_subtype_of($other)}sub is_supertype_of {my ($self,$other)=_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");$other->is_subtype_of($self)}sub is_a_type_of {my ($self,$other)=_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");$self->equals($other)or $self->is_subtype_of($other)}sub strictly_equals {my ($self,$other)=_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");$self->{uniq}==$other->{uniq}}sub is_strictly_subtype_of {my ($self,$other)=_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");return unless$self->has_parent;$self->parent->strictly_equals($other)or $self->parent->is_strictly_subtype_of($other)}sub is_strictly_supertype_of {my ($self,$other)=_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");$other->is_strictly_subtype_of($self)}sub is_strictly_a_type_of {my ($self,$other)=_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");$self->strictly_equals($other)or $self->is_strictly_subtype_of($other)}sub qualified_name {my$self=shift;(exists$self->{library}and $self->name ne "__ANON__")? "$self->{library}::$self->{name}" : $self->{name}}sub is_anon {my$self=shift;$self->name eq "__ANON__"}sub parents {my$self=shift;return unless$self->has_parent;return ($self->parent,$self->parent->parents)}sub find_parent {my$self=shift;my ($test)=@_;local ($_,$.);my$type=$self;my$count=0;while ($type){if ($test->($_=$type,$.=$count)){return wantarray ? ($type,$count): $type}else {$type=$type->parent;$count++}}return}sub check {my$self=shift;($self->{compiled_type_constraint}||= $self->_build_compiled_check)->(@_)}sub _strict_check {my$self=shift;local $_=$_[0];my@constraints=reverse map {$_->constraint}grep {not $_->_is_null_constraint}($self,$self->parents);for my$c (@constraints){return unless$c->(@_)}return!!1}sub get_message {my$self=shift;local $_=$_[0];$self->has_message ? $self->message->(@_): $self->_default_message->(@_)}sub validate {my$self=shift;return undef if ($self->{compiled_type_constraint}||= $self->_build_compiled_check)->(@_);local $_=$_[0];return$self->get_message(@_)}sub validate_explain {my$self=shift;my ($value,$varname)=@_;$varname='$_' unless defined$varname;return undef if$self->check($value);if ($self->has_parent){my$parent=$self->parent->validate_explain($value,$varname);return [sprintf('"%s" is a subtype of "%s"',$self,$self->parent),@$parent ]if$parent}my$message=sprintf('%s%s',$self->get_message($value),$varname eq q{$_} ? '' : sprintf(' (in %s)',$varname),);if ($self->is_parameterized and $self->parent->has_deep_explanation){my$deep=$self->parent->deep_explanation->($self,$value,$varname);return [$message,@$deep ]if$deep}return [$message,sprintf('"%s" is defined as: %s',$self,$self->_perlcode)]}my$b;sub _perlcode {my$self=shift;return$self->inline_check('$_')if$self->can_be_inlined;$b ||= do {require B::Deparse;my$tmp="B::Deparse"->new;$tmp->ambient_pragmas(strict=>"all",warnings=>"all")if$tmp->can('ambient_pragmas');$tmp};my$code=$b->coderef2text($self->constraint);$code =~ s/\s+/ /g;return "sub $code"}sub assert_valid {my$self=shift;return!!1 if ($self->{compiled_type_constraint}||= $self->_build_compiled_check)->(@_);local $_=$_[0];$self->_failed_check("$self",$_)}sub assert_return {my$self=shift;return $_[0]if ($self->{compiled_type_constraint}||= $self->_build_compiled_check)->(@_);local $_=$_[0];$self->_failed_check("$self",$_)}sub can_be_inlined {my$self=shift;return$self->parent->can_be_inlined if$self->has_parent && $self->_is_null_constraint;return!!1 if!$self->has_parent && $self->_is_null_constraint;return$self->has_inlined}sub inline_check {my$self=shift;_croak 'Cannot inline type constraint check for "%s"',$self unless$self->can_be_inlined;return$self->parent->inline_check(@_)if$self->has_parent && $self->_is_null_constraint;return '(!!1)' if!$self->has_parent && $self->_is_null_constraint;local $_=$_[0];my@r=$self->inlined->($self,@_);if (@r and not defined$r[0]){_croak 'Inlining type constraint check for "%s" returned undef!',$self unless$self->has_parent;$r[0]=$self->parent->inline_check(@_)}my$r=join " && "=>map {/[;{}]/ ? "do { $_ }" : "($_)"}@r;return@r==1 ? $r : "($r)"}sub inline_assert {require B;my$self=shift;my$varname=$_[0];my$code=sprintf(q[do { no warnings "void"; %s ? %s : Type::Tiny::_failed_check(%d, %s, %s) };],$self->inline_check(@_),$varname,$self->{uniq},B::perlstring("$self"),$varname,);return$code}sub _failed_check {require Error::TypeTiny::Assertion;my ($self,$name,$value,%attrs)=@_;$self=$ALL_TYPES{$self}unless ref$self;my$exception_class=delete($attrs{exception_class})|| "Error::TypeTiny::Assertion";if ($self){$exception_class->throw(message=>$self->get_message($value),type=>$self,value=>$value,%attrs,)}else {$exception_class->throw(message=>sprintf('%s did not pass type constraint "%s"',_dd($value),$name),value=>$value,%attrs,)}}sub coerce {my$self=shift;$self->_assert_coercion->coerce(@_)}sub assert_coerce {my$self=shift;$self->_assert_coercion->assert_coerce(@_)}sub is_parameterizable {shift->has_constraint_generator}sub is_parameterized {shift->has_parameters}my%param_cache;sub parameterize {my$self=shift;$self->is_parameterizable or @_ ? _croak("Type '%s' does not accept parameters","$self"): return($self);@_=map Types::TypeTiny::to_TypeTiny($_),@_;my$key;if (not grep(ref($_)&&!Types::TypeTiny::TypeTiny->check($_),@_)){require B;$key=join ":",map(Types::TypeTiny::TypeTiny->check($_)? $_->{uniq}: B::perlstring($_),$self,@_)}return$param_cache{$key}if defined$key && defined$param_cache{$key};local$Type::Tiny::parameterize_type=$self;local $_=$_[0];my$P;my ($constraint,$compiled)=$self->constraint_generator->(@_);if (Types::TypeTiny::TypeTiny->check($constraint)){$P=$constraint}else {my%options=(constraint=>$constraint,display_name=>$self->name_generator->($self,@_),parameters=>[@_],);$options{compiled_type_constraint}=$compiled if$compiled;$options{inlined}=$self->inline_generator->(@_)if$self->has_inline_generator;exists$options{$_}&&!defined$options{$_}&& delete$options{$_}for keys%options;$P=$self->create_child_type(%options);my$coercion;$coercion=$self->coercion_generator->($self,$P,@_)if$self->has_coercion_generator;$P->coercion->add_type_coercions(@{$coercion->type_coercion_map})if$coercion}if (defined$key){$param_cache{$key}=$P;weaken($param_cache{$key})}$P->coercion->freeze;return$P}sub child_type_class {__PACKAGE__}sub create_child_type {my$self=shift;return$self->child_type_class->new(parent=>$self,@_)}sub complementary_type {my$self=shift;my$r=($self->{complementary_type}||= $self->_build_complementary_type);weaken($self->{complementary_type})unless isweak($self->{complementary_type});return$r}sub _build_complementary_type {my$self=shift;my%opts=(constraint=>sub {not $self->check($_)},display_name=>sprintf("~%s",$self),);$opts{display_name}=~ s/^\~{2}//;$opts{inlined}=sub {shift;"not(".$self->inline_check(@_).")"}if$self->can_be_inlined;return "Type::Tiny"->new(%opts)}sub _instantiate_moose_type {my$self=shift;my%opts=@_;require Moose::Meta::TypeConstraint;return "Moose::Meta::TypeConstraint"->new(%opts)}sub _build_moose_type {my$self=shift;my$r;if ($self->{_is_core}){require Moose::Util::TypeConstraints;$r=Moose::Util::TypeConstraints::find_type_constraint($self->name);$r->{"Types::TypeTiny::to_TypeTiny"}=$self;Scalar::Util::weaken($r->{"Types::TypeTiny::to_TypeTiny"})}else {my$wrapped_inlined=sub {shift;$self->inline_check(@_)};my%opts;$opts{name}=$self->qualified_name if$self->has_library &&!$self->is_anon;$opts{parent}=$self->parent->moose_type if$self->has_parent;$opts{constraint}=$self->constraint unless$self->_is_null_constraint;$opts{message}=$self->message if$self->has_message;$opts{inlined}=$wrapped_inlined if$self->has_inlined;$r=$self->_instantiate_moose_type(%opts);$r->{"Types::TypeTiny::to_TypeTiny"}=$self;$self->{moose_type}=$r;$r->coercion($self->coercion->moose_coercion)if$self->has_coercion}return$r}sub _build_mouse_type {my$self=shift;my%options;$options{name}=$self->qualified_name if$self->has_library &&!$self->is_anon;$options{parent}=$self->parent->mouse_type if$self->has_parent;$options{constraint}=$self->constraint unless$self->_is_null_constraint;$options{message}=$self->message if$self->has_message;require Mouse::Meta::TypeConstraint;my$r="Mouse::Meta::TypeConstraint"->new(%options);$self->{mouse_type}=$r;$r->_add_type_coercions($self->coercion->freeze->_codelike_type_coercion_map('mouse_type'))if$self->has_coercion;return$r}sub _process_coercion_list {my$self=shift;my@pairs;while (@_){my$next=shift;if (blessed($next)and $next->isa('Type::Coercion')and $next->is_parameterized){push@pairs=>(@{$next->_reparameterize($self)->type_coercion_map})}elsif (blessed($next)and $next->can('type_coercion_map')){push@pairs=>(@{$next->type_coercion_map},)}elsif (ref($next)eq q(ARRAY)){unshift @_,@$next}else {push@pairs=>(Types::TypeTiny::to_TypeTiny($next),shift,)}}return@pairs}sub plus_coercions {my$self=shift;my$new=$self->_clone;$new->coercion->add_type_coercions($self->_process_coercion_list(@_),@{$self->coercion->type_coercion_map},);$new->coercion->freeze;return$new}sub plus_fallback_coercions {my$self=shift;my$new=$self->_clone;$new->coercion->add_type_coercions(@{$self->coercion->type_coercion_map},$self->_process_coercion_list(@_),);$new->coercion->freeze;return$new}sub minus_coercions {my$self=shift;my$new=$self->_clone;my@not=grep Types::TypeTiny::TypeTiny->check($_),$self->_process_coercion_list($new,@_);my@keep;my$c=$self->coercion->type_coercion_map;for (my$i=0;$i <= $#$c;$i += 2){my$keep_this=1;NOT: for my$n (@not){if ($c->[$i]==$n){$keep_this=0;last NOT}}push@keep,$c->[$i],$c->[$i+1]if$keep_this}$new->coercion->add_type_coercions(@keep);$new->coercion->freeze;return$new}sub no_coercions {my$new=shift->_clone;$new->coercion->freeze;$new}sub coercibles {my$self=shift;$self->has_coercion ? $self->coercion->_source_type_union : $self}sub isa {my$self=shift;if ($INC{"Moose.pm"}and ref($self)and $_[0]=~ /^(?:Class::MOP|MooseX?::Meta)::(.+)$/){my$meta=$1;return!!1 if$meta eq 'TypeConstraint';return$self->is_parameterized if$meta eq 'TypeConstraint::Parameterized';return$self->is_parameterizable if$meta eq 'TypeConstraint::Parameterizable';return$self->isa('Type::Tiny::Union')if$meta eq 'TypeConstraint::Union';my$inflate=$self->moose_type;return$inflate->isa(@_)}if ($INC{"Mouse.pm"}and ref($self)and $_[0]eq 'Mouse::Meta::TypeConstraint'){return!!1}$self->SUPER::isa(@_)}sub _build_my_methods {return {}}sub _lookup_my_method {my$self=shift;my ($name)=@_;if ($self->my_methods->{$name}){return$self->my_methods->{$name}}if ($self->has_parent){return$self->parent->_lookup_my_method(@_)}return}sub can {my$self=shift;return!!0 if $_[0]eq 'type_parameter' && blessed($_[0])&& $_[0]->has_parameters;my$can=$self->SUPER::can(@_);return$can if$can;if (ref($self)){if ($INC{"Moose.pm"}){my$method=$self->moose_type->can(@_);return sub {shift->moose_type->$method(@_)}if$method}if ($_[0]=~ /\Amy_(.+)\z/){my$method=$self->_lookup_my_method($1);return$method if$method}}return}sub AUTOLOAD {my$self=shift;my ($m)=(our$AUTOLOAD =~ /::(\w+)$/);return if$m eq 'DESTROY';if (ref($self)){if ($INC{"Moose.pm"}){my$method=$self->moose_type->can($m);return$self->moose_type->$method(@_)if$method}if ($m =~ /\Amy_(.+)\z/){my$method=$self->_lookup_my_method($1);return$self->$method(@_)if$method}}_croak q[Can't locate object method "%s" via package "%s"],$m,ref($self)||$self}sub DOES {my$self=shift;return!!1 if ref($self)&& $_[0]=~ m{^ Type::API::Constraint (?: ::Coercible | ::Inlinable )? $}x;return!!1 if!ref($self)&& $_[0]eq 'Type::API::Constraint::Constructor';"UNIVERSAL"->can("DOES")? $self->SUPER::DOES(@_): $self->isa(@_)}sub _has_xsub {require B;!!B::svref_2object(shift->compiled_check)->XSUB}sub of {shift->parameterize(@_)}sub where {shift->create_child_type(constraint=>@_)}sub inline_environment {+{}}sub _inline_check {shift->inline_check(@_)}sub _compiled_type_constraint {shift->compiled_check(@_)}sub meta {_croak("Not really a Moose::Meta::TypeConstraint. Sorry!")}sub compile_type_constraint {shift->compiled_check}sub _actually_compile_type_constraint {shift->_build_compiled_check}sub hand_optimized_type_constraint {shift->{hand_optimized_type_constraint}}sub has_hand_optimized_type_constraint {exists(shift->{hand_optimized_type_constraint})}sub type_parameter {(shift->parameters || [])->[0]}sub __is_parameterized {shift->is_parameterized(@_)}sub _add_type_coercions {shift->coercion->add_type_coercions(@_)};sub _as_string {shift->qualified_name(@_)}sub _compiled_type_coercion {shift->coercion->compiled_coercion(@_)};sub _identity {refaddr(shift)};sub _unite {require Type::Tiny::Union;"Type::Tiny::Union"->new(type_constraints=>\@_)};sub TIESCALAR {require Type::Tie;unshift @_,'Type::Tie::SCALAR';goto \&Type::Tie::SCALAR::TIESCALAR};sub TIEARRAY {require Type::Tie;unshift @_,'Type::Tie::ARRAY';goto \&Type::Tie::ARRAY::TIEARRAY};sub TIEHASH {require Type::Tie;unshift @_,'Type::Tie::HASH';goto \&Type::Tie::HASH::TIEHASH};1; +TYPE_TINY + +$fatpacked{"Type/Tiny/Class.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_TINY_CLASS'; + package Type::Tiny::Class;use 5.006001;use strict;use warnings;BEGIN {if ($] < 5.008){require Devel::TypeTiny::Perl56Compat}}BEGIN {$Type::Tiny::Class::AUTHORITY='cpan:TOBYINK';$Type::Tiny::Class::VERSION='1.002001'}use Scalar::Util qw<blessed>;sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}use Type::Tiny ();our@ISA='Type::Tiny';sub new {my$proto=shift;return$proto->class->new(@_)if blessed$proto;my%opts=(@_==1)? %{$_[0]}: @_;_croak "Class type constraints cannot have a parent constraint passed to the constructor" if exists$opts{parent};_croak "Class type constraints cannot have a constraint coderef passed to the constructor" if exists$opts{constraint};_croak "Class type constraints cannot have a inlining coderef passed to the constructor" if exists$opts{inlined};_croak "Need to supply class name" unless exists$opts{class};if (Type::Tiny::_USE_XS){my$xsub=Type::Tiny::XS::get_coderef_for("InstanceOf[".$opts{class}."]");$opts{compiled_type_constraint}=$xsub if$xsub}elsif (Type::Tiny::_USE_MOUSE){require Mouse::Util::TypeConstraints;my$maker="Mouse::Util::TypeConstraints"->can("generate_isa_predicate_for");$opts{compiled_type_constraint}=$maker->($opts{class})if$maker}return$proto->SUPER::new(%opts)}sub class {$_[0]{class}}sub inlined {$_[0]{inlined}||= $_[0]->_build_inlined}sub has_inlined {!!1}sub _build_constraint {my$self=shift;my$class=$self->class;return sub {blessed($_)and $_->isa($class)}}sub _build_inlined {my$self=shift;my$class=$self->class;if (Type::Tiny::_USE_XS){my$xsub=Type::Tiny::XS::get_subname_for("InstanceOf[$class]");return sub {my$var=$_[1];"$xsub\($var\)"}if$xsub}sub {my$var=$_[1];qq{Scalar::Util::blessed($var) and $var->isa(q[$class])}}}sub _build_default_message {no warnings 'uninitialized';my$self=shift;my$c=$self->class;return sub {sprintf '%s did not pass type constraint (not isa %s)',Type::Tiny::_dd($_[0]),$c}if$self->is_anon;my$name="$self";return sub {sprintf '%s did not pass type constraint "%s" (not isa %s)',Type::Tiny::_dd($_[0]),$name,$c}}sub _instantiate_moose_type {my$self=shift;my%opts=@_;delete$opts{parent};delete$opts{constraint};delete$opts{inlined};require Moose::Meta::TypeConstraint::Class;return "Moose::Meta::TypeConstraint::Class"->new(%opts,class=>$self->class)}sub plus_constructors {my$self=shift;unless (@_){require Types::Standard;push @_,Types::Standard::HashRef(),"new"}require B;require Types::TypeTiny;my$class=B::perlstring($self->class);my@r;while (@_){my$source=shift;Types::TypeTiny::TypeTiny->check($source)or _croak "Expected type constraint; got $source";my$constructor=shift;Types::TypeTiny::StringLike->check($constructor)or _croak "Expected string; got $constructor";push@r,$source,sprintf('%s->%s($_)',$class,$constructor)}return$self->plus_coercions(\@r)}sub has_parent {!!1}sub parent {$_[0]{parent}||= $_[0]->_build_parent}sub _build_parent {my$self=shift;my$class=$self->class;my@isa=grep$class->isa($_),do {no strict "refs";no warnings;@{"$class\::ISA"}};if (@isa==0){require Types::Standard;return Types::Standard::Object()}if (@isa==1){return ref($self)->new(class=>$isa[0])}require Type::Tiny::Intersection;"Type::Tiny::Intersection"->new(type_constraints=>[map ref($self)->new(class=>$_),@isa ],)}*__get_linear_isa_dfs=eval {require mro}? \&mro::get_linear_isa : sub {no strict 'refs';my$classname=shift;my@lin=($classname);my%stored;for my$parent (@{"$classname\::ISA"}){my$plin=__get_linear_isa_dfs($parent);for (@$plin){next if exists$stored{$_};push(@lin,$_);$stored{$_}=1}}return \@lin};sub validate_explain {my$self=shift;my ($value,$varname)=@_;$varname='$_' unless defined$varname;return undef if$self->check($value);return ["Not a blessed reference"]unless blessed($value);my@isa=@{__get_linear_isa_dfs(ref$value)};my$display_var=$varname eq q{$_} ? '' : sprintf(' (in %s)',$varname);require Type::Utils;return [sprintf('"%s" requires that the reference isa %s',$self,$self->class),sprintf('The reference%s isa %s',$display_var,Type::Utils::english_list(@isa)),]}1; +TYPE_TINY_CLASS + +$fatpacked{"Type/Tiny/Duck.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_TINY_DUCK'; + package Type::Tiny::Duck;use 5.006001;use strict;use warnings;BEGIN {$Type::Tiny::Duck::AUTHORITY='cpan:TOBYINK';$Type::Tiny::Duck::VERSION='1.002001'}use Scalar::Util qw<blessed>;sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}use Type::Tiny ();our@ISA='Type::Tiny';sub new {my$proto=shift;my%opts=(@_==1)? %{$_[0]}: @_;_croak "Duck type constraints cannot have a parent constraint passed to the constructor" if exists$opts{parent};_croak "Duck type constraints cannot have a constraint coderef passed to the constructor" if exists$opts{constraint};_croak "Duck type constraints cannot have a inlining coderef passed to the constructor" if exists$opts{inlined};_croak "Need to supply list of methods" unless exists$opts{methods};$opts{methods}=[$opts{methods}]unless ref$opts{methods};if (Type::Tiny::_USE_XS){my$methods=join ",",sort(@{$opts{methods}});my$xsub=Type::Tiny::XS::get_coderef_for("HasMethods[$methods]");$opts{compiled_type_constraint}=$xsub if$xsub}elsif (Type::Tiny::_USE_MOUSE){require Mouse::Util::TypeConstraints;my$maker="Mouse::Util::TypeConstraints"->can("generate_can_predicate_for");$opts{compiled_type_constraint}=$maker->($opts{methods})if$maker}return$proto->SUPER::new(%opts)}sub methods {$_[0]{methods}}sub inlined {$_[0]{inlined}||= $_[0]->_build_inlined}sub has_inlined {!!1}sub _build_constraint {my$self=shift;my@methods=@{$self->methods};return sub {blessed($_[0])and not grep(!$_[0]->can($_),@methods)}}sub _build_inlined {my$self=shift;my@methods=@{$self->methods};if (Type::Tiny::_USE_XS){my$methods=join ",",sort(@{$self->methods});my$xsub=Type::Tiny::XS::get_subname_for("HasMethods[$methods]");return sub {my$var=$_[1];"$xsub\($var\)"}if$xsub}sub {my$var=$_[1];local $"=q{ };($var =~ /\$_/)? qq{ Scalar::Util::blessed($var) and not do { my \$tmp = $var; grep(!\$tmp->can(\$_), qw/@methods/) } } : qq{ Scalar::Util::blessed($var) and not grep(!$var->can(\$_), qw/@methods/) }}}sub _instantiate_moose_type {my$self=shift;my%opts=@_;delete$opts{parent};delete$opts{constraint};delete$opts{inlined};require Moose::Meta::TypeConstraint::DuckType;return "Moose::Meta::TypeConstraint::DuckType"->new(%opts,methods=>$self->methods)}sub has_parent {!!1}sub parent {require Types::Standard;Types::Standard::Object()}sub validate_explain {my$self=shift;my ($value,$varname)=@_;$varname='$_' unless defined$varname;return undef if$self->check($value);return ["Not a blessed reference"]unless blessed($value);require Type::Utils;return [sprintf('"%s" requires that the reference can %s',$self,Type::Utils::english_list(map qq["$_"],@{$self->methods}),),map sprintf('The reference cannot "%s"',$_),grep!$value->can($_),@{$self->methods}]}1; +TYPE_TINY_DUCK + +$fatpacked{"Type/Tiny/Enum.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_TINY_ENUM'; + package Type::Tiny::Enum;use 5.006001;use strict;use warnings;BEGIN {$Type::Tiny::Enum::AUTHORITY='cpan:TOBYINK';$Type::Tiny::Enum::VERSION='1.002001'}sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}use overload q[@{}]=>'values';use Type::Tiny ();our@ISA='Type::Tiny';sub new {my$proto=shift;my%opts=(@_==1)? %{$_[0]}: @_;_croak "Enum type constraints cannot have a parent constraint passed to the constructor" if exists$opts{parent};_croak "Enum type constraints cannot have a constraint coderef passed to the constructor" if exists$opts{constraint};_croak "Enum type constraints cannot have a inlining coderef passed to the constructor" if exists$opts{inlined};_croak "Need to supply list of values" unless exists$opts{values};my%tmp=map {$_=>1}@{ref$opts{values}eq "ARRAY" ? $opts{values}: [$opts{values}]};$opts{values}=[sort keys%tmp];if (Type::Tiny::_USE_XS and not grep /[^-\w]/,@{$opts{values}}){my$enum=join ",",@{$opts{values}};my$xsub=Type::Tiny::XS::get_coderef_for("Enum[$enum]");$opts{compiled_type_constraint}=$xsub if$xsub}return$proto->SUPER::new(%opts)}sub values {$_[0]{values}}sub constraint {$_[0]{constraint}||= $_[0]->_build_constraint}sub _build_display_name {my$self=shift;sprintf("Enum[%s]",join q[,],@$self)}sub _build_constraint {my$self=shift;my$regexp=join "|",map quotemeta,@$self;return sub {defined and m{\A(?:$regexp)\z}}}sub can_be_inlined {!!1}sub inline_check {my$self=shift;if (Type::Tiny::_USE_XS){my$enum=join ",",@{$self->values};my$xsub=Type::Tiny::XS::get_subname_for("Enum[$enum]");return "$xsub\($_[0]\)" if$xsub}my$regexp=join "|",map quotemeta,@$self;$_[0]eq '$_' ? "(defined and !ref and m{\\A(?:$regexp)\\z})" : "(defined($_[0]) and !ref($_[0]) and $_[0] =~ m{\\A(?:$regexp)\\z})"}sub _instantiate_moose_type {my$self=shift;my%opts=@_;delete$opts{parent};delete$opts{constraint};delete$opts{inlined};require Moose::Meta::TypeConstraint::Enum;return "Moose::Meta::TypeConstraint::Enum"->new(%opts,values=>$self->values)}sub has_parent {!!1}sub parent {require Types::Standard;Types::Standard::Str()}sub validate_explain {my$self=shift;my ($value,$varname)=@_;$varname='$_' unless defined$varname;return undef if$self->check($value);require Type::Utils;!defined($value)? [sprintf('"%s" requires that the value is defined',$self,),]: @$self < 13 ? [sprintf('"%s" requires that the value is equal to %s',$self,Type::Utils::english_list(\"or",map B::perlstring($_),@$self),),]: [sprintf('"%s" requires that the value is one of an enumerated list of strings',$self,),]}1; +TYPE_TINY_ENUM + +$fatpacked{"Type/Tiny/Intersection.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_TINY_INTERSECTION'; + package Type::Tiny::Intersection;use 5.006001;use strict;use warnings;BEGIN {$Type::Tiny::Intersection::AUTHORITY='cpan:TOBYINK';$Type::Tiny::Intersection::VERSION='1.002001'}use Scalar::Util qw<blessed>;use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}use overload q[@{}]=>sub {$_[0]{type_constraints}||= []};use Type::Tiny ();our@ISA='Type::Tiny';sub new {my$proto=shift;my%opts=(@_==1)? %{$_[0]}: @_;_croak "Intersection type constraints cannot have a parent constraint" if exists$opts{parent};_croak "Intersection type constraints cannot have a constraint coderef passed to the constructor" if exists$opts{constraint};_croak "Intersection type constraints cannot have a inlining coderef passed to the constructor" if exists$opts{inlined};_croak "Need to supply list of type constraints" unless exists$opts{type_constraints};$opts{type_constraints}=[map {$_->isa(__PACKAGE__)? @$_ : $_}map Types::TypeTiny::to_TypeTiny($_),@{ref$opts{type_constraints}eq "ARRAY" ? $opts{type_constraints}: [$opts{type_constraints}]}];if (Type::Tiny::_USE_XS){my@constraints=@{$opts{type_constraints}};my@known=map {my$known=Type::Tiny::XS::is_known($_->compiled_check);defined($known)? $known : ()}@constraints;if (@known==@constraints){my$xsub=Type::Tiny::XS::get_coderef_for(sprintf "AllOf[%s]",join(',',@known));$opts{compiled_type_constraint}=$xsub if$xsub}}return$proto->SUPER::new(%opts)}sub type_constraints {$_[0]{type_constraints}}sub constraint {$_[0]{constraint}||= $_[0]->_build_constraint}sub _build_display_name {my$self=shift;join q[&],@$self}sub _build_constraint {my@checks=map $_->compiled_check,@{+shift};return sub {my$val=$_;$_->($val)|| return for@checks;return!!1}}sub can_be_inlined {my$self=shift;not grep!$_->can_be_inlined,@$self}sub inline_check {my$self=shift;if (Type::Tiny::_USE_XS and!exists$self->{xs_sub}){$self->{xs_sub}=undef;my@constraints=@{$self->type_constraints};my@known=map {my$known=Type::Tiny::XS::is_known($_->compiled_check);defined($known)? $known : ()}@constraints;if (@known==@constraints){$self->{xs_sub}=Type::Tiny::XS::get_subname_for(sprintf "AllOf[%s]",join(',',@known))}}if (Type::Tiny::_USE_XS and $self->{xs_sub}){return "$self->{xs_sub}\($_[0]\)"}sprintf '(%s)',join " and ",map $_->inline_check($_[0]),@$self}sub has_parent {!!@{$_[0]{type_constraints}}}sub parent {$_[0]{type_constraints}[0]}sub validate_explain {my$self=shift;my ($value,$varname)=@_;$varname='$_' unless defined$varname;return undef if$self->check($value);require Type::Utils;for my$type (@$self){my$deep=$type->validate_explain($value,$varname);return [sprintf('"%s" requires that the value pass %s',$self,Type::Utils::english_list(map qq["$_"],@$self),),@$deep,]if$deep}return}1; +TYPE_TINY_INTERSECTION + +$fatpacked{"Type/Tiny/Role.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_TINY_ROLE'; + package Type::Tiny::Role;use 5.006001;use strict;use warnings;BEGIN {$Type::Tiny::Role::AUTHORITY='cpan:TOBYINK';$Type::Tiny::Role::VERSION='1.002001'}use Scalar::Util qw<blessed weaken>;sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}require Type::Tiny;our@ISA='Type::Tiny';my%cache;sub new {my$proto=shift;my%opts=(@_==1)? %{$_[0]}: @_;_croak "Role type constraints cannot have a parent constraint passed to the constructor" if exists$opts{parent};_croak "Role type constraints cannot have a constraint coderef passed to the constructor" if exists$opts{constraint};_croak "Role type constraints cannot have a inlining coderef passed to the constructor" if exists$opts{inlined};_croak "Need to supply role name" unless exists$opts{role};return$proto->SUPER::new(%opts)}sub role {$_[0]{role}}sub inlined {$_[0]{inlined}||= $_[0]->_build_inlined}sub has_inlined {!!1}sub _build_constraint {my$self=shift;my$role=$self->role;return sub {blessed($_)and do {my$method=$_->can('DOES')||$_->can('isa');$_->$method($role)}}}sub _build_inlined {my$self=shift;my$role=$self->role;sub {my$var=$_[1];qq{Scalar::Util::blessed($var) and do { my \$method = $var->can('DOES')||$var->can('isa'); $var->\$method(q[$role]) }}}}sub _build_default_message {my$self=shift;my$c=$self->role;return sub {sprintf '%s did not pass type constraint (not DOES %s)',Type::Tiny::_dd($_[0]),$c}if$self->is_anon;my$name="$self";return sub {sprintf '%s did not pass type constraint "%s" (not DOES %s)',Type::Tiny::_dd($_[0]),$name,$c}}sub has_parent {!!1}sub parent {require Types::Standard;Types::Standard::Object()}sub validate_explain {my$self=shift;my ($value,$varname)=@_;$varname='$_' unless defined$varname;return undef if$self->check($value);return ["Not a blessed reference"]unless blessed($value);return ["Reference provides no DOES method to check roles"]unless$value->can('DOES');my$display_var=$varname eq q{$_} ? '' : sprintf(' (in %s)',$varname);return [sprintf('"%s" requires that the reference does %s',$self,$self->role),sprintf("The reference%s doesn't %s",$display_var,$self->role),]}1; +TYPE_TINY_ROLE + +$fatpacked{"Type/Tiny/Union.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_TINY_UNION'; + package Type::Tiny::Union;use 5.006001;use strict;use warnings;BEGIN {$Type::Tiny::Union::AUTHORITY='cpan:TOBYINK';$Type::Tiny::Union::VERSION='1.002001'}use Scalar::Util qw<blessed>;use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}use overload q[@{}]=>sub {$_[0]{type_constraints}||= []};use Type::Tiny ();our@ISA='Type::Tiny';sub new {my$proto=shift;my%opts=(@_==1)? %{$_[0]}: @_;_croak "Union type constraints cannot have a parent constraint passed to the constructor" if exists$opts{parent};_croak "Union type constraints cannot have a constraint coderef passed to the constructor" if exists$opts{constraint};_croak "Union type constraints cannot have a inlining coderef passed to the constructor" if exists$opts{inlined};_croak "Need to supply list of type constraints" unless exists$opts{type_constraints};$opts{type_constraints}=[map {$_->isa(__PACKAGE__)? @$_ : $_}map Types::TypeTiny::to_TypeTiny($_),@{ref$opts{type_constraints}eq "ARRAY" ? $opts{type_constraints}: [$opts{type_constraints}]}];if (Type::Tiny::_USE_XS){my@constraints=@{$opts{type_constraints}};my@known=map {my$known=Type::Tiny::XS::is_known($_->compiled_check);defined($known)? $known : ()}@constraints;if (@known==@constraints){my$xsub=Type::Tiny::XS::get_coderef_for(sprintf "AnyOf[%s]",join(',',@known));$opts{compiled_type_constraint}=$xsub if$xsub}}my$self=$proto->SUPER::new(%opts);$self->coercion if grep $_->has_coercion,@$self;return$self}sub type_constraints {$_[0]{type_constraints}}sub constraint {$_[0]{constraint}||= $_[0]->_build_constraint}sub _build_display_name {my$self=shift;join q[|],@$self}sub _build_coercion {require Type::Coercion::Union;my$self=shift;return "Type::Coercion::Union"->new(type_constraint=>$self)}sub _build_constraint {my@checks=map $_->compiled_check,@{+shift};return sub {my$val=$_;$_->($val)&& return!!1 for@checks;return}}sub can_be_inlined {my$self=shift;not grep!$_->can_be_inlined,@$self}sub inline_check {my$self=shift;if (Type::Tiny::_USE_XS and!exists$self->{xs_sub}){$self->{xs_sub}=undef;my@constraints=@{$self->type_constraints};my@known=map {my$known=Type::Tiny::XS::is_known($_->compiled_check);defined($known)? $known : ()}@constraints;if (@known==@constraints){$self->{xs_sub}=Type::Tiny::XS::get_subname_for(sprintf "AnyOf[%s]",join(',',@known))}}if (Type::Tiny::_USE_XS and $self->{xs_sub}){return "$self->{xs_sub}\($_[0]\)"}sprintf '(%s)',join " or ",map $_->inline_check($_[0]),@$self}sub _instantiate_moose_type {my$self=shift;my%opts=@_;delete$opts{parent};delete$opts{constraint};delete$opts{inlined};my@tc=map $_->moose_type,@{$self->type_constraints};require Moose::Meta::TypeConstraint::Union;return "Moose::Meta::TypeConstraint::Union"->new(%opts,type_constraints=>\@tc)}sub has_parent {defined(shift->parent)}sub parent {$_[0]{parent}||= $_[0]->_build_parent}sub _build_parent {my$self=shift;my ($first,@rest)=@$self;for my$parent ($first,$first->parents){return$parent unless grep!$_->is_a_type_of($parent),@rest}return}sub find_type_for {my@types=@{+shift};for my$type (@types){return$type if$type->check(@_)}return}sub validate_explain {my$self=shift;my ($value,$varname)=@_;$varname='$_' unless defined$varname;return undef if$self->check($value);require Type::Utils;return [sprintf('"%s" requires that the value pass %s',$self,Type::Utils::english_list(\"or",map qq["$_"],@$self),),map {$_->get_message($value),map(" $_",@{$_->validate_explain($value)|| []}),}@$self ]}sub equals {my ($self,$other)=Type::Tiny::_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");return!!1 if$self->SUPER::equals($other);return!!0 unless$other->isa(__PACKAGE__);my@self_constraints=@{$self->type_constraints};my@other_constraints=@{$other->type_constraints};return!!0 unless@self_constraints==@other_constraints;constraint: foreach my$constraint (@self_constraints){for (my$i=0;$i < @other_constraints;$i++ ){if ($constraint->equals($other_constraints[$i])){splice@other_constraints,$i,1;next constraint}}}@other_constraints==0}sub is_a_type_of {my ($self,$other)=Type::Tiny::_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");return!!1 if$self->SUPER::is_a_type_of($other);for my$tc (@{$self->type_constraints}){return!!0 unless$tc->is_a_type_of($other)}return!!1}sub is_subtype_of {my ($self,$other)=Type::Tiny::_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");return!!1 if$self->SUPER::is_subtype_of($other);for my$tc (@{$self->type_constraints}){return!!0 unless$tc->is_subtype_of($other)}return!!1}sub is_supertype_of {my ($self,$other)=Type::Tiny::_loose_to_TypeTiny(@_);return unless blessed($self)&& $self->isa("Type::Tiny");return unless blessed($other)&& $other->isa("Type::Tiny");return!!1 if$self->SUPER::is_supertype_of($other);for my$tc (@{$self->type_constraints}){return!!1 if$tc->equals($other);return!!1 if$tc->is_supertype_of($other)}return!!0}1; +TYPE_TINY_UNION + +$fatpacked{"Type/Tiny/_HalfOp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_TINY__HALFOP'; + package Type::Tiny::_HalfOp;use 5.006001;use strict;use warnings;BEGIN {$Type::Tiny::_HalfOp::AUTHORITY='cpan:TOBYINK';$Type::Tiny::_HalfOp::VERSION='1.002001'}use overload ();sub new {my ($class,$op,$param,$type)=@_;bless {op=>$op,param=>$param,type=>$type,},$class}sub complete {my ($self,$type)=@_;my$complete_type=$type->parameterize(@{$self->{param}});my$method=overload::Method($complete_type,$self->{op});$complete_type->$method($self->{type})}1; +TYPE_TINY__HALFOP + +$fatpacked{"Type/Utils.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPE_UTILS'; + package Type::Utils;use 5.006001;use strict;use warnings;BEGIN {$Type::Utils::AUTHORITY='cpan:TOBYINK';$Type::Utils::VERSION='1.002001'}sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}use Scalar::Util qw<blessed>;use Type::Library;use Type::Tiny;use Types::TypeTiny qw<TypeTiny to_TypeTiny HashLike StringLike CodeLike>;our@EXPORT=qw<declare as where message inline_as class_type role_type duck_type union intersection enum coerce from via declare_coercion to_type>;our@EXPORT_OK=(@EXPORT,qw<extends type subtype match_on_type compile_match_on_type dwim_type english_list classifier>,);require Exporter::Tiny;our@ISA='Exporter::Tiny';sub extends {_croak "Not a type library" unless caller->isa("Type::Library");my$caller=caller->meta;for my$lib (@_){eval "use $lib; 1" or _croak "Could not load library '$lib': $@";if ($lib->isa("Type::Library")or $lib eq 'Types::TypeTiny'){$caller->add_type($lib->get_type($_))for sort$lib->meta->type_names;$caller->add_coercion($lib->get_coercion($_))for sort$lib->meta->coercion_names}elsif ($lib->isa('MooseX::Types::Base')){require Moose::Util::TypeConstraints;my$types=$lib->type_storage;for my$name (sort keys %$types){my$moose=Moose::Util::TypeConstraints::find_type_constraint($types->{$name});my$tt=Types::TypeTiny::to_TypeTiny($moose);$caller->add_type($tt->create_child_type(library=>$caller,name=>$name,coercion=>$moose->has_coercion ? 1 : 0))}}elsif ($lib->isa('MouseX::Types::Base')){require Mouse::Util::TypeConstraints;my$types=$lib->type_storage;for my$name (sort keys %$types){my$mouse=Mouse::Util::TypeConstraints::find_type_constraint($types->{$name});my$tt=Types::TypeTiny::to_TypeTiny($mouse);$caller->add_type($tt->create_child_type(library=>$caller,name=>$name,coercion=>$mouse->has_coercion ? 1 : 0))}}else {_croak("'$lib' is not a type constraint library")}}}sub declare {my%opts;if (@_ % 2==0){%opts=@_;if (@_==2 and $_[0]=~ /^_*[A-Z]/ and $_[1]=~ /^[0-9]+$/){require Carp;Carp::carp("Possible missing comma after 'declare $_[0]'")}}else {(my($name),%opts)=@_;_croak "Cannot provide two names for type" if exists$opts{name};$opts{name}=$name}my$caller=caller($opts{_caller_level}|| 0);$opts{library}=$caller;if (defined$opts{parent}){$opts{parent}=to_TypeTiny($opts{parent});unless (TypeTiny->check($opts{parent})){$caller->isa("Type::Library")or _croak("Parent type cannot be a %s",ref($opts{parent})||'non-reference scalar');$opts{parent}=$caller->meta->get_type($opts{parent})or _croak("Could not find parent type")}}my$type;if (defined$opts{parent}){$type=delete($opts{parent})->create_child_type(%opts)}else {my$bless=delete($opts{bless})|| "Type::Tiny";eval "require $bless";$type=$bless->new(%opts)}if ($caller->isa("Type::Library")){$caller->meta->add_type($type)unless$type->is_anon}return$type}*subtype=\&declare;*type=\&declare;sub as (@) {parent=>@_}sub where (&;@) {constraint=>@_}sub message (&;@) {message=>@_}sub inline_as (&;@) {inlined=>@_}sub class_type {my$name=ref($_[0])? undef : shift;my%opts=%{shift or {}};if (defined$name){$opts{name}=$name unless exists$opts{name};$opts{class}=$name unless exists$opts{class};$opts{name}=~ s/:://g}$opts{bless}="Type::Tiny::Class";{no warnings "numeric";$opts{_caller_level}++}declare(%opts)}sub role_type {my$name=ref($_[0])? undef : shift;my%opts=%{shift or {}};if (defined$name){$opts{name}=$name unless exists$opts{name};$opts{role}=$name unless exists$opts{role};$opts{name}=~ s/:://g}$opts{bless}="Type::Tiny::Role";{no warnings "numeric";$opts{_caller_level}++}declare(%opts)}sub duck_type {my$name=ref($_[0])? undef : shift;my@methods=@{shift or []};my%opts;$opts{name}=$name if defined$name;$opts{methods}=\@methods;$opts{bless}="Type::Tiny::Duck";{no warnings "numeric";$opts{_caller_level}++}declare(%opts)}sub enum {my$name=ref($_[0])? undef : shift;my@values=@{shift or []};my%opts;$opts{name}=$name if defined$name;$opts{values}=\@values;$opts{bless}="Type::Tiny::Enum";{no warnings "numeric";$opts{_caller_level}++}declare(%opts)}sub union {my$name=ref($_[0])? undef : shift;my@tcs=@{shift or []};my%opts;$opts{name}=$name if defined$name;$opts{type_constraints}=\@tcs;$opts{bless}="Type::Tiny::Union";{no warnings "numeric";$opts{_caller_level}++}declare(%opts)}sub intersection {my$name=ref($_[0])? undef : shift;my@tcs=@{shift or []};my%opts;$opts{name}=$name if defined$name;$opts{type_constraints}=\@tcs;$opts{bless}="Type::Tiny::Intersection";{no warnings "numeric";$opts{_caller_level}++}declare(%opts)}sub declare_coercion {my%opts;$opts{name}=shift if!ref($_[0]);while (HashLike->check($_[0])and not TypeTiny->check($_[0])){%opts=(%opts,%{+shift})}my$caller=caller($opts{_caller_level}|| 0);$opts{library}=$caller;my$bless=delete($opts{bless})|| "Type::Coercion";eval "require $bless";my$c=$bless->new(%opts);my@C;if ($caller->isa("Type::Library")){my$meta=$caller->meta;$meta->add_coercion($c)unless$c->is_anon;while (@_){push@C,map {ref($_)? to_TypeTiny($_): $meta->get_type($_)||$_}shift;push@C,shift}}else {@C=@_}$c->add_type_coercions(@C);return$c->freeze}sub coerce {if ((scalar caller)->isa("Type::Library")){my$meta=(scalar caller)->meta;my ($type)=map {ref($_)? to_TypeTiny($_): $meta->get_type($_)||$_}shift;my@opts;while (@_){push@opts,map {ref($_)? to_TypeTiny($_): $meta->get_type($_)||$_}shift;push@opts,shift}return$type->coercion->add_type_coercions(@opts)}my ($type,@opts)=@_;$type=to_TypeTiny($type);return$type->coercion->add_type_coercions(@opts)}sub from (@) {return @_}sub to_type (@) {my$type=shift;unless (TypeTiny->check($type)){caller->isa("Type::Library")or _croak "Target type cannot be a string";$type=caller->meta->get_type($type)or _croak "Could not find target type"}return +{type_constraint=>$type },@_}sub via (&;@) {return @_}sub match_on_type {my$value=shift;while (@_){my$code;if (@_==1){$code=shift}else {(my($type),$code)=splice(@_,0,2);TypeTiny->($type)->check($value)or next}if (StringLike->check($code)){local $_=$value;if (wantarray){my@r=eval "$code";die $@ if $@;return@r}if (defined wantarray){my$r=eval "$code";die $@ if $@;return$r}eval "$code";die $@ if $@;return}else {CodeLike->($code);local $_=$value;return$code->($value)}}_croak("No cases matched for %s",Type::Tiny::_dd($value))}sub compile_match_on_type {my@code='sub { local $_ = $_[0]; ';my@checks;my@actions;my$els='';while (@_){my ($type,$code);if (@_==1){require Types::Standard;($type,$code)=(Types::Standard::Any(),shift)}else {($type,$code)=splice(@_,0,2);TypeTiny->($type)}if ($type->can_be_inlined){push@code,sprintf('%sif (%s)',$els,$type->inline_check('$_'))}else {push@checks,$type;push@code,sprintf('%sif ($checks[%d]->check($_))',$els,$#checks)}$els='els';if (StringLike->check($code)){push@code,sprintf(' { %s }',$code)}else {CodeLike->($code);push@actions,$code;push@code,sprintf(' { $actions[%d]->(@_) }',$#actions)}}push@code,'else',' { Type::Utils::_croak("No cases matched for %s", Type::Tiny::_dd($_[0])) }';push@code,'}';require Eval::TypeTiny;return Eval::TypeTiny::eval_closure(source=>\@code,environment=>{'@actions'=>\@actions,'@checks'=>\@checks,},)}sub classifier {my$i;compile_match_on_type(+(map {my$type=$_->[0];$type=>sub {$type}}sort {$b->[1]<=> $a->[1]or $a->[2]<=> $b->[2]}map [$_,scalar(my@parents=$_->parents),++$i],@_),q[ undef ],)}{package Type::Registry::DWIM;our@ISA=qw(Type::Registry);sub foreign_lookup {my$self=shift;my$r=$self->SUPER::foreign_lookup(@_);return$r if$r;if (my$assume=$self->{"~~assume"}and $_[0]=~ /[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*/){my@methods=ref($assume)? @$assume : $assume;for my$method (@methods){$r=$self->$method(@_);return$r if$r}}return}sub lookup_via_moose {my$self=shift;if ($INC{'Moose.pm'}){require Moose::Util::TypeConstraints;require Types::TypeTiny;my$r=Moose::Util::TypeConstraints::find_type_constraint($_[0]);return Types::TypeTiny::to_TypeTiny($r)if defined$r}return}sub lookup_via_mouse {my$self=shift;if ($INC{'Mouse.pm'}){require Mouse::Util::TypeConstraints;require Types::TypeTiny;my$r=Mouse::Util::TypeConstraints::find_type_constraint($_[0]);return Types::TypeTiny::to_TypeTiny($r)if defined$r}return}sub simple_lookup {my$self=shift;my$r;if (defined$self->{"~~chained"}){my$chained="Type::Registry"->for_class($self->{"~~chained"});$r=eval {$chained->simple_lookup(@_)}unless$self==$chained;return$r if defined$r}require Types::Standard;return 'Types::Standard'->get_type($_[0])if 'Types::Standard'->has_type($_[0]);return unless $_[1];my$meta;if (defined$self->{"~~chained"}){$meta ||= Moose::Util::find_meta($self->{"~~chained"})if$INC{'Moose.pm'};$meta ||= Mouse::Util::find_meta($self->{"~~chained"})if$INC{'Mouse.pm'}}if ($meta and $meta->isa('Class::MOP::Module')){$r=$self->lookup_via_moose(@_);return$r if$r}elsif ($meta and $meta->isa('Mouse::Meta::Module')){$r=$self->lookup_via_mouse(@_);return$r if$r}return$self->foreign_lookup(@_)}}our$dwimmer;sub dwim_type {my ($string,%opts)=@_;$opts{for}=caller unless defined$opts{for};$dwimmer ||= do {require Type::Registry;'Type::Registry::DWIM'->new};local$dwimmer->{'~~chained'}=$opts{for};local$dwimmer->{'~~assume'}=$opts{fallback}|| [qw/lookup_via_moose lookup_via_mouse/,$opts{does}? 'make_role_type' : 'make_class_type',];local $@=undef;my$type;unless (eval {$type=$dwimmer->lookup($string);1}){my$e=$@;die($e)unless$e =~ /not a known type constraint/}$type}sub english_list {my$conjunction=ref($_[0])eq 'SCALAR' ? ${+shift}: 'and';my@items=sort @_;return$items[0]if@items==1;return "$items[0] $conjunction $items[1]" if@items==2;my$tail=pop@items;join(', ',@items,"$conjunction $tail")}1; +TYPE_UTILS + +$fatpacked{"Types/Common/Numeric.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_COMMON_NUMERIC'; + package Types::Common::Numeric;use 5.006001;use strict;use warnings;BEGIN {if ($] < 5.008){require Devel::TypeTiny::Perl56Compat}}BEGIN {$Types::Common::Numeric::AUTHORITY='cpan:TOBYINK';$Types::Common::Numeric::VERSION='1.002001'}use Type::Library -base,-declare=>qw(PositiveNum PositiveOrZeroNum PositiveInt PositiveOrZeroInt NegativeNum NegativeOrZeroNum NegativeInt NegativeOrZeroInt SingleDigit);use Type::Tiny ();use Types::Standard qw(Num Int);my$meta=__PACKAGE__->meta;$meta->add_type(name=>'PositiveNum',parent=>Num,constraint=>sub {$_ > 0},inlined=>sub {undef,qq($_ > 0)},message=>sub {"Must be a positive number"},);$meta->add_type(name=>'PositiveOrZeroNum',parent=>Num,constraint=>sub {$_ >= 0},inlined=>sub {undef,qq($_ >= 0)},message=>sub {"Must be a number greater than or equal to zero"},);my ($pos_int,$posz_int);if (Type::Tiny::_USE_XS){$pos_int=Type::Tiny::XS::get_coderef_for('PositiveInt');$posz_int=Type::Tiny::XS::get_coderef_for('PositiveOrZeroInt')}$meta->add_type(name=>'PositiveInt',parent=>Int,constraint=>sub {$_ > 0},inlined=>sub {if ($pos_int){my$xsub=Type::Tiny::XS::get_subname_for($_[0]->name);return "$xsub($_[1])" if$xsub}undef,qq($_ > 0)},message=>sub {"Must be a positive integer"},$pos_int ? (compiled_type_constraint=>$pos_int): (),);$meta->add_type(name=>'PositiveOrZeroInt',parent=>Int,constraint=>sub {$_ >= 0},inlined=>sub {if ($posz_int){my$xsub=Type::Tiny::XS::get_subname_for($_[0]->name);return "$xsub($_[1])" if$xsub}undef,qq($_ >= 0)},message=>sub {"Must be an integer greater than or equal to zero"},$posz_int ? (compiled_type_constraint=>$posz_int): (),);$meta->add_type(name=>'NegativeNum',parent=>Num,constraint=>sub {$_ < 0},inlined=>sub {undef,qq($_ < 0)},message=>sub {"Must be a negative number"},);$meta->add_type(name=>'NegativeOrZeroNum',parent=>Num,constraint=>sub {$_ <= 0},inlined=>sub {undef,qq($_ <= 0)},message=>sub {"Must be a number less than or equal to zero"},);$meta->add_type(name=>'NegativeInt',parent=>Int,constraint=>sub {$_ < 0},inlined=>sub {undef,qq($_ < 0)},message=>sub {"Must be a negative integer"},);$meta->add_type(name=>'NegativeOrZeroInt',parent=>Int,constraint=>sub {$_ <= 0},inlined=>sub {undef,qq($_ <= 0)},message=>sub {"Must be an integer less than or equal to zero"},);$meta->add_type(name=>'SingleDigit',parent=>Int,constraint=>sub {$_ >= -9 and $_ <= 9},inlined=>sub {undef,qq($_ >= -9),qq($_ <= 9)},message=>sub {"Must be a single digit"},);__PACKAGE__->meta->make_immutable;1; +TYPES_COMMON_NUMERIC + +$fatpacked{"Types/Common/String.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_COMMON_STRING'; + package Types::Common::String;use 5.006001;use strict;use warnings;use utf8;BEGIN {if ($] < 5.008){require Devel::TypeTiny::Perl56Compat}}BEGIN {$Types::Common::String::AUTHORITY='cpan:TOBYINK';$Types::Common::String::VERSION='1.002001'}use Type::Library -base,-declare=>qw(SimpleStr NonEmptySimpleStr NumericCode LowerCaseSimpleStr UpperCaseSimpleStr Password StrongPassword NonEmptyStr LowerCaseStr UpperCaseStr);use Type::Tiny ();use Types::Standard qw(Str);my$meta=__PACKAGE__->meta;$meta->add_type(name=>SimpleStr,parent=>Str,constraint=>sub {length($_)<= 255 and not /\n/},inlined=>sub {undef,qq(length($_) <= 255),qq($_ !~ /\\n/)},message=>sub {"Must be a single line of no more than 255 chars"},);$meta->add_type(name=>NonEmptySimpleStr,parent=>SimpleStr,constraint=>sub {length($_)> 0},inlined=>sub {undef,qq(length($_) > 0)},message=>sub {"Must be a non-empty single line of no more than 255 chars"},);$meta->add_type(name=>NumericCode,parent=>NonEmptySimpleStr,constraint=>sub {/^[0-9]+$/},inlined=>sub {SimpleStr->inline_check($_),qq($_ =~ m/^[0-9]+\$/)},message=>sub {'Must be a non-empty single line of no more than 255 chars that consists ' .'of numeric characters only'},);NumericCode->coercion->add_type_coercions(NonEmptySimpleStr,q[ do { (my $code = $_) =~ s/[[:punct:][:space:]]//g; $code } ],);$meta->add_type(name=>Password,parent=>NonEmptySimpleStr,constraint=>sub {length($_)> 3},inlined=>sub {SimpleStr->inline_check($_),qq(length($_) > 3)},message=>sub {"Must be between 4 and 255 chars"},);$meta->add_type(name=>StrongPassword,parent=>Password,constraint=>sub {length($_)> 7 and /[^a-zA-Z]/},inlined=>sub {SimpleStr()->inline_check($_),qq(length($_) > 7),qq($_ =~ /[^a-zA-Z]/)},message=>sub {"Must be between 8 and 255 chars, and contain a non-alpha char"},);my ($nestr);if (Type::Tiny::_USE_XS){$nestr=Type::Tiny::XS::get_coderef_for('NonEmptyStr')}$meta->add_type(name=>NonEmptyStr,parent=>Str,constraint=>sub {length($_)> 0},inlined=>sub {if ($nestr){my$xsub=Type::Tiny::XS::get_subname_for($_[0]->name);return "$xsub($_[1])" if$xsub}undef,qq(length($_) > 0)},message=>sub {"Must not be empty"},$nestr ? (compiled_type_constraint=>$nestr): (),);$meta->add_type(name=>LowerCaseStr,parent=>NonEmptyStr,constraint=>sub {!/\p{Upper}/ms},inlined=>sub {undef,qq($_ !~ /\\p{Upper}/ms)},message=>sub {"Must not contain upper case letters"},);LowerCaseStr->coercion->add_type_coercions(NonEmptyStr,q[ lc($_) ],);$meta->add_type(name=>UpperCaseStr,parent=>NonEmptyStr,constraint=>sub {!/\p{Lower}/ms},inlined=>sub {undef,qq($_ !~ /\\p{Lower}/ms)},message=>sub {"Must not contain lower case letters"},);UpperCaseStr->coercion->add_type_coercions(NonEmptyStr,q[ uc($_) ],);$meta->add_type(name=>LowerCaseSimpleStr,parent=>NonEmptySimpleStr,constraint=>sub {!/\p{Upper}/ms},inlined=>sub {undef,qq($_ !~ /\\p{Upper}/ms)},message=>sub {"Must not contain pper case letters"},);LowerCaseSimpleStr->coercion->add_type_coercions(NonEmptySimpleStr,q[ lc($_) ],);$meta->add_type(name=>UpperCaseSimpleStr,parent=>NonEmptySimpleStr,constraint=>sub {!/\p{Lower}/ms},inlined=>sub {undef,qq($_ !~ /\\p{Lower}/ms)},message=>sub {"Must not contain lower case letters"},);UpperCaseSimpleStr->coercion->add_type_coercions(NonEmptySimpleStr,q[ uc($_) ],);__PACKAGE__->meta->make_immutable;1; +TYPES_COMMON_STRING + +$fatpacked{"Types/Serialiser.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_SERIALISER'; + package Types::Serialiser;use common::sense;our$VERSION='1.0';BEGIN {package JSON::PP::Boolean;*Types::Serialiser::Boolean::=*JSON::PP::Boolean::}{package Types::Serialiser::BooleanBase;use overload "0+"=>sub {${$_[0]}},"++"=>sub {$_[0]=${$_[0]}+ 1},"--"=>sub {$_[0]=${$_[0]}- 1},fallback=>1;@Types::Serialiser::Boolean::ISA=Types::Serialiser::BooleanBase::}our$true=do {bless \(my$dummy=1),Types::Serialiser::Boolean::};our$false=do {bless \(my$dummy=0),Types::Serialiser::Boolean::};our$error=do {bless \(my$dummy),Types::Serialiser::Error::};sub true () {$true}sub false () {$false}sub error () {$error}sub is_bool ($) {UNIVERSAL::isa $_[0],Types::Serialiser::Boolean::}sub is_true ($) {$_[0]&& UNIVERSAL::isa $_[0],Types::Serialiser::Boolean::}sub is_false ($) {!$_[0]&& UNIVERSAL::isa $_[0],Types::Serialiser::Boolean::}sub is_error ($) {UNIVERSAL::isa $_[0],Types::Serialiser::Error::}package Types::Serialiser::Error;sub error {require Carp;Carp::croak ("caught attempt to use the Types::Serialiser::error value")};use overload "0+"=>\&error,"++"=>\&error,"--"=>\&error,fallback=>1;1 +TYPES_SERIALISER + +$fatpacked{"Types/Serialiser/Error.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_SERIALISER_ERROR'; + use Types::Serialiser ();1 +TYPES_SERIALISER_ERROR + +$fatpacked{"Types/Standard.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_STANDARD'; + package Types::Standard;use 5.006001;use strict;use warnings;BEGIN {eval {require re};if ($] < 5.008){require Devel::TypeTiny::Perl56Compat};if ($] < 5.010){require Devel::TypeTiny::Perl58Compat}}BEGIN {$Types::Standard::AUTHORITY='cpan:TOBYINK';$Types::Standard::VERSION='1.002001'}use Type::Library -base;our@EXPORT_OK=qw(slurpy);use Scalar::Util qw(blessed looks_like_number);use Type::Tiny ();use Types::TypeTiny ();BEGIN {*_is_class_loaded=Type::Tiny::_USE_XS ? \&Type::Tiny::XS::Util::is_class_loaded : sub {return!!0 if ref $_[0];return!!0 if not $_[0];my$stash=do {no strict 'refs';\%{"$_[0]\::"}};return!!1 if exists$stash->{'ISA'};return!!1 if exists$stash->{'VERSION'};for my$globref (values %$stash){return!!1 if *{$globref}{CODE}}return!!0}};my$HAS_RUXS=eval {require Ref::Util::XS;Ref::Util::XS::->VERSION(0.100);1};my$add_core_type=sub {my$meta=shift;my ($typedef)=@_;my$name=$typedef->{name};my ($xsub,$xsubname);$typedef->{_is_core}=1 unless$name eq 'Map' || $name eq 'Tuple';if (Type::Tiny::_USE_XS and not ($name eq 'RegexpRef')){$xsub=Type::Tiny::XS::get_coderef_for($name);$xsubname=Type::Tiny::XS::get_subname_for($name)}elsif (Type::Tiny::_USE_MOUSE and not ($name eq 'RegexpRef' or $name eq 'Int' or $name eq 'Object')){require Mouse::Util::TypeConstraints;$xsub="Mouse::Util::TypeConstraints"->can($name);$xsubname="Mouse::Util::TypeConstraints::$name" if$xsub}$typedef->{compiled_type_constraint}=$xsub if$xsub;$typedef->{inlined}=sub {"$xsubname\($_[1])"}if defined($xsubname)and ($name eq 'Str' or $name eq 'Bool' or $name eq 'ClassName' or $name eq 'RegexpRef' or $name eq 'FileHandle');$meta->add_type($typedef)};sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}my$meta=__PACKAGE__->meta;sub Stringable (&) {package Types::Standard::_Stringable;use overload q[""]=>sub {$_[0]{text}||= $_[0]{code}->()},fallback=>1;bless +{code=>$_[0]}}sub LazyLoad ($$) {package Types::Standard::LazyLoad;use overload fallback=>1,q[&{}]=>sub {my ($typename,$function)=@{$_[0]};my$type=$meta->get_type($typename);my$class="Types::Standard::$typename";eval "require $class; 1" or die($@);for my$key (keys %$type){next unless ref($type->{$key})eq __PACKAGE__;my$f=$type->{$key}[1];$type->{$key}=$class->can("__$f")}return$class->can("__$function")};bless \@_}no warnings;BEGIN {*STRICTNUM=$ENV{PERL_TYPES_STANDARD_STRICTNUM}? sub(){!!1}: sub(){!!0}};my$_any=$meta->$add_core_type({name=>"Any",inlined=>sub {"!!1"},});my$_item=$meta->$add_core_type({name=>"Item",inlined=>sub {"!!1"},parent=>$_any,});$meta->$add_core_type({name=>"Bool",parent=>$_item,constraint=>sub {!defined $_ or $_ eq q() or $_ eq '0' or $_ eq '1'},inlined=>sub {"!defined $_[1] or $_[1] eq q() or $_[1] eq '0' or $_[1] eq '1'"},});my$_undef=$meta->$add_core_type({name=>"Undef",parent=>$_item,constraint=>sub {!defined $_},inlined=>sub {"!defined($_[1])"},});my$_def=$meta->$add_core_type({name=>"Defined",parent=>$_item,constraint=>sub {defined $_},inlined=>sub {"defined($_[1])"},});my$_val=$meta->$add_core_type({name=>"Value",parent=>$_def,constraint=>sub {not ref $_},inlined=>sub {"defined($_[1]) and not ref($_[1])"},});my$_str=$meta->$add_core_type({name=>"Str",parent=>$_val,constraint=>sub {ref(\$_)eq 'SCALAR' or ref(\(my$val=$_))eq 'SCALAR'},inlined=>sub {"defined($_[1]) and do { ref(\\$_[1]) eq 'SCALAR' or ref(\\(my \$val = $_[1])) eq 'SCALAR' }"},});my$_laxnum=$meta->add_type({name=>"LaxNum",parent=>$_str,constraint=>sub {looks_like_number $_},inlined=>sub {"defined($_[1]) && !ref($_[1]) && Scalar::Util::looks_like_number($_[1])"},});my$_strictnum=$meta->add_type({name=>"StrictNum",parent=>$_str,constraint=>sub {my$val=$_;($val =~ /\A[+-]?[0-9]+\z/)|| ($val =~ /\A(?:[+-]?) #matches optional +- in the beginning + (?=[0-9]|\.[0-9]) #matches previous +- only if there is something like 3 or .3 + [0-9]* #matches 0-9 zero or more times + (?:\.[0-9]+)? #matches optional .89 or nothing + (?:[Ee](?:[+-]?[0-9]+))? #matches E1 or e1 or e-1 or e+1 etc + \z/x)},inlined=>sub {'my $val = '.$_[1].';'.Value()->inline_check('$val').' && ( $val =~ /\A[+-]?[0-9]+\z/ || ' .'$val =~ /\A(?:[+-]?) # matches optional +- in the beginning + (?=[0-9]|\.[0-9]) # matches previous +- only if there is something like 3 or .3 + [0-9]* # matches 0-9 zero or more times + (?:\.[0-9]+)? # matches optional .89 or nothing + (?:[Ee](?:[+-]?[0-9]+))? # matches E1 or e1 or e-1 or e+1 etc + \z/x ); '},});my$_num=$meta->add_type({name=>"Num",parent=>(STRICTNUM ? $_strictnum : $_laxnum),});$meta->$add_core_type({name=>"Int",parent=>$_num,constraint=>sub {/\A-?[0-9]+\z/},inlined=>sub {"defined($_[1]) and !ref($_[1]) and $_[1] =~ /\\A-?[0-9]+\\z/"},});my$_classn=$meta->add_type({name=>"ClassName",parent=>$_str,constraint=>\&_is_class_loaded,inlined=>sub {"Types::Standard::_is_class_loaded(do { my \$tmp = $_[1] })"},});$meta->add_type({name=>"RoleName",parent=>$_classn,constraint=>sub {not $_->can("new")},inlined=>sub {"Types::Standard::_is_class_loaded(do { my \$tmp = $_[1] }) and not $_[1]\->can('new')"},});my$_ref=$meta->$add_core_type({name=>"Ref",parent=>$_def,constraint=>sub {ref $_},inlined=>sub {"!!ref($_[1])"},constraint_generator=>sub {return$meta->get_type('Ref')unless @_;my$reftype=shift;Types::TypeTiny::StringLike->check($reftype)or _croak("Parameter to Ref[`a] expected to be string; got $reftype");$reftype="$reftype";return sub {ref($_[0])and Scalar::Util::reftype($_[0])eq $reftype}},inline_generator=>sub {my$reftype=shift;return sub {my$v=$_[1];"ref($v) and Scalar::Util::reftype($v) eq q($reftype)"}},deep_explanation=>sub {require B;my ($type,$value,$varname)=@_;my$param=$type->parameters->[0];return if$type->check($value);my$reftype=Scalar::Util::reftype($value);return [sprintf('"%s" constrains reftype(%s) to be equal to %s',$type,$varname,B::perlstring($param)),sprintf('reftype(%s) is %s',$varname,defined($reftype)? B::perlstring($reftype): "undef"),]},});$meta->$add_core_type({name=>"CodeRef",parent=>$_ref,constraint=>sub {ref $_ eq "CODE"},inlined=>$HAS_RUXS ? sub {"Ref::Util::XS::is_plain_coderef($_[1])"}: sub {"ref($_[1]) eq 'CODE'"},});my$_regexp=$meta->$add_core_type({name=>"RegexpRef",parent=>$_ref,constraint=>sub {ref($_)&&!!re::is_regexp($_)or blessed($_)&& $_->isa('Regexp')},inlined=>sub {my$v=$_[1];"ref($v) && !!re::is_regexp($v) or Scalar::Util::blessed($v) && $v\->isa('Regexp')"},});$meta->$add_core_type({name=>"GlobRef",parent=>$_ref,constraint=>sub {ref $_ eq "GLOB"},inlined=>$HAS_RUXS ? sub {"Ref::Util::XS::is_plain_globref($_[1])"}: sub {"ref($_[1]) eq 'GLOB'"},});$meta->$add_core_type({name=>"FileHandle",parent=>$_ref,constraint=>sub {(ref($_)eq "GLOB" && Scalar::Util::openhandle($_))or (blessed($_)&& $_->isa("IO::Handle"))},inlined=>sub {"(ref($_[1]) eq \"GLOB\" && Scalar::Util::openhandle($_[1])) "."or (Scalar::Util::blessed($_[1]) && $_[1]\->isa(\"IO::Handle\"))"},});my$_arr=$meta->$add_core_type({name=>"ArrayRef",parent=>$_ref,constraint=>sub {ref $_ eq "ARRAY"},inlined=>$HAS_RUXS ? sub {"Ref::Util::XS::is_plain_arrayref($_[1])"}: sub {"ref($_[1]) eq 'ARRAY'"},constraint_generator=>LazyLoad(ArrayRef=>'constraint_generator'),inline_generator=>LazyLoad(ArrayRef=>'inline_generator'),deep_explanation=>LazyLoad(ArrayRef=>'deep_explanation'),coercion_generator=>LazyLoad(ArrayRef=>'coercion_generator'),});my$_hash=$meta->$add_core_type({name=>"HashRef",parent=>$_ref,constraint=>sub {ref $_ eq "HASH"},inlined=>$HAS_RUXS ? sub {"Ref::Util::XS::is_plain_hashref($_[1])"}: sub {"ref($_[1]) eq 'HASH'"},constraint_generator=>LazyLoad(HashRef=>'constraint_generator'),inline_generator=>LazyLoad(HashRef=>'inline_generator'),deep_explanation=>LazyLoad(HashRef=>'deep_explanation'),coercion_generator=>LazyLoad(HashRef=>'coercion_generator'),my_methods=>{hashref_allows_key=>sub {my$self=shift;Str()->check($_[0])},hashref_allows_value=>sub {my$self=shift;my ($key,$value)=@_;return!!0 unless$self->my_hashref_allows_key($key);return!!1 if$self==HashRef();my$href=$self->find_parent(sub {$_->has_parent && $_->parent==HashRef()});my$param=$href->type_parameter;Str()->check($key)and $param->check($value)},},});$meta->$add_core_type({name=>"ScalarRef",parent=>$_ref,constraint=>sub {ref $_ eq "SCALAR" or ref $_ eq "REF"},inlined=>sub {"ref($_[1]) eq 'SCALAR' or ref($_[1]) eq 'REF'"},constraint_generator=>LazyLoad(ScalarRef=>'constraint_generator'),inline_generator=>LazyLoad(ScalarRef=>'inline_generator'),deep_explanation=>LazyLoad(ScalarRef=>'deep_explanation'),coercion_generator=>LazyLoad(ScalarRef=>'coercion_generator'),});my$_obj=$meta->$add_core_type({name=>"Object",parent=>$_ref,constraint=>sub {blessed $_},inlined=>$HAS_RUXS ? sub {"Ref::Util::XS::is_blessed_ref($_[1])"}: sub {"Scalar::Util::blessed($_[1])"},});$meta->$add_core_type({name=>"Maybe",parent=>$_item,constraint_generator=>sub {return$meta->get_type('Maybe')unless @_;my$param=Types::TypeTiny::to_TypeTiny(shift);Types::TypeTiny::TypeTiny->check($param)or _croak("Parameter to Maybe[`a] expected to be a type constraint; got $param");my$param_compiled_check=$param->compiled_check;my@xsub;if (Type::Tiny::_USE_XS){my$paramname=Type::Tiny::XS::is_known($param_compiled_check);push@xsub,Type::Tiny::XS::get_coderef_for("Maybe[$paramname]")if$paramname}elsif (Type::Tiny::_USE_MOUSE and $param->_has_xsub){require Mouse::Util::TypeConstraints;my$maker="Mouse::Util::TypeConstraints"->can("_parameterize_Maybe_for");push@xsub,$maker->($param)if$maker}return(sub {my$value=shift;return!!1 unless defined$value;return$param->check($value)},@xsub,)},inline_generator=>sub {my$param=shift;my$param_compiled_check=$param->compiled_check;if (Type::Tiny::_USE_XS){my$paramname=Type::Tiny::XS::is_known($param_compiled_check);my$xsubname=Type::Tiny::XS::get_subname_for("Maybe[$paramname]");return sub {"$xsubname\($_[1]\)"}if$xsubname}return unless$param->can_be_inlined;return sub {my$v=$_[1];my$param_check=$param->inline_check($v);"!defined($v) or $param_check"}},deep_explanation=>sub {my ($type,$value,$varname)=@_;my$param=$type->parameters->[0];return [sprintf('%s is defined',Type::Tiny::_dd($value)),sprintf('"%s" constrains the value with "%s" if it is defined',$type,$param),@{$param->validate_explain($value,$varname)},]},coercion_generator=>sub {my ($parent,$child,$param)=@_;return unless$param->has_coercion;return$param->coercion},});my$_map=$meta->$add_core_type({name=>"Map",parent=>$_hash,constraint_generator=>LazyLoad(Map=>'constraint_generator'),inline_generator=>LazyLoad(Map=>'inline_generator'),deep_explanation=>LazyLoad(Map=>'deep_explanation'),coercion_generator=>LazyLoad(Map=>'coercion_generator'),my_methods=>{hashref_allows_key=>sub {my$self=shift;my ($key)=@_;return Str()->check($key)if$self==Map();my$map=$self->find_parent(sub {$_->has_parent && $_->parent==Map()});my ($kcheck,$vcheck)=@{$map->parameters};($kcheck or Any())->check($key)},hashref_allows_value=>sub {my$self=shift;my ($key,$value)=@_;return!!0 unless$self->my_hashref_allows_key($key);return!!1 if$self==Map();my$map=$self->find_parent(sub {$_->has_parent && $_->parent==Map()});my ($kcheck,$vcheck)=@{$map->parameters};($kcheck or Any())->check($key)and ($vcheck or Any())->check($value)},},});my$_Optional=$meta->add_type({name=>"Optional",parent=>$_item,constraint_generator=>sub {return$meta->get_type('Optional')unless @_;my$param=Types::TypeTiny::to_TypeTiny(shift);Types::TypeTiny::TypeTiny->check($param)or _croak("Parameter to Optional[`a] expected to be a type constraint; got $param");sub {$param->check($_[0])}},inline_generator=>sub {my$param=shift;return unless$param->can_be_inlined;return sub {my$v=$_[1];$param->inline_check($v)}},deep_explanation=>sub {my ($type,$value,$varname)=@_;my$param=$type->parameters->[0];return [sprintf('%s exists',$varname),sprintf('"%s" constrains %s with "%s" if it exists',$type,$varname,$param),@{$param->validate_explain($value,$varname)},]},coercion_generator=>sub {my ($parent,$child,$param)=@_;return unless$param->has_coercion;return$param->coercion},});sub slurpy {my$t=shift;wantarray ? (+{slurpy=>$t },@_): +{slurpy=>$t }}$meta->$add_core_type({name=>"Tuple",parent=>$_arr,name_generator=>sub {my ($s,@a)=@_;sprintf('%s[%s]',$s,join q[,],map {ref($_)eq "HASH" ? sprintf("slurpy %s",$_->{slurpy}): $_}@a)},constraint_generator=>LazyLoad(Tuple=>'constraint_generator'),inline_generator=>LazyLoad(Tuple=>'inline_generator'),deep_explanation=>LazyLoad(Tuple=>'deep_explanation'),coercion_generator=>LazyLoad(Tuple=>'coercion_generator'),});$meta->add_type({name=>"CycleTuple",parent=>$_arr,name_generator=>sub {my ($s,@a)=@_;sprintf('%s[%s]',$s,join q[,],@a)},constraint_generator=>LazyLoad(CycleTuple=>'constraint_generator'),inline_generator=>LazyLoad(CycleTuple=>'inline_generator'),deep_explanation=>LazyLoad(CycleTuple=>'deep_explanation'),coercion_generator=>LazyLoad(CycleTuple=>'coercion_generator'),});$meta->add_type({name=>"Dict",parent=>$_hash,name_generator=>sub {my ($s,@p)=@_;my$l=ref($p[-1])eq q(HASH) ? pop(@p)->{slurpy}: undef;my%a=@p;sprintf('%s[%s%s]',$s,join(q[,],map sprintf("%s=>%s",$_,$a{$_}),sort keys%a),$l ? ",slurpy $l" : '')},constraint_generator=>LazyLoad(Dict=>'constraint_generator'),inline_generator=>LazyLoad(Dict=>'inline_generator'),deep_explanation=>LazyLoad(Dict=>'deep_explanation'),coercion_generator=>LazyLoad(Dict=>'coercion_generator'),my_methods=>{dict_is_slurpy=>sub {my$self=shift;return!!0 if$self==Dict();my$dict=$self->find_parent(sub {$_->has_parent && $_->parent==Dict()});ref($dict->parameters->[-1])eq q(HASH) ? $dict->parameters->[-1]{slurpy}:!!0},hashref_allows_key=>sub {my$self=shift;my ($key)=@_;return Str()->check($key)if$self==Dict();my$dict=$self->find_parent(sub {$_->has_parent && $_->parent==Dict()});my%params;my$slurpy=$dict->my_dict_is_slurpy;if ($slurpy){my@args=@{$dict->parameters};pop@args;%params=@args}else {%params=@{$dict->parameters}}return!!1 if exists($params{$key});return!!0 if!$slurpy;return Str()->check($key)if$slurpy==Any()|| $slurpy==Item()|| $slurpy==Defined()|| $slurpy==Ref();return$slurpy->my_hashref_allows_key($key)if$slurpy->is_a_type_of(HashRef());return!!0},hashref_allows_value=>sub {my$self=shift;my ($key,$value)=@_;return!!0 unless$self->my_hashref_allows_key($key);return!!1 if$self==Dict();my$dict=$self->find_parent(sub {$_->has_parent && $_->parent==Dict()});my%params;my$slurpy=$dict->my_dict_is_slurpy;if ($slurpy){my@args=@{$dict->parameters};pop@args;%params=@args}else {%params=@{$dict->parameters}}return!!1 if exists($params{$key})&& $params{$key}->check($value);return!!0 if!$slurpy;return!!1 if$slurpy==Any()|| $slurpy==Item()|| $slurpy==Defined()|| $slurpy==Ref();return$slurpy->my_hashref_allows_value($key,$value)if$slurpy->is_a_type_of(HashRef());return!!0},},});use overload ();$meta->add_type({name=>"Overload",parent=>$_obj,constraint=>sub {overload::Overloaded($_)},inlined=>sub {"Scalar::Util::blessed($_[1]) and overload::Overloaded($_[1])"},constraint_generator=>sub {return$meta->get_type('Overload')unless @_;my@operations=map {Types::TypeTiny::StringLike->check($_)? "$_" : _croak("Parameters to Overload[`a] expected to be a strings; got $_")}@_;return sub {my$value=shift;for my$op (@operations){return unless overload::Method($value,$op)}return!!1}},inline_generator=>sub {my@operations=@_;return sub {my$v=$_[1];join " and ","Scalar::Util::blessed($v)",map "overload::Method($v, q[$_])",@operations}},});our%_StrMatch;my$has_regexp_util;my$serialize_regexp=sub {$has_regexp_util=eval {require Regexp::Util;Regexp::Util->VERSION('0.003');1}|| 0 unless defined$has_regexp_util;my$re=shift;my$serialized;if ($has_regexp_util){$serialized=eval {Regexp::Util::serialize_regexp($re)}}if (!$serialized){my$key=sprintf('%s|%s',ref($re),$re);$_StrMatch{$key}=$re;$serialized=sprintf('$Types::Standard::_StrMatch{%s}',B::perlstring($key))}return$serialized};$meta->add_type({name=>"StrMatch",parent=>$_str,constraint_generator=>sub {return$meta->get_type('StrMatch')unless @_;my ($regexp,$checker)=@_;$_regexp->check($regexp)or _croak("First parameter to StrMatch[`a] expected to be a Regexp; got $regexp");if (@_ > 1){$checker=Types::TypeTiny::to_TypeTiny($checker);Types::TypeTiny::TypeTiny->check($checker)or _croak("Second parameter to StrMatch[`a] expected to be a type constraint; got $checker")}$checker ? sub {my$value=shift;return if ref($value);my@m=($value =~ $regexp);$checker->check(\@m)}: sub {my$value=shift;!ref($value)and $value =~ $regexp}},inline_generator=>sub {require B;my ($regexp,$checker)=@_;if ($checker){return unless$checker->can_be_inlined;my$serialized_re=$regexp->$serialize_regexp;return sub {my$v=$_[1];sprintf "!ref($v) and do { my \$m = [$v =~ %s]; %s }",$serialized_re,$checker->inline_check('$m'),}}else {my$regexp_string="$regexp";if ($regexp_string =~ /\A\(\?\^u?:(\.+)\)\z/){my$length=length $1;return sub {"!ref($_) and length($_)>=$length"}}if ($regexp_string =~ /\A\(\?\^u?:\\A(\.+)\\z\)\z/){my$length=length $1;return sub {"!ref($_) and length($_)==$length"}}my$serialized_re=$regexp->$serialize_regexp;return sub {my$v=$_[1];"!ref($v) and $v =~ $serialized_re"}}},});$meta->add_type({name=>"OptList",parent=>$_arr,constraint=>sub {for my$inner (@$_){return unless ref($inner)eq q(ARRAY);return unless @$inner==2;return unless is_Str($inner->[0])}return!!1},inlined=>sub {my ($self,$var)=@_;my$Str_check=Str()->inline_check('$inner->[0]');my@code='do { my $ok = 1; ';push@code,sprintf('for my $inner (@{%s}) { no warnings; ',$var);push@code,sprintf('($ok=0) && last unless ref($inner) eq q(ARRAY) && @$inner == 2 && (%s); ',$Str_check);push@code,'} ';push@code,'$ok }';return (undef,join(q( ),@code))},});$meta->add_type({name=>"Tied",parent=>$_ref,constraint=>sub {!!tied(Scalar::Util::reftype($_)eq 'HASH' ? %{$_}: Scalar::Util::reftype($_)eq 'ARRAY' ? @{$_}: ${$_})},inlined=>sub {my ($self,$var)=@_;$self->parent->inline_check($var)." and !!tied(Scalar::Util::reftype($var) eq 'HASH' ? \%{$var} : Scalar::Util::reftype($var) eq 'ARRAY' ? \@{$var} : \${$var})"},name_generator=>sub {my$self=shift;my$param=Types::TypeTiny::to_TypeTiny(shift);unless (Types::TypeTiny::TypeTiny->check($param)){Types::TypeTiny::StringLike->check($param)or _croak("Parameter to Tied[`a] expected to be a class name; got $param");require B;return sprintf("%s[%s]",$self,B::perlstring($param))}return sprintf("%s[%s]",$self,$param)},constraint_generator=>sub {return$meta->get_type('Tied')unless @_;my$param=Types::TypeTiny::to_TypeTiny(shift);unless (Types::TypeTiny::TypeTiny->check($param)){Types::TypeTiny::StringLike->check($param)or _croak("Parameter to Tied[`a] expected to be a class name; got $param");require Type::Tiny::Class;$param="Type::Tiny::Class"->new(class=>"$param")}my$check=$param->compiled_check;return sub {$check->(tied(Scalar::Util::reftype($_)eq 'HASH' ? %{$_}: Scalar::Util::reftype($_)eq 'ARRAY' ? @{$_}: ${$_}))}},inline_generator=>sub {my$param=Types::TypeTiny::to_TypeTiny(shift);unless (Types::TypeTiny::TypeTiny->check($param)){Types::TypeTiny::StringLike->check($param)or _croak("Parameter to Tied[`a] expected to be a class name; got $param");require Type::Tiny::Class;$param="Type::Tiny::Class"->new(class=>"$param")}return unless$param->can_be_inlined;return sub {require B;my$var=$_[1];sprintf("%s and do { my \$TIED = tied(Scalar::Util::reftype($var) eq 'HASH' ? \%{$var} : Scalar::Util::reftype($var) eq 'ARRAY' ? \@{$var} : \${$var}); %s }",Ref()->inline_check($var),$param->inline_check('$TIED'))}},});$meta->add_type({name=>"InstanceOf",parent=>$_obj,constraint_generator=>sub {return$meta->get_type('InstanceOf')unless @_;require Type::Tiny::Class;my@classes=map {Types::TypeTiny::TypeTiny->check($_)? $_ : "Type::Tiny::Class"->new(class=>$_,display_name=>sprintf('InstanceOf[%s]',B::perlstring($_)))}@_;return$classes[0]if@classes==1;require B;require Type::Tiny::Union;return "Type::Tiny::Union"->new(type_constraints=>\@classes,display_name=>sprintf('InstanceOf[%s]',join q[,],map B::perlstring($_->class),@classes),)},});$meta->add_type({name=>"ConsumerOf",parent=>$_obj,constraint_generator=>sub {return$meta->get_type('ConsumerOf')unless @_;require B;require Type::Tiny::Role;my@roles=map {Types::TypeTiny::TypeTiny->check($_)? $_ : "Type::Tiny::Role"->new(role=>$_,display_name=>sprintf('ConsumerOf[%s]',B::perlstring($_)))}@_;return$roles[0]if@roles==1;require Type::Tiny::Intersection;return "Type::Tiny::Intersection"->new(type_constraints=>\@roles,display_name=>sprintf('ConsumerOf[%s]',join q[,],map B::perlstring($_->role),@roles),)},});$meta->add_type({name=>"HasMethods",parent=>$_obj,constraint_generator=>sub {return$meta->get_type('HasMethods')unless @_;require B;require Type::Tiny::Duck;return "Type::Tiny::Duck"->new(methods=>\@_,display_name=>sprintf('HasMethods[%s]',join q[,],map B::perlstring($_),@_),)},});$meta->add_type({name=>"Enum",parent=>$_str,constraint_generator=>sub {return$meta->get_type('Enum')unless @_;require B;require Type::Tiny::Enum;return "Type::Tiny::Enum"->new(values=>\@_,display_name=>sprintf('Enum[%s]',join q[,],map B::perlstring($_),@_),)},});$meta->add_coercion({name=>"MkOpt",type_constraint=>$meta->get_type("OptList"),type_coercion_map=>[$_arr,q{ Exporter::Tiny::mkopt($_) },$_hash,q{ Exporter::Tiny::mkopt($_) },$_undef,q{ [] },],});$meta->add_coercion({name=>"Join",type_constraint=>$_str,coercion_generator=>sub {my ($self,$target,$sep)=@_;Types::TypeTiny::StringLike->check($sep)or _croak("Parameter to Join[`a] expected to be a string; got $sep");require B;$sep=B::perlstring($sep);return (ArrayRef(),qq{ join($sep, \@\$_) })},});$meta->add_coercion({name=>"Split",type_constraint=>$_arr,coercion_generator=>sub {my ($self,$target,$re)=@_;ref($re)eq q(Regexp) or _croak("Parameter to Split[`a] expected to be a regular expresssion; got $re");my$regexp_string="$re";$regexp_string =~ s/\\\//\\\\\//g;return (Str(),qq{ [split /$regexp_string/, \$_] })},});__PACKAGE__->meta->make_immutable;1; +TYPES_STANDARD + +$fatpacked{"Types/Standard/ArrayRef.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_STANDARD_ARRAYREF'; + package Types::Standard::ArrayRef;use 5.006001;use strict;use warnings;BEGIN {$Types::Standard::ArrayRef::AUTHORITY='cpan:TOBYINK';$Types::Standard::ArrayRef::VERSION='1.002001'}use Type::Tiny ();use Types::Standard ();use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}no warnings;sub __constraint_generator {return Types::Standard::ArrayRef unless @_;my$param=Types::TypeTiny::to_TypeTiny(shift);Types::TypeTiny::TypeTiny->check($param)or _croak("Parameter to ArrayRef[`a] expected to be a type constraint; got $param");_croak("Only one parameter to ArrayRef[`a] expected; got @{[ 1 + @_ ]}. Did you mean to use Tuple[`a]?")if @_;my$param_compiled_check=$param->compiled_check;my$xsub;if (Type::Tiny::_USE_XS){my$paramname=Type::Tiny::XS::is_known($param_compiled_check);$xsub=Type::Tiny::XS::get_coderef_for("ArrayRef[$paramname]")if$paramname}elsif (Type::Tiny::_USE_MOUSE and $param->_has_xsub){require Mouse::Util::TypeConstraints;my$maker="Mouse::Util::TypeConstraints"->can("_parameterize_ArrayRef_for");$xsub=$maker->($param)if$maker}return (sub {my$array=shift;$param->check($_)|| return for @$array;return!!1},$xsub,)}sub __inline_generator {my$param=shift;my$param_compiled_check=$param->compiled_check;if (Type::Tiny::_USE_XS){my$paramname=Type::Tiny::XS::is_known($param_compiled_check);my$xsubname=Type::Tiny::XS::get_subname_for("ArrayRef[$paramname]");return sub {"$xsubname\($_[1]\)"}if$xsubname}return unless$param->can_be_inlined;my$param_check=$param->inline_check('$i');return sub {my$v=$_[1];my$p=Types::Standard::ArrayRef->inline_check($v);"$p and do { " ."my \$ok = 1; " ."for my \$i (\@{$v}) { " ."(\$ok = 0, last) unless $param_check " ."}; " ."\$ok " ."}"}}sub __deep_explanation {my ($type,$value,$varname)=@_;my$param=$type->parameters->[0];for my$i (0 .. $#$value){my$item=$value->[$i];next if$param->check($item);return [sprintf('"%s" constrains each value in the array with "%s"',$type,$param),@{$param->validate_explain($item,sprintf('%s->[%d]',$varname,$i))},]}return}sub __coercion_generator {my ($parent,$child,$param)=@_;return unless$param->has_coercion;my$coercable_item=$param->coercion->_source_type_union;my$C="Type::Coercion"->new(type_constraint=>$child);if ($param->coercion->can_be_inlined and $coercable_item->can_be_inlined){$C->add_type_coercions($parent=>Types::Standard::Stringable {my@code;push@code,'do { my ($orig, $return_orig, @new) = ($_, 0);';push@code,'for (@$orig) {';push@code,sprintf('++$return_orig && last unless (%s);',$coercable_item->inline_check('$_'));push@code,sprintf('push @new, (%s);',$param->coercion->inline_coercion('$_'));push@code,'}';push@code,'$return_orig ? $orig : \\@new';push@code,'}';"@code"})}else {$C->add_type_coercions($parent=>sub {my$value=@_ ? $_[0]: $_;my@new;for my$item (@$value){return$value unless$coercable_item->check($item);push@new,$param->coerce($item)}return \@new},)}return$C}1; +TYPES_STANDARD_ARRAYREF + +$fatpacked{"Types/Standard/CycleTuple.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_STANDARD_CYCLETUPLE'; + package Types::Standard::CycleTuple;use 5.006001;use strict;use warnings;BEGIN {$Types::Standard::CycleTuple::AUTHORITY='cpan:TOBYINK';$Types::Standard::CycleTuple::VERSION='1.002001'}use Type::Tiny ();use Types::Standard ();use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}my$_Optional=Types::Standard::Optional;my$_arr=Types::Standard::ArrayRef;no warnings;my$cycleuniq=0;sub __constraint_generator {my@params=map {ref($_)eq 'HASH' and exists($_->{slurpy})and _croak("Parameters to CycleTuple[`a] cannot be slurpy");my$param=Types::TypeTiny::to_TypeTiny($_);Types::TypeTiny::TypeTiny->check($param)or _croak("Parameter to CycleTuple[`a] expected to be a type constraint; got $param");$param}@_;my$count=@params;my$tuple=Types::Standard::Tuple()->of(@params);_croak("Parameters to CycleTuple[`a] cannot be optional")if grep!!$_->is_strictly_a_type_of($_Optional),@params;sub {my$value=shift;return unless$_arr->check($value);return if @$value % $count;my$i=0;while ($i < $#$value){my$tmp=[@$value[$i .. $i+$count-1 ]];return unless$tuple->check($tmp);$i += $count}!!1}}sub __inline_generator {my@params=map {my$param=Types::TypeTiny::to_TypeTiny($_);Types::TypeTiny::TypeTiny->check($param)or _croak("Parameter to CycleTuple[`a] expected to be a type constraint; got $param");$param}@_;my$count=@params;my$tuple=Types::Standard::Tuple()->of(@params);return unless$tuple->can_be_inlined;sub {$cycleuniq++;my$v=$_[1];my@checks=$_arr->inline_check($v);push@checks,sprintf('not(@%s %% %d)',($v=~/\A\$[a-z0-9_]+\z/i ? $v : "{$v}"),$count,);push@checks,sprintf('do { my $cyclecount%d = 0; my $cycleok%d = 1; while ($cyclecount%d < $#{%s}) { my $cycletmp%d = [@{%s}[$cyclecount%d .. $cyclecount%d+%d]]; unless (%s) { $cycleok%d = 0; last; }; $cyclecount%d += %d; }; $cycleok%d; }',$cycleuniq,$cycleuniq,$cycleuniq,$v,$cycleuniq,$v,$cycleuniq,$cycleuniq,$count - 1,$tuple->inline_check("\$cycletmp$cycleuniq"),$cycleuniq,$cycleuniq,$count,$cycleuniq,)if grep {$_->inline_check('$xyz')ne '(!!1)'}@params;join(' && ',@checks)}}sub __deep_explanation {my ($type,$value,$varname)=@_;my@constraints=map Types::TypeTiny::to_TypeTiny($_),@{$type->parameters};if (@$value % @constraints){return [sprintf('"%s" expects a multiple of %d values in the array',$type,scalar(@constraints)),sprintf('%d values found',scalar(@$value)),]}for my$i (0 .. $#$value){my$constraint=$constraints[$i % @constraints];next if$constraint->check($value->[$i]);return [sprintf('"%s" constrains value at index %d of array with "%s"',$type,$i,$constraint),@{$constraint->validate_explain($value->[$i],sprintf('%s->[%s]',$varname,$i))},]}return}my$label_counter=0;sub __coercion_generator {my ($parent,$child,@tuple)=@_;my$child_coercions_exist=0;my$all_inlinable=1;for my$tc (@tuple){$all_inlinable=0 if!$tc->can_be_inlined;$all_inlinable=0 if$tc->has_coercion &&!$tc->coercion->can_be_inlined;$child_coercions_exist++ if$tc->has_coercion}return unless$child_coercions_exist;my$C="Type::Coercion"->new(type_constraint=>$child);if ($all_inlinable){$C->add_type_coercions($parent=>Types::Standard::Stringable {my$label=sprintf("CTUPLELABEL%d",++$label_counter);my$label2=sprintf("CTUPLEINNER%d",$label_counter);my@code;push@code,'do { my ($orig, $return_orig, $tmp, @new) = ($_, 0);';push@code,"$label: {";push@code,sprintf('(($return_orig = 1), last %s) if scalar(@$orig) %% %d != 0;',$label,scalar@tuple);push@code,sprintf('my $%s = 0; while ($%s < @$orig) {',$label2,$label2);for my$i (0 .. $#tuple){my$ct=$tuple[$i];my$ct_coerce=$ct->has_coercion;push@code,sprintf('do { $tmp = %s; (%s) ? ($new[$%s + %d]=$tmp) : (($return_orig=1), last %s) };',$ct_coerce ? $ct->coercion->inline_coercion("\$orig->[\$$label2 + $i]"): "\$orig->[\$$label2 + $i]",$ct->inline_check('$tmp'),$label2,$i,$label,)}push@code,sprintf('$%s += %d;',$label2,scalar(@tuple));push@code,'}';push@code,'}';push@code,'$return_orig ? $orig : \\@new';push@code,'}';"@code"})}else {$C->add_type_coercions($parent=>sub {my$value=@_ ? $_[0]: $_;if (scalar(@$value)% scalar(@tuple)!=0){return$value}my@new;for my$i (0 .. $#$value){my$ct=$tuple[$i % @tuple];my$x=$ct->has_coercion ? $ct->coerce($value->[$i]): $value->[$i];return$value unless$ct->check($x);$new[$i]=$x}return \@new},)};return$C}1; +TYPES_STANDARD_CYCLETUPLE + +$fatpacked{"Types/Standard/Dict.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_STANDARD_DICT'; + package Types::Standard::Dict;use 5.006001;use strict;use warnings;BEGIN {$Types::Standard::Dict::AUTHORITY='cpan:TOBYINK';$Types::Standard::Dict::VERSION='1.002001'}use Types::Standard ();use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}my$_optional=Types::Standard::Optional;my$_hash=Types::Standard::HashRef;my$_map=Types::Standard::Map;my$_any=Types::Standard::Any;no warnings;sub __constraint_generator {my$slurpy=ref($_[-1])eq q(HASH) ? pop(@_)->{slurpy}: undef;my%constraints=@_;my%is_optional;while (my ($k,$v)=each%constraints){$constraints{$k}=Types::TypeTiny::to_TypeTiny($v);$is_optional{$k}=!!$constraints{$k}->is_strictly_a_type_of($_optional);Types::TypeTiny::TypeTiny->check($v)or _croak("Parameter to Dict[`a] for key '$k' expected to be a type constraint; got $v")}return sub {my$value=$_[0];if ($slurpy){my%tmp=map {exists($constraints{$_})? (): ($_=>$value->{$_})}keys %$value;return unless$slurpy->check(\%tmp)}else {exists($constraints{$_})|| return for sort keys %$value}for my$k (sort keys%constraints){exists($value->{$k})or ($is_optional{$k}? next : return);$constraints{$k}->check($value->{$k})or return}return!!1}}sub __inline_generator {my$slurpy=ref($_[-1])eq q(HASH) ? pop(@_)->{slurpy}: undef;return if$slurpy &&!$slurpy->can_be_inlined;my$slurpy_is_any=$slurpy && $_hash->is_a_type_of($slurpy);my$slurpy_is_map=$slurpy && $slurpy->is_parameterized && (($slurpy->parent->strictly_equals($_map)&& $slurpy->parameters)||($slurpy->parent->strictly_equals($_hash)&& [$_any,$slurpy->parameters->[0]]));my%constraints=@_;for my$c (values%constraints){next if$c->can_be_inlined;return}my$regexp=join "|",map quotemeta,sort keys%constraints;return sub {require B;my$h=$_[1];join " and ",Types::Standard::HashRef->inline_check($h),($slurpy_is_any ? (): $slurpy_is_map ? do {'(not grep {' ."my \$v = ($h)->{\$_};" .sprintf('not((/\\A(?:%s)\\z/) or ((%s) and (%s)))',$regexp,$slurpy_is_map->[0]->inline_check('$_'),$slurpy_is_map->[1]->inline_check('$v'),)."} keys \%{$h})"}: $slurpy ? do {'do {' ."my \$slurpy_tmp = +{ map /\\A(?:$regexp)\\z/ ? () : (\$_ => ($h)->{\$_}), keys \%{$h} };" .$slurpy->inline_check('$slurpy_tmp').'}'}: "not(grep !/\\A(?:$regexp)\\z/, keys \%{$h})"),(map {my$k=B::perlstring($_);$constraints{$_}->is_strictly_a_type_of($_optional)? sprintf('(!exists %s->{%s} or %s)',$h,$k,$constraints{$_}->inline_check("$h\->{$k}")): ("exists($h\->{$k})",$constraints{$_}->inline_check("$h\->{$k}"))}sort keys%constraints),}}sub __deep_explanation {require B;my ($type,$value,$varname)=@_;my@params=@{$type->parameters};my$slurpy=ref($params[-1])eq q(HASH) ? pop(@params)->{slurpy}: undef;my%constraints=@params;for my$k (sort keys%constraints){next if$constraints{$k}->parent==Types::Standard::Optional &&!exists$value->{$k};next if$constraints{$k}->check($value->{$k});return [sprintf('"%s" requires key %s to appear in hash',$type,B::perlstring($k))]unless exists$value->{$k};return [sprintf('"%s" constrains value at key %s of hash with "%s"',$type,B::perlstring($k),$constraints{$k}),@{$constraints{$k}->validate_explain($value->{$k},sprintf('%s->{%s}',$varname,B::perlstring($k)))},]}if ($slurpy){my%tmp=map {exists($constraints{$_})? (): ($_=>$value->{$_})}keys %$value;my$explain=$slurpy->validate_explain(\%tmp,'$slurpy');return [sprintf('"%s" requires the hashref of additional key/value pairs to conform to "%s"',$type,$slurpy),@$explain,]if$explain}else {for my$k (sort keys %$value){return [sprintf('"%s" does not allow key %s to appear in hash',$type,B::perlstring($k))]unless exists$constraints{$k}}}return}my$label_counter=0;our ($keycheck_counter,@KEYCHECK)=-1;sub __coercion_generator {my$slurpy=ref($_[-1])eq q(HASH) ? pop(@_)->{slurpy}: undef;my ($parent,$child,%dict)=@_;my$C="Type::Coercion"->new(type_constraint=>$child);my$all_inlinable=1;my$child_coercions_exist=0;for my$tc (values%dict){$all_inlinable=0 if!$tc->can_be_inlined;$all_inlinable=0 if$tc->has_coercion &&!$tc->coercion->can_be_inlined;$child_coercions_exist++ if$tc->has_coercion}$all_inlinable=0 if$slurpy &&!$slurpy->can_be_inlined;$all_inlinable=0 if$slurpy && $slurpy->has_coercion &&!$slurpy->coercion->can_be_inlined;$child_coercions_exist++ if$slurpy && $slurpy->has_coercion;return unless$child_coercions_exist;if ($all_inlinable){$C->add_type_coercions($parent=>Types::Standard::Stringable {require B;my$keycheck=join "|",map quotemeta,sort {length($b)<=> length($a)or $a cmp $b}keys%dict;$keycheck=$KEYCHECK[++$keycheck_counter]=qr{^($keycheck)$}ms;my$label=sprintf("DICTLABEL%d",++$label_counter);my@code;push@code,'do { my ($orig, $return_orig, $tmp, %new) = ($_, 0);';push@code,"$label: {";if ($slurpy){push@code,sprintf('my $slurped = +{ map +($_=~$%s::KEYCHECK[%d])?():($_=>$orig->{$_}), keys %%$orig };',__PACKAGE__,$keycheck_counter);if ($slurpy->has_coercion){push@code,sprintf('my $coerced = %s;',$slurpy->coercion->inline_coercion('$slurped'));push@code,sprintf('((%s)&&(%s))?(%%new=%%$coerced):(($return_orig = 1), last %s);',$_hash->inline_check('$coerced'),$slurpy->inline_check('$coerced'),$label)}else {push@code,sprintf('(%s)?(%%new=%%$slurped):(($return_orig = 1), last %s);',$slurpy->inline_check('$slurped'),$label)}}else {push@code,sprintf('($_ =~ $%s::KEYCHECK[%d])||(($return_orig = 1), last %s) for sort keys %%$orig;',__PACKAGE__,$keycheck_counter,$label)}for my$k (keys%dict){my$ct=$dict{$k};my$ct_coerce=$ct->has_coercion;my$ct_optional=$ct->is_a_type_of($_optional);my$K=B::perlstring($k);push@code,sprintf('if (exists $orig->{%s}) { $tmp = %s; (%s) ? ($new{%s}=$tmp) : (($return_orig=1), last %s) }',$K,$ct_coerce ? $ct->coercion->inline_coercion("\$orig->{$K}"): "\$orig->{$K}",$ct->inline_check('$tmp'),$K,$label,)}push@code,'}';push@code,'$return_orig ? $orig : \\%new';push@code,'}';"@code"})}else {my%is_optional=map {;$_=>!!$dict{$_}->is_strictly_a_type_of($_optional)}sort keys%dict;$C->add_type_coercions($parent=>sub {my$value=@_ ? $_[0]: $_;my%new;if ($slurpy){my%slurped=map exists($dict{$_})? (): ($_=>$value->{$_}),keys %$value;if ($slurpy->check(\%slurped)){%new=%slurped}elsif ($slurpy->has_coercion){my$coerced=$slurpy->coerce(\%slurped);$slurpy->check($coerced)? (%new=%$coerced): (return$value)}else {return$value}}else {for my$k (keys %$value){return$value unless exists$dict{$k}}}for my$k (keys%dict){next if$is_optional{$k}and not exists$value->{$k};my$ct=$dict{$k};my$x=$ct->has_coercion ? $ct->coerce($value->{$k}): $value->{$k};return$value unless$ct->check($x);$new{$k}=$x}return \%new},)}return$C}1; +TYPES_STANDARD_DICT + +$fatpacked{"Types/Standard/HashRef.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_STANDARD_HASHREF'; + package Types::Standard::HashRef;use 5.006001;use strict;use warnings;BEGIN {$Types::Standard::HashRef::AUTHORITY='cpan:TOBYINK';$Types::Standard::HashRef::VERSION='1.002001'}use Type::Tiny ();use Types::Standard ();use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}no warnings;sub __constraint_generator {return Types::Standard::HashRef unless @_;my$param=Types::TypeTiny::to_TypeTiny(shift);Types::TypeTiny::TypeTiny->check($param)or _croak("Parameter to HashRef[`a] expected to be a type constraint; got $param");my$param_compiled_check=$param->compiled_check;my$xsub;if (Type::Tiny::_USE_XS){my$paramname=Type::Tiny::XS::is_known($param_compiled_check);$xsub=Type::Tiny::XS::get_coderef_for("HashRef[$paramname]")if$paramname}elsif (Type::Tiny::_USE_MOUSE and $param->_has_xsub){require Mouse::Util::TypeConstraints;my$maker="Mouse::Util::TypeConstraints"->can("_parameterize_HashRef_for");$xsub=$maker->($param)if$maker}return (sub {my$hash=shift;$param->check($_)|| return for values %$hash;return!!1},$xsub,)}sub __inline_generator {my$param=shift;my$compiled=$param->compiled_check;if (Type::Tiny::_USE_XS){my$paramname=Type::Tiny::XS::is_known($compiled);my$xsubname=Type::Tiny::XS::get_subname_for("HashRef[$paramname]");return sub {"$xsubname\($_[1]\)"}if$xsubname}return unless$param->can_be_inlined;my$param_check=$param->inline_check('$i');return sub {my$v=$_[1];my$p=Types::Standard::HashRef->inline_check($v);"$p and do { " ."my \$ok = 1; " ."for my \$i (values \%{$v}) { " ."(\$ok = 0, last) unless $param_check " ."}; " ."\$ok " ."}"}}sub __deep_explanation {require B;my ($type,$value,$varname)=@_;my$param=$type->parameters->[0];for my$k (sort keys %$value){my$item=$value->{$k};next if$param->check($item);return [sprintf('"%s" constrains each value in the hash with "%s"',$type,$param),@{$param->validate_explain($item,sprintf('%s->{%s}',$varname,B::perlstring($k)))},]}return}sub __coercion_generator {my ($parent,$child,$param)=@_;return unless$param->has_coercion;my$coercable_item=$param->coercion->_source_type_union;my$C="Type::Coercion"->new(type_constraint=>$child);if ($param->coercion->can_be_inlined and $coercable_item->can_be_inlined){$C->add_type_coercions($parent=>Types::Standard::Stringable {my@code;push@code,'do { my ($orig, $return_orig, %new) = ($_, 0);';push@code,'for (keys %$orig) {';push@code,sprintf('$return_orig++ && last unless (%s);',$coercable_item->inline_check('$orig->{$_}'));push@code,sprintf('$new{$_} = (%s);',$param->coercion->inline_coercion('$orig->{$_}'));push@code,'}';push@code,'$return_orig ? $orig : \\%new';push@code,'}';"@code"})}else {$C->add_type_coercions($parent=>sub {my$value=@_ ? $_[0]: $_;my%new;for my$k (keys %$value){return$value unless$coercable_item->check($value->{$k});$new{$k}=$param->coerce($value->{$k})}return \%new},)}return$C}1; +TYPES_STANDARD_HASHREF + +$fatpacked{"Types/Standard/Map.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_STANDARD_MAP'; + package Types::Standard::Map;use 5.006001;use strict;use warnings;BEGIN {$Types::Standard::Map::AUTHORITY='cpan:TOBYINK';$Types::Standard::Map::VERSION='1.002001'}use Type::Tiny ();use Types::Standard ();use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}my$meta=Types::Standard->meta;no warnings;sub __constraint_generator {return$meta->get_type('Map')unless @_;my ($keys,$values)=map Types::TypeTiny::to_TypeTiny($_),@_;Types::TypeTiny::TypeTiny->check($keys)or _croak("First parameter to Map[`k,`v] expected to be a type constraint; got $keys");Types::TypeTiny::TypeTiny->check($values)or _croak("Second parameter to Map[`k,`v] expected to be a type constraint; got $values");my@xsub;if (Type::Tiny::_USE_XS){my@known=map {my$known=Type::Tiny::XS::is_known($_->compiled_check);defined($known)? $known : ()}($keys,$values);if (@known==2){my$xsub=Type::Tiny::XS::get_coderef_for(sprintf "Map[%s,%s]",@known);push@xsub,$xsub if$xsub}}sub {my$hash=shift;$keys->check($_)|| return for keys %$hash;$values->check($_)|| return for values %$hash;return!!1},@xsub}sub __inline_generator {my ($k,$v)=@_;return unless$k->can_be_inlined && $v->can_be_inlined;if (Type::Tiny::_USE_XS){my@known=map {my$known=Type::Tiny::XS::is_known($_->compiled_check);defined($known)? $known : ()}($k,$v);if (@known==2){my$xsub=Type::Tiny::XS::get_subname_for(sprintf "Map[%s,%s]",@known);return sub {my$var=$_[1];"$xsub\($var\)"}if$xsub}}my$k_check=$k->inline_check('$k');my$v_check=$v->inline_check('$v');return sub {my$h=$_[1];my$p=Types::Standard::HashRef->inline_check($h);"$p and do { " ."my \$ok = 1; " ."for my \$v (values \%{$h}) { " ."(\$ok = 0, last) unless $v_check " ."}; " ."for my \$k (keys \%{$h}) { " ."(\$ok = 0, last) unless $k_check " ."}; " ."\$ok " ."}"}}sub __deep_explanation {require B;my ($type,$value,$varname)=@_;my ($kparam,$vparam)=@{$type->parameters};for my$k (sort keys %$value){unless ($kparam->check($k)){return [sprintf('"%s" constrains each key in the hash with "%s"',$type,$kparam),@{$kparam->validate_explain($k,sprintf('key %s->{%s}',$varname,B::perlstring($k)))},]}unless ($vparam->check($value->{$k})){return [sprintf('"%s" constrains each value in the hash with "%s"',$type,$vparam),@{$vparam->validate_explain($value->{$k},sprintf('%s->{%s}',$varname,B::perlstring($k)))},]}}return}sub __coercion_generator {my ($parent,$child,$kparam,$vparam)=@_;return unless$kparam->has_coercion || $vparam->has_coercion;my$kcoercable_item=$kparam->has_coercion ? $kparam->coercion->_source_type_union : $kparam;my$vcoercable_item=$vparam->has_coercion ? $vparam->coercion->_source_type_union : $vparam;my$C="Type::Coercion"->new(type_constraint=>$child);if ((!$kparam->has_coercion or $kparam->coercion->can_be_inlined)and (!$vparam->has_coercion or $vparam->coercion->can_be_inlined)and $kcoercable_item->can_be_inlined and $vcoercable_item->can_be_inlined){$C->add_type_coercions($parent=>Types::Standard::Stringable {my@code;push@code,'do { my ($orig, $return_orig, %new) = ($_, 0);';push@code,'for (keys %$orig) {';push@code,sprintf('++$return_orig && last unless (%s);',$kcoercable_item->inline_check('$_'));push@code,sprintf('++$return_orig && last unless (%s);',$vcoercable_item->inline_check('$orig->{$_}'));push@code,sprintf('$new{(%s)} = (%s);',$kparam->has_coercion ? $kparam->coercion->inline_coercion('$_'): '$_',$vparam->has_coercion ? $vparam->coercion->inline_coercion('$orig->{$_}'): '$orig->{$_}',);push@code,'}';push@code,'$return_orig ? $orig : \\%new';push@code,'}';"@code"})}else {$C->add_type_coercions($parent=>sub {my$value=@_ ? $_[0]: $_;my%new;for my$k (keys %$value){return$value unless$kcoercable_item->check($k)&& $vcoercable_item->check($value->{$k});$new{$kparam->has_coercion ? $kparam->coerce($k): $k}=$vparam->has_coercion ? $vparam->coerce($value->{$k}): $value->{$k}}return \%new},)}return$C}1; +TYPES_STANDARD_MAP + +$fatpacked{"Types/Standard/ScalarRef.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_STANDARD_SCALARREF'; + package Types::Standard::ScalarRef;use 5.006001;use strict;use warnings;BEGIN {$Types::Standard::ScalarRef::AUTHORITY='cpan:TOBYINK';$Types::Standard::ScalarRef::VERSION='1.002001'}use Types::Standard ();use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}no warnings;sub __constraint_generator {return Types::Standard::ScalarRef unless @_;my$param=Types::TypeTiny::to_TypeTiny(shift);Types::TypeTiny::TypeTiny->check($param)or _croak("Parameter to ScalarRef[`a] expected to be a type constraint; got $param");return sub {my$ref=shift;$param->check($$ref)|| return;return!!1}}sub __inline_generator {my$param=shift;return unless$param->can_be_inlined;return sub {my$v=$_[1];my$param_check=$param->inline_check("\${$v}");"(ref($v) eq 'SCALAR' or ref($v) eq 'REF') and $param_check"}}sub __deep_explanation {my ($type,$value,$varname)=@_;my$param=$type->parameters->[0];for my$item ($$value){next if$param->check($item);return [sprintf('"%s" constrains the referenced scalar value with "%s"',$type,$param),@{$param->validate_explain($item,sprintf('${%s}',$varname))},]}return}sub __coercion_generator {my ($parent,$child,$param)=@_;return unless$param->has_coercion;my$coercable_item=$param->coercion->_source_type_union;my$C="Type::Coercion"->new(type_constraint=>$child);if ($param->coercion->can_be_inlined and $coercable_item->can_be_inlined){$C->add_type_coercions($parent=>Types::Standard::Stringable {my@code;push@code,'do { my ($orig, $return_orig, $new) = ($_, 0);';push@code,'for ($$orig) {';push@code,sprintf('++$return_orig && last unless (%s);',$coercable_item->inline_check('$_'));push@code,sprintf('$new = (%s);',$param->coercion->inline_coercion('$_'));push@code,'}';push@code,'$return_orig ? $orig : \\$new';push@code,'}';"@code"})}else {$C->add_type_coercions($parent=>sub {my$value=@_ ? $_[0]: $_;my$new;for my$item ($$value){return$value unless$coercable_item->check($item);$new=$param->coerce($item)}return \$new},)}return$C}1; +TYPES_STANDARD_SCALARREF + +$fatpacked{"Types/Standard/Tuple.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_STANDARD_TUPLE'; + package Types::Standard::Tuple;use 5.006001;use strict;use warnings;BEGIN {$Types::Standard::Tuple::AUTHORITY='cpan:TOBYINK';$Types::Standard::Tuple::VERSION='1.002001'}use Type::Tiny ();use Types::Standard ();use Types::TypeTiny ();sub _croak ($;@) {require Error::TypeTiny;goto \&Error::TypeTiny::croak}my$_Optional=Types::Standard::Optional;no warnings;sub __constraint_generator {my@constraints=@_;my$slurpy;if (exists$constraints[-1]and ref$constraints[-1]eq "HASH"){$slurpy=Types::TypeTiny::to_TypeTiny(pop(@constraints)->{slurpy});Types::TypeTiny::TypeTiny->check($slurpy)or _croak("Slurpy parameter to Tuple[...] expected to be a type constraint; got $slurpy")}@constraints=map Types::TypeTiny::to_TypeTiny($_),@constraints;for (@constraints){Types::TypeTiny::TypeTiny->check($_)or _croak("Parameters to Tuple[...] expected to be type constraints; got $_")}my@xsub;if (Type::Tiny::_USE_XS and!$slurpy){my@known=map {my$known;$known=Type::Tiny::XS::is_known($_->compiled_check)unless $_->is_strictly_a_type_of($_Optional);defined($known)? $known : ()}@constraints;if (@known==@constraints){my$xsub=Type::Tiny::XS::get_coderef_for(sprintf "Tuple[%s]",join(',',@known));push@xsub,$xsub if$xsub}}my@is_optional=map!!$_->is_strictly_a_type_of($_Optional),@constraints;my$slurp_hash=$slurpy && $slurpy->is_a_type_of(Types::Standard::HashRef);my$slurp_any=$slurpy && $slurpy->equals(Types::Standard::Any);sub {my$value=$_[0];if ($#constraints < $#$value){return!!0 unless$slurpy;my$tmp;if ($slurp_hash){($#$value - $#constraints+1)% 2 or return;$tmp=+{@$value[$#constraints+1 .. $#$value]};$slurpy->check($tmp)or return}elsif (not $slurp_any){$tmp=+[@$value[$#constraints+1 .. $#$value]];$slurpy->check($tmp)or return}}for my$i (0 .. $#constraints){($i > $#$value)and return!!$is_optional[$i];$constraints[$i]->check($value->[$i])or return!!0}return!!1},@xsub}sub __inline_generator {my@constraints=@_;my$slurpy;if (exists$constraints[-1]and ref$constraints[-1]eq "HASH"){$slurpy=pop(@constraints)->{slurpy}}return if grep {not $_->can_be_inlined}@constraints;return if defined$slurpy &&!$slurpy->can_be_inlined;if (Type::Tiny::_USE_XS and!$slurpy){my@known=map {my$known;$known=Type::Tiny::XS::is_known($_->compiled_check)unless $_->is_strictly_a_type_of($_Optional);defined($known)? $known : ()}@constraints;if (@known==@constraints){my$xsub=Type::Tiny::XS::get_subname_for(sprintf "Tuple[%s]",join(',',@known));return sub {my$var=$_[1];"$xsub\($var\)"}if$xsub}}my$tmpl="do { my \$tmp = +[\@{%s}[%d..\$#{%s}]]; %s }";my$slurpy_any;if (defined$slurpy){$tmpl='do { my ($orig, $from, $to) = (%s, %d, $#{%s});' .'($to-$from % 2) and do { my $tmp = +{@{$orig}[$from..$to]}; %s }' .'}' if$slurpy->is_a_type_of(Types::Standard::HashRef);$slurpy_any=1 if$slurpy->equals(Types::Standard::Any)}my@is_optional=map!!$_->is_strictly_a_type_of($_Optional),@constraints;my$min=0 + grep!$_,@is_optional;return sub {my$v=$_[1];join " and ",Types::Standard::ArrayRef->inline_check($v),((scalar@constraints==$min and not $slurpy)? "\@{$v} == $min" : ("\@{$v} >= $min",($slurpy_any ? (): ($slurpy ? sprintf($tmpl,$v,$#constraints+1,$v,$slurpy->inline_check('$tmp')): sprintf("\@{$v} <= %d",scalar@constraints))),)),map {my$inline=$constraints[$_]->inline_check("$v\->[$_]");$inline eq '(!!1)' ? (): ($is_optional[$_]? sprintf('(@{%s} <= %d or %s)',$v,$_,$inline): $inline)}0 .. $#constraints}}sub __deep_explanation {my ($type,$value,$varname)=@_;my@constraints=@{$type->parameters};my$slurpy;if (exists$constraints[-1]and ref$constraints[-1]eq "HASH"){$slurpy=Types::TypeTiny::to_TypeTiny(pop(@constraints)->{slurpy})}@constraints=map Types::TypeTiny::to_TypeTiny($_),@constraints;if (@constraints < @$value and not $slurpy){return [sprintf('"%s" expects at most %d values in the array',$type,scalar(@constraints)),sprintf('%d values found; too many',scalar(@$value)),]}for my$i (0 .. $#constraints){next if$constraints[$i]->is_strictly_a_type_of(Types::Standard::Optional)&& $i > $#$value;next if$constraints[$i]->check($value->[$i]);return [sprintf('"%s" constrains value at index %d of array with "%s"',$type,$i,$constraints[$i]),@{$constraints[$i]->validate_explain($value->[$i],sprintf('%s->[%s]',$varname,$i))},]}if (defined($slurpy)){my$tmp=$slurpy->is_a_type_of(Types::Standard::HashRef)? +{@$value[$#constraints+1 .. $#$value]}: +[@$value[$#constraints+1 .. $#$value]];$slurpy->check($tmp)or return [sprintf('Array elements from index %d are slurped into a %s which is constrained with "%s"',$#constraints+1,$slurpy->is_a_type_of(Types::Standard::HashRef)? 'hashref' : 'arrayref',$slurpy,),@{$slurpy->validate_explain($tmp,'$SLURPY')},]}return}my$label_counter=0;sub __coercion_generator {my ($parent,$child,@tuple)=@_;my$slurpy;if (exists$tuple[-1]and ref$tuple[-1]eq "HASH"){$slurpy=pop(@tuple)->{slurpy}}my$child_coercions_exist=0;my$all_inlinable=1;for my$tc (@tuple,($slurpy ? $slurpy : ())){$all_inlinable=0 if!$tc->can_be_inlined;$all_inlinable=0 if$tc->has_coercion &&!$tc->coercion->can_be_inlined;$child_coercions_exist++ if$tc->has_coercion}return unless$child_coercions_exist;my$C="Type::Coercion"->new(type_constraint=>$child);if ($all_inlinable){$C->add_type_coercions($parent=>Types::Standard::Stringable {my$label=sprintf("TUPLELABEL%d",++$label_counter);my@code;push@code,'do { my ($orig, $return_orig, $tmp, @new) = ($_, 0);';push@code,"$label: {";push@code,sprintf('(($return_orig = 1), last %s) if @$orig > %d;',$label,scalar@tuple)unless$slurpy;for my$i (0 .. $#tuple){my$ct=$tuple[$i];my$ct_coerce=$ct->has_coercion;my$ct_optional=$ct->is_a_type_of(Types::Standard::Optional);push@code,sprintf('if (@$orig > %d) { $tmp = %s; (%s) ? ($new[%d]=$tmp) : (($return_orig=1), last %s) }',$i,$ct_coerce ? $ct->coercion->inline_coercion("\$orig->[$i]"): "\$orig->[$i]",$ct->inline_check('$tmp'),$i,$label,)}if ($slurpy){my$size=@tuple;push@code,sprintf('if (@$orig > %d) {',$size);push@code,sprintf('my $tail = [ @{$orig}[%d .. $#$orig] ];',$size);push@code,$slurpy->has_coercion ? sprintf('$tail = %s;',$slurpy->coercion->inline_coercion('$tail')): q();push@code,sprintf('(%s) ? push(@new, @$tail) : ($return_orig++);',$slurpy->inline_check('$tail'),);push@code,'}'}push@code,'}';push@code,'$return_orig ? $orig : \\@new';push@code,'}';"@code"})}else {my@is_optional=map!!$_->is_strictly_a_type_of($_Optional),@tuple;$C->add_type_coercions($parent=>sub {my$value=@_ ? $_[0]: $_;if (!$slurpy and @$value > @tuple){return$value}my@new;for my$i (0 .. $#tuple){return \@new if$i > $#$value and $is_optional[$i];my$ct=$tuple[$i];my$x=$ct->has_coercion ? $ct->coerce($value->[$i]): $value->[$i];return$value unless$ct->check($x);$new[$i]=$x}if ($slurpy and @$value > @tuple){my$tmp=$slurpy->has_coercion ? $slurpy->coerce([@{$value}[@tuple .. $#$value]]): [@{$value}[@tuple .. $#$value]];$slurpy->check($tmp)? push(@new,@$tmp): return($value)}return \@new},)};return$C}1; +TYPES_STANDARD_TUPLE + +$fatpacked{"Types/TypeTiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TYPES_TYPETINY'; + package Types::TypeTiny;use strict;use warnings;our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.002001';use Scalar::Util qw<blessed refaddr weaken>;our@EXPORT_OK=(__PACKAGE__->type_names,qw/to_TypeTiny/);my%cache;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,@_)}sub meta {return $_[0]}sub type_names {qw(CodeLike StringLike TypeTiny HashLike ArrayLike)}sub has_type {my%has=map +($_=>1),shift->type_names;!!$has{$_[0]}}sub get_type {my$self=shift;return unless$self->has_type(@_);no strict qw(refs);&{$_[0]}()}sub coercion_names {qw()}sub has_coercion {my%has=map +($_=>1),shift->coercion_names;!!$has{$_[0]}}sub get_coercion {my$self=shift;return unless$self->has_coercion(@_);no strict qw(refs);&{$_[0]}()}sub StringLike () {require Type::Tiny;$cache{StringLike}||= "Type::Tiny"->new(name=>"StringLike",constraint=>sub {defined($_)&&!ref($_)or Scalar::Util::blessed($_)&& overload::Method($_,q[""])},inlined=>sub {qq/defined($_[1]) && !ref($_[1]) or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[""])/},library=>__PACKAGE__,)}sub HashLike () {require Type::Tiny;$cache{HashLike}||= "Type::Tiny"->new(name=>"HashLike",constraint=>sub {ref($_)eq q[HASH] or Scalar::Util::blessed($_)&& overload::Method($_,q[%{}])},inlined=>sub {qq/ref($_[1]) eq q[HASH] or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[\%{}])/},library=>__PACKAGE__,)}sub ArrayLike () {require Type::Tiny;$cache{ArrayLike}||= "Type::Tiny"->new(name=>"ArrayLike",constraint=>sub {ref($_)eq q[ARRAY] or Scalar::Util::blessed($_)&& overload::Method($_,q[@{}])},inlined=>sub {qq/ref($_[1]) eq q[ARRAY] or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[\@{}])/},library=>__PACKAGE__,)}sub CodeLike () {require Type::Tiny;$cache{CodeLike}||= "Type::Tiny"->new(name=>"CodeLike",constraint=>sub {ref($_)eq q[CODE] or Scalar::Util::blessed($_)&& overload::Method($_,q[&{}])},inlined=>sub {qq/ref($_[1]) eq q[CODE] or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[\&{}])/},library=>__PACKAGE__,)}sub TypeTiny () {require Type::Tiny;$cache{TypeTiny}||= "Type::Tiny"->new(name=>"TypeTiny",constraint=>sub {Scalar::Util::blessed($_)&& $_ ->isa(q[Type::Tiny])},inlined=>sub {my$var=$_[1];"Scalar::Util::blessed($var) && $var\->isa(q[Type::Tiny])"},library=>__PACKAGE__,)}my%ttt_cache;sub to_TypeTiny {my$t=$_[0];return$t unless (my$ref=ref$t);return$t if$ref =~ /^Type::Tiny\b/;return$ttt_cache{refaddr($t)}if$ttt_cache{refaddr($t)};if (my$class=blessed$t){return$t if$class->isa("Type::Tiny");return _TypeTinyFromMoose($t)if$class->isa("Moose::Meta::TypeConstraint");return _TypeTinyFromMoose($t)if$class->isa("MooseX::Types::TypeDecorator");return _TypeTinyFromValidationClass($t)if$class->isa("Validation::Class::Simple");return _TypeTinyFromValidationClass($t)if$class->isa("Validation::Class");return _TypeTinyFromGeneric($t)if$t->can("check")&& $t->can("get_message")}return _TypeTinyFromCodeRef($t)if$ref eq q(CODE);$t}sub _TypeTinyFromMoose {my$t=$_[0];if (ref$t->{"Types::TypeTiny::to_TypeTiny"}){return$t->{"Types::TypeTiny::to_TypeTiny"}}if ($t->name ne '__ANON__'){require Types::Standard;my$ts='Types::Standard'->get_type($t->name);return$ts if$ts->{_is_core}}my%opts;$opts{display_name}=$t->name;$opts{constraint}=$t->constraint;$opts{parent}=to_TypeTiny($t->parent)if$t->has_parent;$opts{inlined}=sub {shift;$t->_inline_check(@_)}if$t->can("can_be_inlined")&& $t->can_be_inlined;$opts{message}=sub {$t->get_message($_)}if$t->has_message;$opts{moose_type}=$t;require Type::Tiny;my$new='Type::Tiny'->new(%opts);$ttt_cache{refaddr($t)}=$new;weaken($ttt_cache{refaddr($t)});$new->{coercion}=do {require Type::Coercion::FromMoose;'Type::Coercion::FromMoose'->new(type_constraint=>$new,moose_coercion=>$t->coercion,)}if$t->has_coercion;return$new}sub _TypeTinyFromValidationClass {my$t=$_[0];require Type::Tiny;require Types::Standard;my%opts=(parent=>Types::Standard::HashRef(),_validation_class=>$t,);if ($t->VERSION >= "7.900048"){$opts{constraint}=sub {$t->params->clear;$t->params->add(%$_);my$f=$t->filtering;$t->filtering('off');my$r=eval {$t->validate};$t->filtering($f || 'pre');return$r};$opts{message}=sub {$t->params->clear;$t->params->add(%$_);my$f=$t->filtering;$t->filtering('off');my$r=(eval {$t->validate}? "OK" : $t->errors_to_string);$t->filtering($f || 'pre');return$r}}else {$opts{constraint}=sub {$t->params->clear;$t->params->add(%$_);no warnings "redefine";local*Validation::Class::Directive::Filters::execute_filtering=sub {$_[0]};eval {$t->validate}};$opts{message}=sub {$t->params->clear;$t->params->add(%$_);no warnings "redefine";local*Validation::Class::Directive::Filters::execute_filtering=sub {$_[0]};eval {$t->validate}? "OK" : $t->errors_to_string}}require Type::Tiny;my$new="Type::Tiny"->new(%opts);$new->coercion->add_type_coercions(Types::Standard::HashRef()=>sub {my%params=%$_;for my$k (keys%params){delete$params{$_}unless$t->get_fields($k)};$t->params->clear;$t->params->add(%params);eval {$t->validate};$t->get_hash},);$ttt_cache{refaddr($t)}=$new;weaken($ttt_cache{refaddr($t)});return$new}sub _TypeTinyFromGeneric {my$t=$_[0];my%opts=(constraint=>sub {$t->check(@_ ? @_ : $_)},message=>sub {$t->get_message(@_ ? @_ : $_)},);$opts{display_name}=$t->name if$t->can("name");$opts{coercion}=sub {$t->coerce(@_ ? @_ : $_)}if$t->can("has_coercion")&& $t->has_coercion && $t->can("coerce");require Type::Tiny;my$new="Type::Tiny"->new(%opts);$ttt_cache{refaddr($t)}=$new;weaken($ttt_cache{refaddr($t)});return$new}my$QFS;sub _TypeTinyFromCodeRef {my$t=$_[0];my%opts=(constraint=>sub {return!!eval {$t->($_)}},message=>sub {local $@;eval {$t->($_);1}or do {chomp $@;return $@ if $@};return sprintf('%s did not pass type constraint',Type::Tiny::_dd($_))},);if ($QFS ||= "Sub::Quote"->can("quoted_from_sub")){my (undef,$perlstring,$captures)=@{$QFS->($t)|| []};if ($perlstring){$perlstring="!!eval{ $perlstring }";$opts{inlined}=sub {my$var=$_[1];Sub::Quote::inlinify($perlstring,$var,$var eq q($_) ? '' : "local \$_ = $var;",1,)}if$perlstring &&!$captures}}require Type::Tiny;my$new="Type::Tiny"->new(%opts);$ttt_cache{refaddr($t)}=$new;weaken($ttt_cache{refaddr($t)});return$new}1; +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 +X86_64-LINUX-THREAD-MULTI_COMMON_SENSE + +s/^ //mg for values %fatpacked; + +my $class = 'FatPacked::'.(0+\%fatpacked); +no strict 'refs'; +*{"${class}::files"} = sub { keys %{$_[0]} }; + +if ($] < 5.008) { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + my $pos = 0; + my $last = length $fat; + return (sub { + return 0 if $pos == $last; + my $next = (1 + index $fat, "\n", $pos) || $last; + $_ .= substr $fat, $pos, $next - $pos; + $pos = $next; + return 1; + }); + } + }; +} + +else { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + open my $fh, '<', \$fat + or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; + return $fh; + } + return; + }; +} + +unshift @INC, bless \%fatpacked, $class; + } # END OF FATPACK CODE + +# +# Igor - dotfile management for perl hackers +# Copyright (C) 2017, 2018 Simon Schuster +# +# 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 <https://www.gnu.org/licenses/>. + +use warnings; +use strict; + +use version; our $VERSION = version->declare("v0.1.0"); + +BEGIN { unshift @INC, './lib'; } + +use Igor::CLI; + +# Simply dispatch, wuhu +Igor::CLI::main(@ARGV); + +__END__ + +=encoding utf8 + +=head1 NAME + +igor - Because nothing makes you feel so as home like a good igor + +I<A humble attempt at configuration management - dotfile management for perl hackers> + +=head1 SYNOPSIS + +igor [general options] <subcommand> [subcommand options] + + General Options: + --help|-h|-? Display help + --config|-c Configuration file to use + --verbose|-v Be Verbose + + Subcommands: + apply Apply the specifiec configuration + diff Show differences between applied and stored configuration + gc Show obsolete files + +=head1 OPTIONS + +=over 8 + +=item B<C<--help|-h|-?>> + +Print a brief help message and exits. Can be passed multiple times. Passing +twice will show the full documentation. + +=item B<C<--config|-c> conffile> + +Set the config file to use, instead of F<config.toml> in the current directory + +=item B<C<--verbose|-v>> + +Be a bit more verbose when conduction business. Can be passed multiple times. +Passing once enables the C<debug> mode most useful to debug issues with the +current configuration. C<trace> is even more verbose and logs various internal +states. + +=back + +=head1 SUBCOMMANDS + +=head2 apply + +Apply a configuration to this computer. +The default is to use the configuration specified by this computers hostname. + +=over 8 + +=item B<C<--dry-run>> + +Only list what would be done, but do not actually perform the operations. + +=item B<C<--task> T> + +Apply configuration C<T> instead of the default one + +=back + +=head2 diff + +Show changes between stored and effective configuration + +=head3 gc + +Show obsolete files + +=head1 DOCUMENTATION + +=head2 FUNDAMENTALS + +Igors approach to dotfile management mirrors the concept of traditional package +management. Therefore, instead of delivering all dotfiles at once, files are +grouped into L<packages|/PACKAGES> which can be enabled for individual hosts +selectively. + +L<Configurations|/CONFIGURATION> describe the set of packages that igor should +activate. By providing L<facts|/facts> for the current environment, they further +allow igor to customize the packages and their templates before deployment. + +=head2 PACKAGES + +Igor manages individual configuration files as packages. Each package comprises +a set of files relating to a specific task or aspect of the system. Often, +this will coincide with a program (e.g.: the C<zsh> package might contain +F<.zprofile>, F<.zshrc> and F<.zshenv>), while the can also relate to +functionality (e.g.: C<mail> comprising a F<.muttrc>, F<.mbsyncrc> and +F<.msmtprc>). + +=head3 Filesystem Layout + +In the filesystem, each package is represented as a directory. In the simplest +case, a package consists of the mandatory package description file (either +F<package.toml> or F<package.pl>, see below L<[1]|/"TOML"> +L<[2]|/"Perl-style package description">). + +In the simplest case, all actual configuration files to install for the package +reside in a flat flat folder alongside the package description file: + + vim + ├── package.toml + ├── env.sh + ├── vimrc + ├── runinstall.sh + └── neobundle.toml.tmpl + +However, you are free to reorganize them into subfolders as you see fit: + + vim + ├── files + │ ├── env.sh + │ └── vimrc + ├── hooks + │ └── runinstall.sh + ├── package.toml + └── templates + └── neobundle.toml.tmpl + +The package description file then specifies what actions should be performed on +these files. + +=head3 TOML + +The operations to be performed by a package are described by the +F<package.toml> file, which describes the operations to be performed +in L<TOML syntax|https://github.com/toml-lang/toml>. + +Each package consists of four components: + +=over + +=item Files + +A list of files or directories that should be deployed into the filesystem. + +The most basic operation a package can perform is symlinking a file (e.g. +F<./symlink> to F<~/test/symlink>): + + [[files]] + source = "./symlink" + dest = "~/test/symlink" + operation = "symlink" + +Specifying the operation in this example is not strictly necessary, as +C<"symlink"> actually constitutes the default. Sometimes, however, it is +necessary to actually copy the package file, which can be forced by the +C<"copy"> operation. Optionally, you can also specify the filesystem +permissions of the copied file there: + + [[files]] + source = "./copy" + dest = "~/test/copy" + operation = "copy" + perm = "0644" + +However, often it is not enough to simply copy complete files. For instance, +the shell's C<.*-profile> usually comprises environment variables from several +packages. To this end, igor provides I<collections>, whose contents are collected +from all files specified in the package configuration: + + [[files]] + source = "./env.sh" + collection = "profile" + +Here, C<profile> specifies the name of the collection. All content from all +configured packages for said collection is collected, merged and then deployed +on the host. +The merge and deployment of named collections is configured in the +L<top level configuration file|/CONFIGURATION>. + +=item Templates + +Sometimes, it is useful to adapt configuration files before deployment and +provide tailored variations. + +Example: On work computers, I want to set my work email address as the default +git C<user.email>. + +To this end, the user can configure facts for any active configuration inside +the L<top level configuration file|/CONFIGURATION> or derive them automatically +from the environments via L<factors|/Custom factors>. + +This information can then be interpolated into template files. The templating +is based on L<Text::Template|https://metacpan.org/pod/Text::Template>, which +uses perl as its templating language. The default escape characters are curly +braces C<{}>: + + # In ./gitconfig.tmpl + [user] + name = Nixus Minimax + email = { $facts{dev}->{git}->{email} } + +To deploy apply templating and deploy this file, specify the destination (see +Files above for the syntax for dest/collection) in the F<package.toml> file: + + [[templates]] + source = "./gitconfig.tmpl" + dest = "~/.config/git/config" + perm = "..." + +However, configuration files often already use C<{}> as syntactical elements. +Therefore, it is possible to use custom delimiters: + + # In package.toml + [[templates]] + source = "./files/config" + dest = "~/.config/git/config" + delimiters = { open = "#BEGIN_TEMPLATE", close = "#END_TEMPLATE"} + + # In ./gitconfig.tmpl + [user] + name = Nixus Minimax + #BEGIN_TEMPLATE + <<"EOF" + email = $facts{dev}->{git}->{email} + EOF + #END_TEMPLATE + ... + +=item Dependencies + +Furthermore, sometimes there is interdependence between configuration files. +For instance, my C<i3> configuration spawns C<rofi> for running programs. +Therefore, whenever the package C<i3> is deployed, C<rofi>'s configuration +should be installed as well. This can be enforced by declaring the dependency +in C<i3>'s F<package.toml> file: + + # in i3/package.toml + dependencies = [ 'rofi' ] + +=item Hooks + +Hooks allow to run certain commands before and after package installation. To +this end, igor provides two lists (C<precmds> and C<postcmds>) which make it +possible to specify commands to be run before and after installation +respectively. + + precmds = [ + "mkdir -p ~/.cache/vim/", + "echo hallo welt" + ] + + postcmds = [ + ["./hooks/runinstall.sh"], + ["echo", "hallo", "welt"] + ] + +The arrays can either store the commands as string, which will be executed by +the default users shell. Alternatively, the hooks can be specified as an array +of strings. In that case, the systems shell is bypassed and the command will be +invoked directly using exec, bypassing the system shell. + +=back + +=head4 Perl-style package description + +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 +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. + +In this case, the C<package.pl> package description format provides a mechanism +to create the relevant datastructure describing the package via perl code: + + sub { + my ($config) = @_; # effective configuration + # $config->{facts} comprises the configured facts + # $config->{pacakges} lists the packages being installed + my $package = ...; # perform calculations + return $package; + } + +The return type C<$package> is a perl hash with keys analogous to the +L<TOML|/TOML> components, for example: + + my $package = { + files => [ { source => "./file", dest => "~/.myfile" } + , { source => "./file2", dest => "~/.myfile", operation => 'copy' } + ], + dependencies => ['otherpackage1', 'otherpackage2'], + template => [ { source => "...", dest => "..."} + , { source => "..."}, collection => "collectionname" } + ], + postcmds => [ 'command arg1 arg2', [ 'cmd2', 'arg21', 'arg22'] ] + } + +=head2 CONFIGURATION + +A configurations specifies which packages to install and defines parameters for +the current deployment. +The configuration is expressed in a L<TOML|https://github.com/toml-lang/toml> +configuration file. +By default, igor looks for a file named F<config.toml> in the pwd. +This default can be overwritten by passing an alternative filename to +C<-c|--config>. + +The configuration file stores different configurations as TOML tables: + + [defaults] + ... + + [configurations.cfg1] + ... + + [configurations.cfg2] + +=head3 Configuration format + +Each configuration block describes the various attributes of the desired system +state. + +=over 4 + +=item Repositories and Packages + +Most importantly, the configuration defines which repositories to +consult when resolving package names and the list of packages to be installed: + + [configurations.config] + repositories = { + repository1 = { path = './repo1' } + repository2 = { path = './repo2' } + } + packages = ['pkg1', 'repository1/pkg2', 'repository2/pkg2', 'repository2/pkg42'] + +The above snippet configures igor to search for packages in two repositories located +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 +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 +namespaced by the repository name (e.g. C<repository1/pkg2> and C<repository2/pkg2>). + +=item Facts + +Templates as well as perl-style packages allow to tailor packages and package +contents to the host environment. C<facts> allow to describe attributes of the +current configuration. Examples include: the username of the current user, the +git commit email address that should be used, which development plugins for +which programming languages should be configured in the vimrc, ... + +In the configuration, facts are represented as a (potentially nested) hash: + + [configurations.config.facts] + git_email = mail@example.org + dev = { languages = { viml = true, perl = true, haskell = false }} + mailaccounts = [ + { user = 'work@biz.example.org', server = 'mx.example.org' }, + { user = 'private@example.org', server = 'hugo.example.org' }, + ] + hostname = 'luggage' + +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 Collections + +Often, certain files store configuration that relates to different system +components and as such to different packages (e.g. your shells environment +file, which might export environment variables for your editor (e.g. C<EDITOR>, +your own C<PATH>, ...)). +Collections allow to receive input from multiple packages and merge those into +a single file. + + [configurations.computer.collections] + 'env.sh' = { + destination = '~/env.sh', # Storage location of the merged file + perm = "0644", # Permissions for the generated file + } + +If no permissions (C<perm>) are specified, the default umask is used. +Inside the packages, collections can be used as a substitute to the C<dest> parameter: + + [[files]] + source = "./files/env.sh" + collection = "env.sh" + +By default, all entries are merged by sorting the components by packagename and +concatenating those together. As this simplistic strategy is not sufficient for +complex files (e.g.: we always need the C<env> package first, which declares +important variables like C<HOME>, C<XDG_*>, ... and are used by other +components within the generated collection file F<env.sh>). Therefore, +alternative merge strategies can be specified: + + [configurations.config] + mergers = { envmerger = './mergers/envmerger.pl' } + collections = { + 'env.sh' = { + destination = '~/env.sh' + merger = 'envmerger' # name in the mergers hash + } + } + +For the contents of F<./mergers/envmerger.pl> see the section on +L<custom mergers|/Custom collection mergers> + +=item Advanced features: C<dependencies>, C<factors>, C<mergers> and C<mergeconfigs> + +For the advanced features like C<dependencies>, C<factors>, C<mergers> and +C<mergeconfigs>, see below. + +=back + +=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 +several aspects. + +For instance, all configurations share a common set of default values and basic +packages (e.g. I use a z-Shell everywhere,...) and on top of that, I have +configurations for developing Haskell, reading Mail, running graphical +environments, etc. These actually (hopefully) form a directed acyclic graph, +as displayed in the image below: + + +---------------------------------------------------------------------------+ + | defaults | + | repositories = { repo1 = ... } | + | facts = { | + | opt1 = false, opt2 = 'def', opt3 = 1, opt4 = { rec = true }, | + | opt5 = [ 1, 2, 3 ] | + | } | + | packages = [ 'pkg1', 'pkg2' ] | + | | + +---------------------------------------------------------------------------+ + ^ ^ ^ + | | | + +-------------------+ +-------------------+ +-------------------+ + | cfg1 | | cfg2 | | cfg3 | + | facts = | | facts = | | facts = | + | {opt1 = false} | | {opt1 = false, | | {opt4 = | + +-------------------+ | optX = 'hallo'} | | {rec = false} | + ^ | packages = | | opt3 = 42} | + | | ['pkg2', 'pkg3'] | +-------------------+ + | +-------------------+ ^ + | ^ ^ | + | | | | + +-------------------+ | +-------------------+ + | cfg4 | | | cfg5 | + | facts = | | | facts = | + | {opt1 = false} | | | {opt1 = true} | + +-------------------+ | +-------------------+ + | ^ + | | + +-------------------+ + | cfg6 | + | packages = | + | [ 'pkg42' ] | + +-------------------+ + ^ + | + active configuration + +Dependencies between configurations are declared by the C<dependencies> member +inside the configuration block in F<config.toml>. + + [configurations.cfg6] + dependencies = ['cfg2', 'cfg5'] + +Igor merges the set of (transitively) active configurations from top to bottom: + + defaults -> cfg2 -> cfg3 -> cfg5 -> cfg5 + +Therefore, the above results in the following effective configuration: + + repositories = { repo1 = ...} + facts = { + opt1 = true, + opt2 = 'def', + opt3 = 42, + opt4 = {rec = false }, + opt5 = [1, 2, 3], + optX = 'hallo' + } + packages = ['pkg1', 'pkg2', 'pkg3', 'pkg42'] + +C<repositories> and C<facts> are merged by the NestedHash merge strategy. +Descend into the nested hash as far as possible. As soon as something is found +that is not a hash, its value is replaced by the value of the overlay. That +way, the key C<facts.opt4.rec> will be toggled from C<true> to C<false> when +C<cfg3> is merged into C<defaults>. + +The list C<packages> on the other hand is merged by concatenation of the lists +(and eliminating duplicates). + +To configure such context-preserving merge strategies for individual keys +within C<facts>, custom mergers can be defined (see L</Custom fact mergers>). + +=head3 Custom fact mergers + +Custom fact mergers allow to specify how multiple values inside the C<facts> +section of configurations should be merged inside the cascade described in the +preceding section. The declaration consists of three components. + +=over 4 + +=item 1. + +Description of the modified merge strategy as a file (e.g. +F<./mergers/althashmerger.pl>): + + sub { + my ($l, $r, $breadcrumbs) = @_; + # $l : left (= less specific) fact value + # $r : right (= more specific) fact value + # $breadcrumbs: arrayref describing the position in the facts hash, + # e.g. ['dev', 'languages'] for key 'facts.dev.languages' + + # Here, we simply take the more specific value (default behaviour) + return $r; + } + +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(@_) + } + +=item 2. + +The declaration of the merger inside the main configuration file. This is the +path to a file containing the code as a perl subroutine, which we symbolically +bind to the name C<altmerger>: + + [defaults] + mergers = { altmerger = './mergers/althashmerger.pl' } + +B<Note:> As fact-mergers are used to merge configurations, they can only be +specified within the C<[defaults]> section. + +=item 3. + +A description to what elements this merger should be applied. This configuration +is represented as a nested hash, where the leafs name the merger that should be +used to merge the specified values inside configurations. In the example, it +registers the C<altmerger> declared above for the facts in C<recursive.hell>. + + [defaults] + mergeconfig = { facts = { recursive = {hell = 'altmerger' } } } + +B<Note:> As fact-mergers are used to merge configurations, they can only be +specified within the C<[defaults]> section. + +=back + +=head3 Custom collection mergers + +Custom collection mergers are declared analogous to custom fact mergers by +defining the merge routine as a perl sub inside a file and symbolically naming +it insed the main config file: + + [configurations.config] + mergers = { + envmerger = './mergers/envmerger.pl', + } + +Contents of F<./mergers/envmerger.pl>, which ensures that the contents of the +C<main/base> package will be at the head of the merged configuration file: + + sub { + my $hash = shift; + # Hash of packagename -> filecontens + + # Perform a copy as we will do destructive updates below + my %copy = %$hash; + + # Extract the contents of the "base"-packages, as we want to prepend it + my $base = $copy{'main/base'}; + delete $copy{'main/base'}; + + # Order the other artifacts in alphabetic order by package name + my @keys = sort { $a cmp $b } keys %copy; + join('', $base, map {$copy{$_}} @keys) + } + +Those custom mergers can then be referenced by setting the C<merger> parameter +for specified collections: + + [configurations.config] + collections = { + 'env.sh' = { + destination = '~/env.sh', + merger = 'envmerger', + } + } + +=head3 Custom factors + +Some facts can be automatically obtained from the execution environment by +executing so called C<factors>, which are declared in the C<defaults.factors> +array in the main configuration file: + + [defaults] + factors = [ + {path = './factors/executables.sh', type = 'script'}, + {path = './factors/environment.pl', type = 'perl'}, + ] + +There are two types of factors: + +=over 4 + +=item C<script> factors + + + [defaults] + factors = [ + {path = './factors/executables.sh', type = 'script'}, + } + +Execute scripts using C<system> und parse the scripts stdout as +L<TOML|https://github.com/toml-lang/toml>, e.g.: + + # ./factors/executables.sh + #!/usr/bin/env sh + + # Find all executable binaries in PATH and store them in the "automatic.executables" + # fact as an array. + echo "executables = [" + + IFS=':'; + for i in $PATH; do + test -d "$i" && find "$i" -maxdepth 1 -executable -type f -exec basename {} \;; + done | sort -u | sed 's/^/\t"/g;s/$/",/g' + + echo "]" + +=item C<perl> factors + + [defaults] + factors = [ + {path = './factors/environment.pl', type = 'perl'}, + ] + +Execute a perl sub and use the returned perl datastructure as automatically +generated facts, e.g.: + + # ./factors/environment.pl + sub { + # store the environment variables as an automatic fact in "automatic.env" + {env => \%ENV} + } + +=back + +=head3 Task selection + +If no task/configuration is specified at the command line using the C<--task> +command line argument, igor tries to autodetect the configuration to apply. +The first step is guessing an identifier by determining the fully qualified +domain name (FQDN) and falling back to the plain hostname if the FQDN is +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. + +=head2 EXAMPLE + +Here, a more complete example showing of the different features in TOML syntax. + + [defaults] + repositories = { + main = { path = './repo' } + } + facts = { + haskell = true, + } + factors = [ + {path = './factors/executables.sh', type = 'script'}, + {path = './factors/environment.pl', type = 'perl'}, + ] + mergers = { altmerger = './mergers/althashmerger.pl' } + mergeconfig = { facts = { recursive = {hell = 'altmerger' } } } + + [configurations.interactive] + packages = ['tmux'] + facts = { + haskell = true, + perl = true, + recursive = { + hell = ['hades'], + truth = 42, + } + } + + [configurations.computer] + dependencies = ['interactive'] + packages = ['vim', 'file-test', 'perlpackage-test'] + facts = { + haskell = false, + recursive = {hell = ['hades', 'hel']}, + } + mergers = { + envmerger = './mergers/envmerger.pl', + } + collections = { + 'env.sh' = { + destination = '~/env.sh', + merger = 'envmerger', + }, + 'test1.collection' = { + destination = '~/test/test1.collection', + perm = "0644", + }, + 'test2.collection' = { + destination = '~/test/test2.collection', + } + } + + + + +=head2 INSTALLATION / DISTRIBUTION + +Igor is designed to be portable and not require an actual installation on +the host system (even more: it is actually designed with public systems such +as university infrastructure in mind, where the user might not possess +administrator privileges). + +Instead, igor is best distributed as a single script file (fatpacked, that is +containing all dependencies) alongside your dotfiles. + +To obtain the fatpacked script, either download it from the official release +page or build it yourself: + + # Install all dependencies locally to ./local using carton + # See DEVELOPMENT SETUP below for details + carton install + ./bin/fatpack.sh + +The fatpacked script can be found in F<./bin/igor.fatpacked.pl> and be executed +standalone. + +=head2 HACKING + +=head3 DESGIN/CODE STRUCTURE + +C<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 2. +Parsing the config + +=item 3. +Using the layering system to determine the config to apply + +=item 4. +Building the package database and configuring the individual packages + +=item 5. +Applying the relevant subcommand (eiter applying a configuration, diff, gc...) + +=back + +The last step (5.) borrows a lot of its internal structure from the layout of +compilers: Each package is deconstructed into a set of C<transactions>. These +transactions describe the operations to install the package. Available +operations include: Collecting facts (C<RunFactor>), executing commands +(C<RunCommand>), symlinking or copying files (C<FileTransfer>) and installing +templates (C<Template>) and finally merging and emitting collections +(C<EmitCollection>). Each transaction has an attribute (C<Operation::order>) +that defines the execution order of the individual transaction. + +=head3 LIBRARIES + +Igor uses a couple of external libraries that ease development and foster code +reuse. However, to maintain portability and the ability to fatpack igor for +distribution, B<all libraries used have to be pure perl libraries>. +All libraries used can be found in the F<cpanfile>. + +The most ubiquitous libraries that you will notice when working with the code are: + +=over 4 + +=item C<Class::Tiny> + +Igor uses an object-oriented design. C<Class::Tiny> is used to ease class +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 +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). + +=item C<Path::Tiny> + +All variables describing filepaths are converted to C<Path::Tiny> at first +opportunity. The objects provide a wide variety of auxiliary functions for dealing +with files. + +=item C<Types::Standard> + +C<Types::Standard> is used to verify conformance of parsed, nested configuration +data structures with the expected format. + +=back + +=head3 DEVELOPMENT SETUP + +=head4 Installing dependencies + +Igor provides a F<cartonfile> to declare and manage its library dependencies. +Therefore L<carton|https://metacpan.org/release/carton> can be used to install +the required nonstandard libraries: + + carton install + +Carton can then be used to execute C<igor> with those locally installed libs: + + carton exec -- ./igor.pl --help + +=head4 Running tests + +Several unittests are provided. They are written with C<Test::More> and reside +in the folder F<./t> and can be executed using C<prove> or, when using carton +by running C<carton exec prove>. + +In addition, an example configuration is provided in F<./test/test_minimal> as +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 + +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<./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 +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>). + + # On host + # Build/Prepare + ./bin/builddocker.pl # just once + ./bin/fatpack.sh # just once + # Start the container + ./bin/devup.sh + + # In the container + ./igor.packed.pl --help + +=cut diff --git a/vim/files/after/ftplugin/c.vim b/vim/files/after/ftplugin/c.vim new file mode 100644 index 0000000..2e39262 --- /dev/null +++ b/vim/files/after/ftplugin/c.vim @@ -0,0 +1,5 @@ +if dein#tap('vim-lsp') + if executable('ccls') + setl omnifunc=lsp#complete + endif +endif diff --git a/vim/files/dein.toml b/vim/files/dein.toml new file mode 100644 index 0000000..372f4c6 --- /dev/null +++ b/vim/files/dein.toml @@ -0,0 +1,117 @@ +[[plugins]] +repo = 'Shougo/dein.vim' + +[[plugins]] +repo = 'roxma/vim-hug-neovim-rpc' +lazy = 1 + +[[plugins]] +repo = 'roxma/nvim-yarp' +lazy = 1 + +[[plugins]] +repo = 'Shougo/denite.nvim' +lazy = 1 +on_cmd = 'Denite' +depends = ['vim-hug-neovim-rpc', 'nvim-yarp'] + +[[plugins]] +repo = 'chriskempson/base16-vim' + +[[plugins]] +repo = 'tpope/vim-unimpaired' +lazy = 1 +on_i = 1 + +[[plugins]] +repo = 'cespare/vim-toml' + +[[plugins]] +repo = 'ledger/vim-ledger' + +[[plugins]] +repo = 'sirtaj/vim-openscad' + +[[plugins]] +repo = 'vim-scripts/a.vim' +lazy = 1 +on_ft = ['c', 'cpp'] + +[[plugins]] +repo = 'Twinside/vim-hoogle' +lazy = 1 +external_commands = 'hoogle' +on_ft = ['haskell', 'lhaskell', 'chaskell'] + +[[plugins]] +repo = 'ujihisa/unite-haskellimport' +lazy = 1 +external_commands = 'hoogle' + +[[plugins]] +repo = 'rust-lang/rust.vim' +lazy = 1 +on_ft = 'rust' + +[[plugins]] +repo = 'MarcWeber/vim-addon-local-vimrc' + +[[plugins]] +repo = 'neomake/neomake' +lazy = 1 +on_cmd = 'Neomake' + +[[plugins]] +repo = 'lambdalisue/gina.vim' +rev = 'v1.0.*' +lazy = 1 +on_cmd = 'Gina' + +[[plugins]] +repo = 'Shougo/neosnippet.vim' +lazy = 1 +on_map = {i = '<Plug>'} + +[[plugins]] +repo = 'Shougo/neosnippet-snippets' +lazy = 1 +on_source = 'neosnippet.vim' + +[[plugins]] +repo = 'junegunn/vim-easy-align' +lazy = 1 +on_cmd = ['EasyAlign', 'LiveEasyAlign'] +on_map = '<Plug>(EasyAlign)' + +[[plugins]] +repo = 'kana/vim-operator-user' +lazy = 1 +on_source = 'vim-operator-surround' + +[[plugins]] +repo = 'rhysd/vim-operator-surround' +lazy = 1 +on_map = {n = '<Plug>'} + +[[plugins]] +repo = 'kana/vim-textobj-user' + +[[plugins]] +repo = 'thinca/vim-textobj-between' +lazy = 1 +on_map = { xo = '<Plug>' } +depends = ['vim-textobj-user'] + +[[plugins]] +repo = 'kana/vim-textobj-indent' +lazy = 1 +on_map = { xo = '<Plug>' } +depends = ['vim-textobj-user'] + +[[plugins]] +repo = 'prabirshrestha/async.vim' + +[[plugins]] +repo = 'prabirshrestha/vim-lsp' +lazy = 0 +depends = ['async.vim'] diff --git a/vim/files/ftplugin/c.vim b/vim/files/ftplugin/c.vim new file mode 100644 index 0000000..f08009e --- /dev/null +++ b/vim/files/ftplugin/c.vim @@ -0,0 +1,16 @@ +setl cin cino+=:0,(s,l1 +if has('cscope') + if filereadable("cscope.out") + cs add cscope.out + endif + nnoremap [cscope] <Nop> + nmap <C-\> [cscope] + nmap [cscope]s :cs find s <C-R>=expand("<cword>")<CR><CR> + nmap [cscope]g :cs find g <C-R>=expand("<cword>")<CR><CR> + nmap [cscope]c :cs find c <C-R>=expand("<cword>")<CR><CR> + nmap [cscope]t :cs find t <C-R>=expand("<cword>")<CR><CR> + nmap [cscope]e :cs find e <C-R>=expand("<cword>")<CR><CR> + nmap [cscope]f :cs find f <C-R>=expand("<cfile>")<CR><CR> + nmap [cscope]i :cs find i ^<C-R>=expand("<cfile>")<CR>$<CR> + nmap [cscope]d :cs find d <C-R>=expand("<cword>")<CR><CR> +endif diff --git a/vim/files/ftplugin/haskell.vim b/vim/files/ftplugin/haskell.vim new file mode 100644 index 0000000..23a4130 --- /dev/null +++ b/vim/files/ftplugin/haskell.vim @@ -0,0 +1,2 @@ +setl tags+=codex.tags +setl ts=8 sts=4 sw=4 et sr diff --git a/vim/files/ftplugin/tex.vim b/vim/files/ftplugin/tex.vim new file mode 100644 index 0000000..72097c4 --- /dev/null +++ b/vim/files/ftplugin/tex.vim @@ -0,0 +1,5 @@ +setl lbr +nnoremap <expr> j v:count ? 'j' : 'gj' +vnoremap <expr> j v:count ? 'j' : 'gj' +nnoremap <expr> k v:count ? 'k' : 'gk' +vnoremap <expr> k v:count ? 'k' : 'gk' diff --git a/vim/files/plugrc/vimfiler.rc.vim b/vim/files/plugrc/vimfiler.rc.vim new file mode 100644 index 0000000..3c80c47 --- /dev/null +++ b/vim/files/plugrc/vimfiler.rc.vim @@ -0,0 +1,6 @@ +let g:vimfiler_as_default_explorer = 1 +let g:vimfiler_tree_indentation = 1 +let g:vimfiler_tree_opened_icon = "▼" +let g:vimfiler_tree_closed_icon = "▷" +let g:vimfiler_readonly_file_icon = "⭤" +let g:vimfiler_marked_file_icon = '✓' diff --git a/vim/files/vimrc b/vim/files/vimrc new file mode 100644 index 0000000..ac03d93 --- /dev/null +++ b/vim/files/vimrc @@ -0,0 +1,177 @@ +set nocompatible + +" Environment http://tlvince.com/vim-respect-xdg +if !exists($XDG_CONFIG_HOME) + let $XDG_CONFIG_HOME=expand('~/.config') +endif +if !exists($XDG_DATA_HOME) + let $XDG_DATA_HOME=expand('~/.local/share') +endif +if !exists($XDG_CACHE_HOME) + let $XDG_CACHE_HOME=expand('~/.cache') +endif + +set directory=$XDG_CACHE_HOME/vim/swp//,/var/tmp//,/tmp// +set undodir=$XDG_CACHE_HOME/vim/undo//,/var/tmp//,/tmp// +set backupdir=$XDG_CACHE_HOME/vim/backup,/var/tmp,/tmp +set viminfo+=n$XDG_CACHE_HOME/vim/viminfo +set rtp=$XDG_CONFIG_HOME/vim,$VIM/vimfiles,$VIMRUNTIME,$VIM/vimfiles/after,$XDG_CONFIG_HOME/vim/after + +" dein.vim +let s:dein_base = $XDG_DATA_HOME . '/vim/dein' +let s:dein_repo_path = s:dein_base . '/repos/github.com/Shougo/dein.vim' +let s:dein_repo_url = 'https://github.com/Shougo/dein.vim' +let s:dein_toml = $XDG_CONFIG_HOME . '/vim/dein.toml' +let s:plugrc = $XDG_CONFIG_HOME . '/vim/plugrc' +let &runtimepath.=','.s:dein_repo_path + +function! s:hook_source() abort + let l:rcfile = s:plugrc . '/' . g:dein#plugin.normalized_name . '.rc.vim' + let g:dein#plugin.hook_source = "source " . l:rcfile +endfunction + +" dein.vim +let g:dein#types#git#clone_depth = 1 +try + if dein#load_state(s:dein_base) + call dein#begin(s:dein_base) + call dein#load_toml(s:dein_toml) + call dein#end() + call dein#save_state() + endif +catch /E117:/ " dein not installed + execute "silent !git clone" s:dein_repo_url s:dein_repo_path + call dein#begin(s:dein_base) + call dein#load_toml(s:dein_toml) + set nomore + call dein#install() + call dein#end() + quit +endtry + +if dein#tap('denite.nvim') + nnoremap [Denite] <Nop> + nmap <leader>d [Denite] + + nnoremap [Denite]g :<C-u>Denite grep -auto-preview -split=no -no-empty<CR> + nnoremap [Denite]f :<C-u>Denite file/rec -mode=insert -split=no<CR> + nnoremap [Denite]l :<C-u>Denite buffer file/old -split=no<CR> + nnoremap [Denite]r :<C-u>Denite -resume -refresh<CR> + + nnoremap [Denite]gf :DeniteCursorWord file/rec<CR> + nnoremap [Denite]gg :DeniteCursorWord grep<Cr> + nnoremap [Denite]g/ :DeniteCursorWord line<Cr> +endif +if dein#tap('vimfiler.vim') + call s:hook_source() +endif +if dein#tap('neosnippet.vim') + let g:neosnippet#snippets_directory = + \ $XDG_CONFIG_HOME . '/vim/snippets' + imap <C-k> <Plug>(neosnippet_expand_or_jump) + smap <C-k> <Plug>(neosnippet_expand_or_jump) + xmap <C-k> <Plug>(neosnippet_expand_or_jump) +endif +if dein#tap('vim-easy-align') + nmap ga <Plug>(EasyAlign) +endif +if dein#tap('vim-textobj-between') + let g:textobj_between_no_default_key_mappings = 1 + omap af <Plug>(textobj-between-a) + omap if <Plug>(textobj-between-i) + xmap af <Plug>(textobj-between-a) + xmap if <Plug>(textobj-between-i) +endif +if dein#tap('vim-textobj-indent') + let g:textobj_indent_no_default_key_mappings = 1 + omap ai <Plug>(textobj-indent-a) + omap ii <Plug>(textobj-indent-i) + xmap ai <Plug>(textobj-indent-a) + xmap ii <Plug>(textobj-indent-i) + + omap aI <Plug>(textobj-indent-same-a) + omap iI <Plug>(textobj-indent-same-i) + xmap aI <Plug>(textobj-indent-same-a) + xmap iI <Plug>(textobj-indent-same-i) +endif +if dein#tap('vim-operator-surround') + nmap <silent>sa <Plug>(operator-surround-append) + nmap <silent>sd <Plug>(operator-surround-delete) + nmap <silent>sr <Plug>(operator-surround-replace) +endif +if dein#tap('vim-addon-local-vimrc') + let g:local_vimrc = {'names':['.lvimrc'],'hash_fun':'LVRHashOfFile'} +endif +if dein#tap('vim-lsp') + if executable('ccls') + au User lsp_setup call lsp#register_server({ + \ 'name': 'ccls', + \ 'cmd': {server_info->['ccls']}, + \ 'root_uri': {server_info->lsp#utils#path_to_uri(lsp#utils#find_nearest_parent_file_directory(lsp#utils#get_buffer_path(), 'compile_commands.json'))}, + \ 'initialization_options': {'cache': {'directory': '/tmp/ccls/cache' }}, + \ 'whitelist': ['c', 'cpp', 'objc', 'objcpp'], + \ }) + endif + if executable('rls') + au User lsp_setup call lsp#register_server({ + \ 'name': 'rls', + \ 'cmd': {server_info->['rustup', 'run', 'nightly', 'rls']}, + \ 'whitelist': ['rust'], + \ }) + + au FileType rust setl omnifunc=lsp#complete + endif + if executable('hie-wrapper') + au User lsp_setup call lsp#register_server({ + \ 'name': 'hie', + \ 'cmd': {server_info->['hie-wrapper']}, + \ 'whitelist': ['haskell'], + \ }) + + au FileType haskell setl omnifunc=lsp#complete + endif + + nnoremap [Lsp] <Nop> + nmap <leader>l [Lsp] + + nmap [Lsp]dd <Plug>(lsp-definition) + nmap [Lsp]s <Plug>(lsp-document-symbol) + nmap [Lsp]i <Plug>(lsp-document-diagnostics) + nmap [Lsp]r <Plug>(lsp-rename) +endif +if dein#tap('base16-vim') + set bg=dark + let base16colorspace=256 + colorscheme base16-monokai +endif + +filetype plugin indent on +syntax on + +set ai +set bs=2 +set cc=80 +set fdm=syntax +set formatoptions+=j +set lcs=tab:\│\ ,trail:·,eol:¬ +set ls=2 +set nu +set rnu +set ru +set si +set sta +set sw=4 +set ts=4 +set ttyfast +set udf +set wmnu + +if has('gui_running') + set go=m +endif + +" Filebin +com -range=% Fb :exec "<line1>,<line2>w !fb -e ".&filetype." -n ".expand("%:t") + +" Write with sudo +com W w !sudo tee % > /dev/null diff --git a/vim/package.toml b/vim/package.toml new file mode 100644 index 0000000..d861910 --- /dev/null +++ b/vim/package.toml @@ -0,0 +1,3 @@ +[[files]] +source = './files' +dest = '~/.config/vim' diff --git a/zsh/.zprofile b/zsh/.zprofile new file mode 100644 index 0000000..0d2a4e3 --- /dev/null +++ b/zsh/.zprofile @@ -0,0 +1,11 @@ +# exports +EDITOR=vim +VIMINIT='let $MYVIMRC="~/.config/vim/vimrc" | source $MYVIMRC' +TEXMFHOME=~/.local/share/texlive +TEXMFCONFIG=~/.config/texlive +TEXMFVAR=~/.cache/texlive +export EDITOR VIMINIT TASKRC TEXMFHOME TEXMFCONFIG TEXMFVAR + +eval "$(perl -I$HOME/.local/perl5/lib/perl5/ -Mlocal::lib=--deactivate-all,$HOME/.local/perl5)" + +[[ -z $DISPLAY && $XDG_VTNR -eq 1 ]] && exec startx diff --git a/zsh/.zshrc b/zsh/.zshrc new file mode 100644 index 0000000..75ba23e --- /dev/null +++ b/zsh/.zshrc @@ -0,0 +1,57 @@ +# Input/Output +setopt interactive_comments + +# Expansion and Globbing +setopt extended_glob nomatch + +# Job Control +unsetopt notify + +# History +setopt append_history hist_ignore_dups hist_ignore_space +HISTFILE=~/.cache/zsh/histfile +HISTSIZE=1000 +SAVEHIST=100000 + +# Zle +setopt beep +autoload -z edit-command-line +zle -N edit-command-line + +# Keybinds +bindkey -e +bindkey \^U backward-kill-line +bindkey \^X\^E edit-command-line + +# Changing Directories +setopt auto_cd auto_pushd +DIRSTACKSIZE=30 + +# Completion +setopt always_to_end list_ambiguous +zstyle ':completion:*' menu select +zstyle ':completion:*' use-perl on +zstyle ':completion:*' use-cache on +zstyle ':completion:*' cache-path $HOME/.cache/zsh/complcache +zstyle ':completion:*:*:kill:*' command 'ps --forest -u$USER -o pid,%cpu,tty,cputime,cmd' +zstyle :compinstall filename "$HOME/.config/zsh/.zshrc" +autoload -Uz compinit +compinit -d $HOME/.cache/zsh/zcompdump + +# Misc +PATH=$PATH:~/.local/bin +REPORTTIME=2 +PROMPT=": " +RPROMPT="%1~" + +# Aliases +alias _='sudo ' +alias g='git' +alias hc='herbstclient' +alias l='ls -l' +alias ll='ls -la' +alias p='pacman' +alias sc='systemctl' +alias aria2c="aria2c --conf-path=$HOME/.config/aria2/config" +alias chat="ssh karif -t 'TERM=\"xterm\" /usr/bin/bash -l -c \"tmux attach -t weechat\"'" +alias tmux='tmux -f ~/.config/tmux/tmux.conf' |