Initial Commit

database/perl/vendor/lib/Term/ReadKey.pm

@@ -0,0 +1,493 @@
+# -*- buffer-read-only: t -*-
+#
+# This file is auto-generated. ***ANY*** changes here will be lost
+#
+package Term::ReadKey;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+Term::ReadKey - A perl module for simple terminal control
+
+=head1 SYNOPSIS
+
+    use Term::ReadKey;
+    ReadMode 4; # Turn off controls keys
+    while (not defined ($key = ReadKey(-1))) {
+        # No key yet
+    }
+    print "Get key $key\n";
+    ReadMode 0; # Reset tty mode before exiting
+
+=head1 DESCRIPTION
+
+Term::ReadKey is a compiled perl module dedicated to providing simple
+control over terminal driver modes (cbreak, raw, cooked, etc.,) support for
+non-blocking reads, if the architecture allows, and some generalized handy
+functions for working with terminals. One of the main goals is to have the
+functions as portable as possible, so you can just plug in "use
+Term::ReadKey" on any architecture and have a good likelihood of it working.
+
+Version 2.30.01:
+Added handling of arrows, page up/down, home/end, insert/delete keys 
+under Win32. These keys emit xterm-compatible sequences.
+Works with Term::ReadLine::Perl.
+
+=over 4
+
+=item ReadMode MODE [, Filehandle]
+
+Takes an integer argument or a string synonym (case insensitive), which
+can currently be one of the following values:
+
+    INT   SYNONYM    DESCRIPTION
+
+    0    'restore'   Restore original settings.
+
+    1    'normal'    Change to what is commonly the default mode,
+                     echo on, buffered, signals enabled, Xon/Xoff
+                     possibly enabled, and 8-bit mode possibly disabled.
+
+    2    'noecho'    Same as 1, just with echo off. Nice for
+                     reading passwords.
+
+    3    'cbreak'    Echo off, unbuffered, signals enabled, Xon/Xoff
+                     possibly enabled, and 8-bit mode possibly enabled.
+
+    4    'raw'       Echo off, unbuffered, signals disabled, Xon/Xoff
+                     disabled, and 8-bit mode possibly disabled.
+
+    5    'ultra-raw' Echo off, unbuffered, signals disabled, Xon/Xoff 
+                     disabled, 8-bit mode enabled if parity permits,
+                     and CR to CR/LF translation turned off. 
+
+
+These functions are automatically applied to the STDIN handle if no
+other handle is supplied. Modes 0 and 5 have some special properties
+worth mentioning: not only will mode 0 restore original settings, but it
+cause the next ReadMode call to save a new set of default settings. Mode
+5 is similar to mode 4, except no CR/LF translation is performed, and if
+possible, parity will be disabled (only if not being used by the terminal,
+however. It is no different from mode 4 under Windows.)
+
+If you just need to read a key at a time, then modes 3 or 4 are probably
+sufficient. Mode 4 is a tad more flexible, but needs a bit more work to
+control. If you use ReadMode 3, then you should install a SIGINT or END
+handler to reset the terminal (via ReadMode 0) if the user aborts the
+program via C<^C>. (For any mode, an END handler consisting of "ReadMode 0"
+is actually a good idea.)
+
+If you are executing another program that may be changing the terminal mode,
+you will either want to say
+
+    ReadMode 1;             # same as ReadMode 'normal'
+    system('someprogram');
+    ReadMode 1;
+
+which resets the settings after the program has run, or:
+
+    $somemode=1;
+    ReadMode 0;             # same as ReadMode 'restore'
+    system('someprogram');
+    ReadMode 1;
+
+which records any changes the program may have made, before resetting the
+mode.
+
+=item ReadKey MODE [, Filehandle]
+
+Takes an integer argument, which can currently be one of the following 
+values:
+
+    0    Perform a normal read using getc
+    -1   Perform a non-blocked read
+    >0	 Perform a timed read
+
+If the filehandle is not supplied, it will default to STDIN. If there is
+nothing waiting in the buffer during a non-blocked read, then undef will be
+returned.  In most situations, you will probably want to use C<ReadKey -1>.
+
+I<NOTE> that if the OS does not provide any known mechanism for non-blocking
+reads, then a C<ReadKey -1> can die with a fatal error. This will hopefully
+not be common.
+
+If MODE is greater then zero, then ReadKey will use it as a timeout value in
+seconds (fractional seconds are allowed), and won't return C<undef> until
+that time expires.
+
+I<NOTE>, again, that some OS's may not support this timeout behaviour.
+
+If MODE is less then zero, then this is treated as a timeout
+of zero, and thus will return immediately if no character is waiting. A MODE
+of zero, however, will act like a normal getc.
+
+I<NOTE>, there are currently some limitations with this call under Windows.
+It may be possible that non-blocking reads will fail when reading repeating
+keys from more then one console.
+
+
+=item ReadLine MODE [, Filehandle]
+
+Takes an integer argument, which can currently be one of the following 
+values:
+
+    0    Perform a normal read using scalar(<FileHandle>)
+    -1   Perform a non-blocked read
+    >0	 Perform a timed read
+
+If there is nothing waiting in the buffer during a non-blocked read, then
+undef will be returned.
+
+I<NOTE>, that if the OS does not provide any known mechanism for
+non-blocking reads, then a C<ReadLine 1> can die with a fatal
+error. This will hopefully not be common.
+
+I<NOTE> that a non-blocking test is only performed for the first character
+in the line, not the entire line.  This call will probably B<not> do what
+you assume, especially with C<ReadMode> MODE values higher then 1. For
+example, pressing Space and then Backspace would appear to leave you
+where you started, but any timeouts would now be suspended.
+
+B<This call is currently not available under Windows>.
+
+=item GetTerminalSize [Filehandle]
+
+Returns either an empty array if this operation is unsupported, or a four
+element array containing: the width of the terminal in characters, the
+height of the terminal in character, the width in pixels, and the height in
+pixels. (The pixel size will only be valid in some environments.)
+
+I<NOTE>, under Windows, this function must be called with an B<output>
+filehandle, such as C<STDOUT>, or a handle opened to C<CONOUT$>.
+
+=item SetTerminalSize WIDTH,HEIGHT,XPIX,YPIX [, Filehandle]
+
+Return -1 on failure, 0 otherwise.
+
+I<NOTE> that this terminal size is only for B<informative> value, and
+changing the size via this mechanism will B<not> change the size of
+the screen. For example, XTerm uses a call like this when
+it resizes the screen. If any of the new measurements vary from the old, the
+OS will probably send a SIGWINCH signal to anything reading that tty or pty.
+
+B<This call does not work under Windows>.
+
+=item GetSpeed [, Filehandle]
+
+Returns either an empty array if the operation is unsupported, or a two
+value array containing the terminal in and out speeds, in B<decimal>. E.g,
+an in speed of 9600 baud and an out speed of 4800 baud would be returned as
+(9600,4800). Note that currently the in and out speeds will always be
+identical in some OS's.
+
+B<No speeds are reported under Windows>.
+
+=item GetControlChars [, Filehandle]
+
+Returns an array containing key/value pairs suitable for a hash. The pairs
+consist of a key, the name of the control character/signal, and the value
+of that character, as a single character.
+
+B<This call does nothing under Windows>.
+
+Each key will be an entry from the following list:
+
+	DISCARD
+	DSUSPEND
+	EOF
+	EOL
+	EOL2
+	ERASE
+	ERASEWORD
+	INTERRUPT
+	KILL
+	MIN
+	QUIT
+	QUOTENEXT
+	REPRINT
+	START
+	STATUS
+	STOP
+	SUSPEND
+	SWITCH
+	TIME
+
+Thus, the following will always return the current interrupt character,
+regardless of platform.
+
+	%keys = GetControlChars;
+	$int = $keys{INTERRUPT};
+
+=item SetControlChars [, Filehandle]
+
+Takes an array containing key/value pairs, as a hash will produce. The pairs
+should consist of a key that is the name of a legal control
+character/signal, and the value should be either a single character, or a
+number in the range 0-255. SetControlChars will die with a runtime error if
+an invalid character name is passed or there is an error changing the
+settings. The list of valid names is easily available via
+
+	%cchars = GetControlChars();
+	@cnames = keys %cchars;
+
+B<This call does nothing under Windows>.
+
+=back
+
+=head1 AUTHOR
+
+Kenneth Albanowski <kjahds@kjahds.com>
+
+Currently maintained by Jonathan Stowe <jns@gellyfish.co.uk>
+
+=head1 SUPPORT
+
+The code is maintained at 
+
+     https://github.com/jonathanstowe/TermReadKey
+
+Please feel free to fork and suggest patches.
+
+
+=head1 LICENSE
+
+Prior to the 2.31 release the license statement was:
+
+ Copyright (C) 1994-1999 Kenneth Albanowski.
+               2001-2005 Jonathan Stowe and others
+
+               Unlimited distribution and/or modification is allowed as long as this
+               copyright notice remains intact.
+
+And was only stated in the README file.
+
+Because I believe the original author's intent was to be more open than the
+other commonly used licenses I would like to leave that in place. However if
+you or your lawyers require something with some more words you can optionally
+choose to license this under the standard Perl license:
+
+      This module is free software; you can redistribute it and/or modify it
+      under the terms of the Artistic License. For details, see the full
+      text of the license in the file "Artistic" that should have been provided
+      with the version of perl you are using.
+
+      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.
+
+
+=cut
+
+use vars qw($VERSION);
+
+$VERSION = '2.38';
+
+require Exporter;
+require DynaLoader;
+
+use vars qw(@ISA @EXPORT_OK @EXPORT);
+
+@ISA = qw(Exporter DynaLoader);
+
+# Items to export into callers namespace by default
+# (move infrequently used names to @EXPORT_OK below)
+
+@EXPORT = qw(
+  ReadKey
+  ReadMode
+  ReadLine
+  GetTerminalSize
+  SetTerminalSize
+  GetSpeed
+  GetControlChars
+  SetControlChars
+);
+
+@EXPORT_OK = qw();
+
+bootstrap Term::ReadKey;
+
+# Should we use LINES and COLUMNS to try and get the terminal size?
+# Change this to zero if you have systems where these are commonly
+# set to erroneous values. (But if either are near zero, they won't be
+# used anyhow.)
+
+use vars qw($UseEnv $CurrentMode %modes);
+
+$UseEnv = 1;
+
+$CurrentMode = 0;
+
+%modes = (                            # lowercase is canonical
+    original    => 0,
+    restore     => 0,
+    normal      => 1,
+    noecho      => 2,
+    cbreak      => 3,
+    raw         => 4,
+    'ultra-raw' => 5
+);
+
+# reduce Carp memory footprint, only load when needed
+sub croak { require Carp; goto &Carp::croak; }
+sub carp  { require Carp; goto &Carp::carp; }
+
+sub ReadMode
+{
+    my $mode = $modes{ lc $_[0] };  # lowercase is canonical
+    my $fh = normalizehandle( ( @_ > 1 ? $_[1] : \*STDIN ) );
+
+    if ( defined($mode) )    { $CurrentMode = $mode }
+    elsif ( $_[0] =~ /^\d/ ) { $CurrentMode = $_[0] }
+    else                     { croak("Unknown terminal mode `$_[0]'"); }
+
+    SetReadMode($CurrentMode, $fh);
+}
+
+sub normalizehandle
+{
+    my ($file) = @_; # allows fake signature optimization
+
+    no strict;
+    #	print "Handle = $file\n";
+    if ( ref($file) ) { return $file; }    # Reference is fine
+
+    #	if ($file =~ /^\*/) { return $file; } # Type glob is good
+    if ( ref( \$file ) eq 'GLOB' ) { return $file; }    # Glob is good
+
+    #	print "Caller = ",(caller(1))[0],"\n";
+    return \*{ ( ( caller(1) )[0] ) . "::$file" };
+}
+
+sub GetTerminalSize
+{
+    my $file = normalizehandle( ( @_ > 0 ? $_[0] : \*STDOUT ) );
+
+    my (@results, @fail);
+
+    if ( &termsizeoptions() & 1 )                       # VIO
+    {
+        @results = GetTermSizeVIO($file);
+        push( @fail, "VIOGetMode call" );
+    }
+    elsif ( &termsizeoptions() & 2 )                    # GWINSZ
+    {
+        @results = GetTermSizeGWINSZ($file);
+        push( @fail, "TIOCGWINSZ ioctl" );
+    }
+    elsif ( &termsizeoptions() & 4 )                    # GSIZE
+    {
+        @results = GetTermSizeGSIZE($file);
+        push( @fail, "TIOCGSIZE ioctl" );
+    }
+    elsif ( &termsizeoptions() & 8 )                    # WIN32
+    {
+        @results = GetTermSizeWin32($file);
+        push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
+    }
+    else
+    {
+        @results = ();
+    }
+
+    if ( @results < 4 and $UseEnv )
+    {
+        my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
+        my ($L) = defined( $ENV{LINES} )   ? $ENV{LINES}   : 0;
+        if ( ( $C >= 2 ) and ( $L >= 2 ) )
+        {
+            @results = ( $C + 0, $L + 0, 0, 0 );
+        }
+        push( @fail, "COLUMNS and LINES environment variables" );
+    }
+
+    if ( @results < 4 && $^O ne 'MSWin32')
+    {
+        my ($prog) = "resize";
+
+        # Workaround for Solaris path silliness
+        if ( -f "/usr/openwin/bin/resize" ) {
+            $prog = "/usr/openwin/bin/resize";
+        }
+
+        my ($resize) = scalar(`$prog 2>/dev/null`);
+        if (defined $resize
+            and (  $resize =~ /COLUMNS\s*=\s*(\d+)/
+                or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
+           )
+        {
+            $results[0] = $1;
+            if (   $resize =~ /LINES\s*=\s*(\d+)/
+                or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
+            {
+                $results[1] = $1;
+                @results[ 2, 3 ] = ( 0, 0 );
+            }
+            else
+            {
+                @results = ();
+            }
+        }
+        else
+        {
+            @results = ();
+        }
+        push( @fail, "resize program" );
+    }
+
+    if ( @results < 4 && $^O ne 'MSWin32' )
+    {
+        my ($prog) = "stty size";
+
+        my ($stty) = scalar(`$prog 2>/dev/null`);
+        if (defined $stty
+            and (  $stty =~ /(\d+) (\d+)/ )
+           )
+        {
+            $results[0] = $2;
+            $results[1] = $1;
+            @results[ 2, 3 ] = ( 0, 0 );
+        }
+        else
+        {
+            @results = ();
+        }
+        push( @fail, "stty program" );
+    }
+
+    if ( @results != 4 )
+    {
+        carp("Unable to get Terminal Size."
+             . join( "", map( " The $_ didn't work.", @fail ) ));
+	return undef;
+    }
+
+    @results;
+}
+
+# blockoptions: 
+#no nodelay
+#Win32
+sub ReadKey {
+    my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
+    if ($_[0] || $CurrentMode >= 3) {
+        Win32PeekChar($File, $_[0]);
+    } else {
+	getc $File;
+    }
+    #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
+    #getc $File;
+}
+sub ReadLine {
+    my $File = normalizehandle((@_>1?$_[1]:\*STDIN));
+    #if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
+    #scalar(<$File>);
+    if ($_[0]) {
+        croak("Non-blocking ReadLine is not supported on this architecture")
+    }
+    scalar(<$File>);
+}
+1;
+# ex: set ro:

database/perl/vendor/lib/Term/ReadLine/Perl.pm

@@ -0,0 +1,153 @@
+package Term::ReadLine::Perl;
+use Carp;
+@ISA = qw(Term::ReadLine::Stub Term::ReadLine::Compa Term::ReadLine::Perl::AU);
+#require 'readline.pl';
+
+$VERSION = $VERSION = 1.0303;
+
+sub readline {
+  shift; 
+  #my $in = 
+  &readline::readline(@_);
+  #$loaded = defined &Term::ReadKey::ReadKey;
+  #print STDOUT "\nrl=`$in', loaded = `$loaded'\n";
+  #if (ref \$in eq 'GLOB') {	# Bug under debugger
+  #  ($in = "$in") =~ s/^\*(\w+::)+//;
+  #}
+  #print STDOUT "rl=`$in'\n";
+  #$in;
+}
+
+#sub addhistory {}
+*addhistory = \&AddHistory;
+
+#$term;
+$readline::minlength = 1;	# To peacify -w
+$readline::rl_readline_name = undef; # To peacify -w
+$readline::rl_basic_word_break_characters = undef; # To peacify -w
+
+sub new {
+  if (defined $term) {
+    warn "Cannot create second readline interface, falling back to dumb.\n";
+    return Term::ReadLine::Stub::new(@_);
+  }
+  shift;			# Package
+  if (@_) {
+    if ($term) {
+      warn "Ignoring name of second readline interface.\n" if defined $term;
+      shift;
+    } else {
+      $readline::rl_readline_name = shift; # Name
+    }
+  }
+  if (!@_) {
+    if (!defined $term) {
+      ($IN,$OUT) = Term::ReadLine->findConsole();
+      # Old Term::ReadLine did not have a workaround for a bug in Win devdriver
+      $IN = 'CONIN$' if $^O eq 'MSWin32' and "\U$IN" eq 'CON';
+      open IN,
+	# A workaround for another bug in Win device driver
+	(($IN eq 'CONIN$' and $^O eq 'MSWin32') ? "+< $IN" : "< $IN")
+	  or croak "Cannot open $IN for read";
+      open(OUT,">$OUT") || croak "Cannot open $OUT for write";
+      $readline::term_IN = \*IN;
+      $readline::term_OUT = \*OUT;
+    }
+  } else {
+    if (defined $term and ($term->IN ne $_[0] or $term->OUT ne $_[1]) ) {
+      croak "Request for a second readline interface with different terminal";
+    }
+    $readline::term_IN = shift;
+    $readline::term_OUT = shift;    
+  }
+  eval {require Term::ReadLine::readline}; die $@ if $@;
+  # The following is here since it is mostly used for perl input:
+  # $readline::rl_basic_word_break_characters .= '-:+/*,[])}';
+  $term = bless [$readline::term_IN,$readline::term_OUT];
+  unless ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/) {
+    local $Term::ReadLine::termcap_nowarn = 1; # With newer Perls
+    local $SIG{__WARN__} = sub {}; # With older Perls
+    $term->ornaments(1);
+  }
+  return $term;
+}
+sub newTTY {
+  my ($self, $in, $out) = @_;
+  $readline::term_IN   = $self->[0] = $in;
+  $readline::term_OUT  = $self->[1] = $out;
+  my $sel = select($out);
+  $| = 1;				# for DB::OUT
+  select($sel);
+}
+sub ReadLine {'Term::ReadLine::Perl'}
+sub MinLine {
+  my $old = $readline::minlength;
+  $readline::minlength = $_[1] if @_ == 2;
+  return $old;
+}
+sub SetHistory {
+  shift;
+  @readline::rl_History = @_;
+  $readline::rl_HistoryIndex = @readline::rl_History;
+}
+sub GetHistory {
+  @readline::rl_History;
+}
+sub AddHistory {
+  shift;
+  push @readline::rl_History, @_;
+  $readline::rl_HistoryIndex = @readline::rl_History + @_;
+}
+%features =  (appname => 1, minline => 1, autohistory => 1, getHistory => 1,
+	      setHistory => 1, addHistory => 1, preput => 1, 
+	      attribs => 1, 'newTTY' => 1,
+	      tkRunning => Term::ReadLine::Stub->Features->{'tkRunning'},
+	      ornaments => Term::ReadLine::Stub->Features->{'ornaments'},
+	     );
+sub Features { \%features; }
+# my %attribs;
+tie %attribs, 'Term::ReadLine::Perl::Tie' or die ;
+sub Attribs {
+  \%attribs;
+}
+sub DESTROY {}
+
+package Term::ReadLine::Perl::AU;
+
+sub AUTOLOAD {
+  { $AUTOLOAD =~ s/.*:://; }		# preserve match data
+  my $name = "readline::rl_$AUTOLOAD";
+  die "Unknown method `$AUTOLOAD' in Term::ReadLine::Perl" 
+    unless exists $readline::{"rl_$AUTOLOAD"};
+  *$AUTOLOAD = sub { shift; &$name };
+  goto &$AUTOLOAD;
+}
+
+package Term::ReadLine::Perl::Tie;
+
+sub TIEHASH { bless {} }
+sub DESTROY {}
+
+sub STORE {
+  my ($self, $name) = (shift, shift);
+  $ {'readline::rl_' . $name} = shift;
+}
+sub FETCH {
+  my ($self, $name) = (shift, shift);
+  $ {'readline::rl_' . $name};
+}
+
+package Term::ReadLine::Compa;
+
+sub get_c {
+  my $self = shift;
+  getc($self->[0]);
+}
+
+sub get_line {
+  my $self = shift;
+  my $fh = $self->[0];
+  scalar <$fh>;
+}
+
+1;

database/perl/vendor/lib/Term/Table.pm

@@ -0,0 +1,451 @@
+package Term::Table;
+use strict;
+use warnings;
+
+our $VERSION = '0.015';
+
+use Term::Table::Cell();
+
+use Term::Table::Util qw/term_size uni_length USE_GCS/;
+use Scalar::Util qw/blessed/;
+use List::Util qw/max sum/;
+use Carp qw/croak carp/;
+
+use Term::Table::HashBase qw/rows _columns collapse max_width mark_tail sanitize show_header auto_columns no_collapse header allow_overflow pad/;
+
+sub BORDER_SIZE()   { 4 }    # '| ' and ' |' borders
+sub DIV_SIZE()      { 3 }    # ' | ' column delimiter
+sub CELL_PAD_SIZE() { 2 }    # space on either side of the |
+
+sub init {
+    my $self = shift;
+
+    croak "You cannot have a table with no rows"
+        unless $self->{+ROWS} && @{$self->{+ROWS}};
+
+    $self->{+MAX_WIDTH}   ||= term_size();
+    $self->{+NO_COLLAPSE} ||= {};
+    if (ref($self->{+NO_COLLAPSE}) eq 'ARRAY') {
+        $self->{+NO_COLLAPSE} = {map { ($_ => 1) } @{$self->{+NO_COLLAPSE}}};
+    }
+
+    if ($self->{+NO_COLLAPSE} && $self->{+HEADER}) {
+        my $header = $self->{+HEADER};
+        for(my $idx = 0; $idx < @$header; $idx++) {
+            $self->{+NO_COLLAPSE}->{$idx} ||= $self->{+NO_COLLAPSE}->{$header->[$idx]};
+        }
+    }
+
+    $self->{+PAD} = 4 unless defined $self->{+PAD};
+
+    $self->{+COLLAPSE}  = 1 unless defined $self->{+COLLAPSE};
+    $self->{+SANITIZE}  = 1 unless defined $self->{+SANITIZE};
+    $self->{+MARK_TAIL} = 1 unless defined $self->{+MARK_TAIL};
+
+    if($self->{+HEADER}) {
+        $self->{+SHOW_HEADER}  = 1 unless defined $self->{+SHOW_HEADER};
+    }
+    else {
+        $self->{+HEADER}       = [];
+        $self->{+AUTO_COLUMNS} = 1;
+        $self->{+SHOW_HEADER}  = 0;
+    }
+}
+
+sub columns {
+    my $self = shift;
+
+    $self->regen_columns unless $self->{+_COLUMNS};
+
+    return $self->{+_COLUMNS};
+}
+
+sub regen_columns {
+    my $self = shift;
+
+    my $has_header = $self->{+SHOW_HEADER} && @{$self->{+HEADER}};
+    my %new_col = (width => 0, count => $has_header ? -1 : 0);
+
+    my $cols = [map { {%new_col} } @{$self->{+HEADER}}];
+    my @rows = @{$self->{+ROWS}};
+
+    for my $row ($has_header ? ($self->{+HEADER}, @rows) : (@rows)) {
+        for my $ci (0 .. max(@$cols - 1, @$row - 1)) {
+            $cols->[$ci] ||= {%new_col} if $self->{+AUTO_COLUMNS};
+            my $c = $cols->[$ci] or next;
+            $c->{idx}  ||= $ci;
+            $c->{rows} ||= [];
+
+            my $r = $row->[$ci];
+            $r = Term::Table::Cell->new(value => $r)
+                unless blessed($r)
+                && ($r->isa('Term::Table::Cell')
+                || $r->isa('Term::Table::CellStack')
+                || $r->isa('Term::Table::Spacer'));
+
+            $r->sanitize  if $self->{+SANITIZE};
+            $r->mark_tail if $self->{+MARK_TAIL};
+
+            my $rs = $r->width;
+            $c->{width} = $rs if $rs > $c->{width};
+            $c->{count}++ if $rs;
+
+            push @{$c->{rows}} => $r;
+        }
+    }
+
+    # Remove any empty columns we can
+    @$cols = grep {$_->{count} > 0 || $self->{+NO_COLLAPSE}->{$_->{idx}}} @$cols
+        if $self->{+COLLAPSE};
+
+    my $current = sum(map {$_->{width}} @$cols);
+    my $border = sum(BORDER_SIZE, $self->{+PAD}, DIV_SIZE * (@$cols - 1));
+    my $total = $current + $border;
+
+    if ($total > $self->{+MAX_WIDTH}) {
+        my $fair = ($self->{+MAX_WIDTH} - $border) / @$cols;
+        if ($fair < 1) {
+            return $self->{+_COLUMNS} = $cols if $self->{+ALLOW_OVERFLOW};
+            croak "Table is too large ($total including $self->{+PAD} padding) to fit into max-width ($self->{+MAX_WIDTH})";
+        }
+
+        my $under = 0;
+        my @fix;
+        for my $c (@$cols) {
+            if ($c->{width} > $fair) {
+                push @fix => $c;
+            }
+            else {
+                $under += $c->{width};
+            }
+        }
+
+        # Recalculate fairness
+        $fair = int(($self->{+MAX_WIDTH} - $border - $under) / @fix);
+        if ($fair < 1) {
+            return $self->{+_COLUMNS} = $cols if $self->{+ALLOW_OVERFLOW};
+            croak "Table is too large ($total including $self->{+PAD} padding) to fit into max-width ($self->{+MAX_WIDTH})";
+        }
+
+        # Adjust over-long columns
+        $_->{width} = $fair for @fix;
+    }
+
+    $self->{+_COLUMNS} = $cols;
+}
+
+sub render {
+    my $self = shift;
+
+    my $cols = $self->columns;
+    for my $col (@$cols) {
+        for my $cell (@{$col->{rows}}) {
+            $cell->reset;
+        }
+    }
+    my $width = sum(BORDER_SIZE, $self->{+PAD}, DIV_SIZE * @$cols, map { $_->{width} } @$cols);
+
+    #<<< NO-TIDY
+    my $border   = '+' . join('+', map { '-' x ($_->{width}  + CELL_PAD_SIZE) }      @$cols) . '+';
+    my $template = '|' . join('|', map { my $w = $_->{width} + CELL_PAD_SIZE; '%s' } @$cols) . '|';
+    my $spacer   = '|' . join('|', map { ' ' x ($_->{width}  + CELL_PAD_SIZE) }      @$cols) . '|';
+    #>>>
+
+    my @out = ($border);
+    my ($row, $split, $found) = (0, 0, 0);
+    while(1) {
+        my @row;
+
+        my $is_spacer = 0;
+
+        for my $col (@$cols) {
+            my $r = $col->{rows}->[$row];
+            unless($r) {
+                push @row => '';
+                next;
+            }
+
+            my ($v, $vw);
+
+            if ($r->isa('Term::Table::Cell')) {
+                my $lw = $r->border_left_width;
+                my $rw = $r->border_right_width;
+                $vw = $col->{width} - $lw - $rw;
+                $v = $r->break->next($vw);
+            }
+            elsif ($r->isa('Term::Table::CellStack')) {
+                ($v, $vw) = $r->break->next($col->{width});
+            }
+            elsif ($r->isa('Term::Table::Spacer')) {
+                $is_spacer = 1;
+            }
+
+            if ($is_spacer) {
+                last;
+            }
+            elsif (defined $v) {
+                $found++;
+                my $bcolor = $r->border_color || '';
+                my $vcolor = $r->value_color  || '';
+                my $reset  = $r->reset_color  || '';
+
+                if (my $need = $vw - uni_length($v)) {
+                    $v .= ' ' x $need;
+                }
+
+                my $rt = "${reset}${bcolor}\%s${reset} ${vcolor}\%s${reset} ${bcolor}\%s${reset}";
+                push @row => sprintf($rt, $r->border_left || '', $v, $r->border_right || '');
+            }
+            else {
+                push @row => ' ' x ($col->{width} + 2);
+            }
+        }
+
+        if (!grep {$_ && m/\S/} @row) {
+            last unless $found || $is_spacer;
+
+            push @out => $border if $row == 0 && $self->{+SHOW_HEADER} && @{$self->{+HEADER}};
+            push @out => $spacer if $split > 1 || $is_spacer;
+
+            $row++;
+            $split = 0;
+            $found = 0;
+
+            next;
+        }
+
+        if ($split == 1 && @out > 1 && $out[-2] ne $border && $out[-2] ne $spacer) {
+            my $last = pop @out;
+            push @out => ($spacer, $last);
+        }
+
+        push @out => sprintf($template, @row);
+        $split++;
+    }
+
+    pop @out while @out && $out[-1] eq $spacer;
+
+    unless (USE_GCS) {
+        for my $row (@out) {
+            next unless $row =~ m/[^\x00-\x7F]/;
+            unshift @out => "Unicode::GCString is not installed, table may not display all unicode characters properly";
+            last;
+        }
+    }
+
+    return (@out, $border);
+}
+
+sub display {
+    my $self = shift;
+    my ($fh) = @_;
+
+    my @parts = map "$_\n", $self->render;
+
+    print $fh @parts if $fh;
+    print @parts;
+}
+
+1;
+
+__END__
+
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Term::Table - Format a header and rows into a table
+
+=head1 DESCRIPTION
+
+This is used by some failing tests to provide diagnostics about what has gone
+wrong. This module is able to generic format rows of data into tables.
+
+=head1 SYNOPSIS
+
+    use Term::Table;
+
+    my $table = Term::Table->new(
+        max_width      => 80,    # defaults to terminal size
+        pad            => 4,     # Extra padding between table and max-width (defaults to 4)
+        allow_overflow => 0,     # default is 0, when off an exception will be thrown if the table is too big
+        collapse       => 1,     # do not show empty columns
+
+        header => ['name', 'age', 'hair color'],
+        rows   => [
+            ['Fred Flinstone',  2000000, 'black'],
+            ['Wilma Flinstone', 1999995, 'red'],
+            ...
+        ],
+    );
+
+    say $_ for $table->render;
+
+This prints a table like this:
+
+    +-----------------+---------+------------+
+    | name            | age     | hair color |
+    +-----------------+---------+------------+
+    | Fred Flinstone  | 2000000 | black      |
+    | Wilma Flinstone | 1999995 | red        |
+    | ...             | ...     | ...        |
+    +-----------------+---------+------------+
+
+=head1 INTERFACE
+
+    use Term::Table;
+    my $table = Term::Table->new(...);
+
+=head2 OPTIONS
+
+=over 4
+
+=item header => [ ... ]
+
+If you want a header specify it here. This takes an arrayref with each columns
+heading.
+
+=item rows => [ [...], [...], ... ]
+
+This should be an arrayref containing an arrayref per row.
+
+=item collapse => $bool
+
+Use this if you want to hide empty columns, that is any column that has no data
+in any row. Having a header for the column will not effect collapse.
+
+=item max_width => $num
+
+Set the maximum width of the table, the table may not be this big, but it will
+be no bigger. If none is specified it will attempt to find the width of your
+terminal and use that, otherwise it falls back to the terminal width or C<80>.
+
+=item pad => $num
+
+Defaults to 4, extra padding for row width calculations. Default is for legacy
+support. Set this to 0 to turn padding off.
+
+=item allow_overflow => $bool
+
+Defaults to 0. If this is off then an exception will be thrown if the table
+cannot be made to fit inside the max-width. If this is set to 1 then the table
+will be rendered anyway, larger than max-width, if it is not possible to stay
+within the max-width. In other words this turns max-width from a hard-limit to
+a soft recommendation.
+
+=item sanitize => $bool
+
+This will sanitize all the data in the table such that newlines, control
+characters, and all whitespace except for ASCII 20 C<' '> are replaced with
+escape sequences. This prevents newlines, tabs, and similar whitespace from
+disrupting the table.
+
+B<Note:> newlines are marked as '\n', but a newline is also inserted into the
+data so that it typically displays in a way that is useful to humans.
+
+Example:
+
+    my $field = "foo\nbar\nbaz\n";
+
+    print join "\n" => table(
+        sanitize => 1,
+        rows => [
+            [$field,      'col2'     ],
+            ['row2 col1', 'row2 col2']
+        ]
+    );
+
+Prints:
+
+    +-----------------+-----------+
+    | foo\n           | col2      |
+    | bar\n           |           |
+    | baz\n           |           |
+    |                 |           |
+    | row2 col1       | row2 col2 |
+    +-----------------+-----------+
+
+So it marks the newlines by inserting the escape sequence, but it also shows
+the data across as many lines as it would normally display.
+
+=item mark_tail => $bool
+
+This will replace the last whitespace character of any trailing whitespace with
+its escape sequence. This makes it easier to notice trailing whitespace when
+comparing values.
+
+=item show_header => $bool
+
+Set this to false to hide the header. This defaults to true if the header is
+set, false if no header is provided.
+
+=item auto_columns => $bool
+
+Set this to true to automatically add columns that are not named in the header.
+This defaults to false if a header is provided, and defaults to true when there
+is no header.
+
+=item no_collapse => [ $col_num_a, $col_num_b, ... ]
+
+=item no_collapse => [ $col_name_a, $col_name_b, ... ]
+
+=item no_collapse => { $col_num_a => 1, $col_num_b => 1, ... }
+
+=item no_collapse => { $col_name_a => 1, $col_name_b => 1, ... }
+
+Specify (by number and/or name) columns that should not be removed when empty.
+The 'name' form only works when a header is specified. There is currently no
+protection to insure that names you specify are actually in the header, invalid
+names are ignored, patches to fix this will be happily accepted.
+
+=back
+
+=head1 NOTE ON UNICODE/WIDE CHARACTERS
+
+Some unicode characters, such as C<婧> (C<U+5A67>) are wider than others. These
+will render just fine if you C<use utf8;> as necessary, and
+L<Unicode::GCString> is installed, however if the module is not installed there
+will be anomalies in the table:
+
+    +-----+-----+---+
+    | a   | b   | c |
+    +-----+-----+---+
+    | 婧 | x   | y |
+    | x   | y   | z |
+    | x   | 婧 | z |
+    +-----+-----+---+
+
+=head1 SOURCE
+
+The source code repository for Term-Table can be found at
+F<http://github.com/exodist/Term-Table/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut

database/perl/vendor/lib/Term/Table/Cell.pm

@@ -0,0 +1,147 @@
+package Term::Table::Cell;
+use strict;
+use warnings;
+
+our $VERSION = '0.015';
+
+use Term::Table::LineBreak();
+use Term::Table::Util qw/uni_length/;
+
+use List::Util qw/sum/;
+
+use Term::Table::HashBase qw/value border_left border_right _break _widths border_color value_color reset_color/;
+
+my %CHAR_MAP = (
+    # Special case, \n should render as \n, but also actually do the newline thing
+    "\n" => "\\n\n",
+
+    "\a" => '\\a',
+    "\b" => '\\b',
+    "\e" => '\\e',
+    "\f" => '\\f',
+    "\r" => '\\r',
+    "\t" => '\\t',
+    " "  => ' ',
+);
+
+sub init {
+    my $self = shift;
+
+    # Stringify
+    $self->{+VALUE} = defined $self->{+VALUE} ? "$self->{+VALUE}" : '';
+}
+
+sub char_id {
+    my $class = shift;
+    my ($char) = @_;
+    return "\\N{U+" . sprintf("\%X", ord($char)) . "}";
+}
+
+sub show_char {
+    my $class = shift;
+    my ($char, %props) = @_;
+    return $char if $props{no_newline} && $char eq "\n";
+    return $CHAR_MAP{$char} || $class->char_id($char);
+}
+
+sub sanitize {
+    my $self = shift;
+    $self->{+VALUE} =~ s/([\s\t\p{Zl}\p{C}\p{Zp}])/$self->show_char($1)/ge; # All whitespace except normal space
+}
+
+sub mark_tail {
+    my $self = shift;
+    $self->{+VALUE} =~ s/([\s\t\p{Zl}\p{C}\p{Zp}])$/$1 eq ' ' ? $self->char_id($1) : $self->show_char($1, no_newline => 1)/se;
+}
+
+sub value_width {
+    my $self = shift;
+
+    my $w = $self->{+_WIDTHS} ||= {};
+    return $w->{value} if defined $w->{value};
+
+    my @parts = split /(\n)/, $self->{+VALUE};
+
+    my $max = 0;
+    while (@parts) {
+        my $text = shift @parts;
+        my $sep  = shift @parts || '';
+        my $len = uni_length("$text");
+        $max = $len if $len > $max;
+    }
+
+    return $w->{value} = $max;
+}
+
+sub border_left_width {
+    my $self = shift;
+    $self->{+_WIDTHS}->{left} ||= uni_length($self->{+BORDER_LEFT} || '');
+}
+
+sub border_right_width {
+    my $self = shift;
+    $self->{+_WIDTHS}->{right} ||= uni_length($self->{+BORDER_RIGHT} || '');
+}
+
+sub width {
+    my $self = shift;
+    $self->{+_WIDTHS}->{all} ||= sum(map { $self->$_ } qw/value_width border_left_width border_right_width/);
+}
+
+sub break {
+    my $self = shift;
+    $self->{+_BREAK} ||= Term::Table::LineBreak->new(string => $self->{+VALUE});
+}
+
+sub reset {
+    my $self = shift;
+    delete $self->{+_BREAK};
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Term::Table::Cell - Representation of a cell in a table.
+
+=head1 DESCRIPTION
+
+This package is used to represent a cell in a table.
+
+=head1 SOURCE
+
+The source code repository for Term-Table can be found at
+F<http://github.com/exodist/Term-Table/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut

database/perl/vendor/lib/Term/Table/CellStack.pm

@@ -0,0 +1,130 @@
+package Term::Table::CellStack;
+use strict;
+use warnings;
+
+our $VERSION = '0.015';
+
+use Term::Table::HashBase qw/-cells -idx/;
+
+use List::Util qw/max/;
+
+sub init {
+    my $self = shift;
+    $self->{+CELLS} ||= [];
+}
+
+sub add_cell {
+    my $self = shift;
+    push @{$self->{+CELLS}} => @_;
+}
+
+sub add_cells {
+    my $self = shift;
+    push @{$self->{+CELLS}} => @_;
+}
+
+sub sanitize {
+    my $self = shift;
+    $_->sanitize(@_) for @{$self->{+CELLS}};
+}
+
+sub mark_tail {
+    my $self = shift;
+    $_->mark_tail(@_) for @{$self->{+CELLS}};
+}
+
+my @proxy = qw{
+    border_left border_right border_color value_color reset_color
+    border_left_width border_right_width
+};
+
+for my $meth (@proxy) {
+    no strict 'refs';
+    *$meth = sub {
+        my $self = shift;
+        $self->{+CELLS}->[$self->{+IDX}]->$meth;
+    };
+}
+
+for my $meth (qw{value_width width}) {
+    no strict 'refs';
+    *$meth = sub {
+        my $self = shift;
+        return max(map { $_->$meth } @{$self->{+CELLS}});
+    };
+}
+
+sub next {
+    my $self = shift;
+    my ($cw) = @_;
+
+    while ($self->{+IDX} < @{$self->{+CELLS}}) {
+        my $cell = $self->{+CELLS}->[$self->{+IDX}];
+
+        my $lw = $cell->border_left_width;
+        my $rw = $cell->border_right_width;
+        my $vw = $cw - $lw - $rw;
+        my $it = $cell->break->next($vw);
+
+        return ($it, $vw) if $it;
+        $self->{+IDX}++;
+    }
+
+    return;
+}
+
+sub break { $_[0] }
+
+sub reset {
+    my $self = shift;
+    $self->{+IDX} = 0;
+    $_->reset for @{$self->{+CELLS}};
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Term::Table::CellStack - Combine several cells into one (vertical)
+
+=head1 DESCRIPTION
+
+This package is used to represent a merged-cell in a table (vertical).
+
+=head1 SOURCE
+
+The source code repository for Term-Table can be found at
+F<http://github.com/exodist/Term-Table/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut

database/perl/vendor/lib/Term/Table/HashBase.pm

@@ -0,0 +1,473 @@
+package Term::Table::HashBase;
+use strict;
+use warnings;
+
+our $VERSION = '0.015';
+
+#################################################################
+#                                                               #
+#  This is a generated file! Do not modify this file directly!  #
+#  Use hashbase_inc.pl script to regenerate this file.          #
+#  The script is part of the Object::HashBase distribution.     #
+#  Note: You can modify the version number above this comment   #
+#  if needed, that is fine.                                     #
+#                                                               #
+#################################################################
+
+{
+    no warnings 'once';
+    $Term::Table::HashBase::HB_VERSION = '0.008';
+    *Term::Table::HashBase::ATTR_SUBS = \%Object::HashBase::ATTR_SUBS;
+    *Term::Table::HashBase::ATTR_LIST = \%Object::HashBase::ATTR_LIST;
+    *Term::Table::HashBase::VERSION   = \%Object::HashBase::VERSION;
+    *Term::Table::HashBase::CAN_CACHE = \%Object::HashBase::CAN_CACHE;
+}
+
+
+require Carp;
+{
+    no warnings 'once';
+    $Carp::Internal{+__PACKAGE__} = 1;
+}
+
+BEGIN {
+    # these are not strictly equivalent, but for out use we don't care
+    # about order
+    *_isa = ($] >= 5.010 && require mro) ? \&mro::get_linear_isa : sub {
+        no strict 'refs';
+        my @packages = ($_[0]);
+        my %seen;
+        for my $package (@packages) {
+            push @packages, grep !$seen{$_}++, @{"$package\::ISA"};
+        }
+        return \@packages;
+    }
+}
+
+my %SPEC = (
+    '^' => {reader => 1, writer => 0, dep_writer => 1, read_only => 0, strip => 1},
+    '-' => {reader => 1, writer => 0, dep_writer => 0, read_only => 1, strip => 1},
+    '>' => {reader => 0, writer => 1, dep_writer => 0, read_only => 0, strip => 1},
+    '<' => {reader => 1, writer => 0, dep_writer => 0, read_only => 0, strip => 1},
+    '+' => {reader => 0, writer => 0, dep_writer => 0, read_only => 0, strip => 1},
+);
+
+sub import {
+    my $class = shift;
+    my $into  = caller;
+
+    # Make sure we list the OLDEST version used to create this class.
+    my $ver = $Term::Table::HashBase::HB_VERSION || $Term::Table::HashBase::VERSION;
+    $Term::Table::HashBase::VERSION{$into} = $ver if !$Term::Table::HashBase::VERSION{$into} || $Term::Table::HashBase::VERSION{$into} > $ver;
+
+    my $isa = _isa($into);
+    my $attr_list = $Term::Table::HashBase::ATTR_LIST{$into} ||= [];
+    my $attr_subs = $Term::Table::HashBase::ATTR_SUBS{$into} ||= {};
+
+    my %subs = (
+        ($into->can('new') ? () : (new => \&_new)),
+        (map %{$Term::Table::HashBase::ATTR_SUBS{$_} || {}}, @{$isa}[1 .. $#$isa]),
+        (
+            map {
+                my $p = substr($_, 0, 1);
+                my $x = $_;
+
+                my $spec = $SPEC{$p} || {reader => 1, writer => 1};
+
+                substr($x, 0, 1) = '' if $spec->{strip};
+                push @$attr_list => $x;
+                my ($sub, $attr) = (uc $x, $x);
+
+                $attr_subs->{$sub} = sub() { $attr };
+                my %out = ($sub => $attr_subs->{$sub});
+
+                $out{$attr}       = sub { $_[0]->{$attr} }                                                  if $spec->{reader};
+                $out{"set_$attr"} = sub { $_[0]->{$attr} = $_[1] }                                          if $spec->{writer};
+                $out{"set_$attr"} = sub { Carp::croak("'$attr' is read-only") }                             if $spec->{read_only};
+                $out{"set_$attr"} = sub { Carp::carp("set_$attr() is deprecated"); $_[0]->{$attr} = $_[1] } if $spec->{dep_writer};
+
+                %out;
+            } @_
+        ),
+    );
+
+    no strict 'refs';
+    *{"$into\::$_"} = $subs{$_} for keys %subs;
+}
+
+sub attr_list {
+    my $class = shift;
+
+    my $isa = _isa($class);
+
+    my %seen;
+    my @list = grep { !$seen{$_}++ } map {
+        my @out;
+
+        if (0.004 > ($Term::Table::HashBase::VERSION{$_} || 0)) {
+            Carp::carp("$_ uses an inlined version of Term::Table::HashBase too old to support attr_list()");
+        }
+        else {
+            my $list = $Term::Table::HashBase::ATTR_LIST{$_};
+            @out = $list ? @$list : ()
+        }
+
+        @out;
+    } reverse @$isa;
+
+    return @list;
+}
+
+sub _new {
+    my $class = shift;
+
+    my $self;
+
+    if (@_ == 1) {
+        my $arg = shift;
+        my $type = ref($arg);
+
+        if ($type eq 'HASH') {
+            $self = bless({%$arg}, $class)
+        }
+        else {
+            Carp::croak("Not sure what to do with '$type' in $class constructor")
+                unless $type eq 'ARRAY';
+
+            my %proto;
+            my @attributes = attr_list($class);
+            while (@$arg) {
+                my $val = shift @$arg;
+                my $key = shift @attributes or Carp::croak("Too many arguments for $class constructor");
+                $proto{$key} = $val;
+            }
+
+            $self = bless(\%proto, $class);
+        }
+    }
+    else {
+        $self = bless({@_}, $class);
+    }
+
+    $Term::Table::HashBase::CAN_CACHE{$class} = $self->can('init')
+        unless exists $Term::Table::HashBase::CAN_CACHE{$class};
+
+    $self->init if $Term::Table::HashBase::CAN_CACHE{$class};
+
+    $self;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Term::Table::HashBase - Build hash based classes.
+
+=head1 SYNOPSIS
+
+A class:
+
+    package My::Class;
+    use strict;
+    use warnings;
+
+    # Generate 3 accessors
+    use Term::Table::HashBase qw/foo -bar ^baz <bat >ban +boo/;
+
+    # Chance to initialize defaults
+    sub init {
+        my $self = shift;    # No other args
+        $self->{+FOO} ||= "foo";
+        $self->{+BAR} ||= "bar";
+        $self->{+BAZ} ||= "baz";
+        $self->{+BAT} ||= "bat";
+        $self->{+BAN} ||= "ban";
+        $self->{+BOO} ||= "boo";
+    }
+
+    sub print {
+        print join ", " => map { $self->{$_} } FOO, BAR, BAZ, BAT, BAN, BOO;
+    }
+
+Subclass it
+
+    package My::Subclass;
+    use strict;
+    use warnings;
+
+    # Note, you should subclass before loading HashBase.
+    use base 'My::Class';
+    use Term::Table::HashBase qw/bub/;
+
+    sub init {
+        my $self = shift;
+
+        # We get the constants from the base class for free.
+        $self->{+FOO} ||= 'SubFoo';
+        $self->{+BUB} ||= 'bub';
+
+        $self->SUPER::init();
+    }
+
+use it:
+
+    package main;
+    use strict;
+    use warnings;
+    use My::Class;
+
+    # These are all functionally identical
+    my $one   = My::Class->new(foo => 'MyFoo', bar => 'MyBar');
+    my $two   = My::Class->new({foo => 'MyFoo', bar => 'MyBar'});
+    my $three = My::Class->new(['MyFoo', 'MyBar']);
+
+    # Readers!
+    my $foo = $one->foo;    # 'MyFoo'
+    my $bar = $one->bar;    # 'MyBar'
+    my $baz = $one->baz;    # Defaulted to: 'baz'
+    my $bat = $one->bat;    # Defaulted to: 'bat'
+    # '>ban' means setter only, no reader
+    # '+boo' means no setter or reader, just the BOO constant
+
+    # Setters!
+    $one->set_foo('A Foo');
+
+    #'-bar' means read-only, so the setter will throw an exception (but is defined).
+    $one->set_bar('A bar');
+
+    # '^baz' means deprecated setter, this will warn about the setter being
+    # deprecated.
+    $one->set_baz('A Baz');
+
+    # '<bat' means no setter defined at all
+    # '+boo' means no setter or reader, just the BOO constant
+
+    $one->{+FOO} = 'xxx';
+
+=head1 DESCRIPTION
+
+This package is used to generate classes based on hashrefs. Using this class
+will give you a C<new()> method, as well as generating accessors you request.
+Generated accessors will be getters, C<set_ACCESSOR> setters will also be
+generated for you. You also get constants for each accessor (all caps) which
+return the key into the hash for that accessor. Single inheritance is also
+supported.
+
+=head1 THIS IS A BUNDLED COPY OF HASHBASE
+
+This is a bundled copy of L<Object::HashBase>. This file was generated using
+the
+C</home/exodist/perl5/perlbrew/perls/main/bin/hashbase_inc.pl>
+script.
+
+=head1 METHODS
+
+=head2 PROVIDED BY HASH BASE
+
+=over 4
+
+=item $it = $class->new(%PAIRS)
+
+=item $it = $class->new(\%PAIRS)
+
+=item $it = $class->new(\@ORDERED_VALUES)
+
+Create a new instance.
+
+HashBase will not export C<new()> if there is already a C<new()> method in your
+packages inheritance chain.
+
+B<If you do not want this method you can define your own> you just have to
+declare it before loading L<Term::Table::HashBase>.
+
+    package My::Package;
+
+    # predeclare new() so that HashBase does not give us one.
+    sub new;
+
+    use Term::Table::HashBase qw/foo bar baz/;
+
+    # Now we define our own new method.
+    sub new { ... }
+
+This makes it so that HashBase sees that you have your own C<new()> method.
+Alternatively you can define the method before loading HashBase instead of just
+declaring it, but that scatters your use statements.
+
+The most common way to create an object is to pass in key/value pairs where
+each key is an attribute and each value is what you want assigned to that
+attribute. No checking is done to verify the attributes or values are valid,
+you may do that in C<init()> if desired.
+
+If you would like, you can pass in a hashref instead of pairs. When you do so
+the hashref will be copied, and the copy will be returned blessed as an object.
+There is no way to ask HashBase to bless a specific hashref.
+
+In some cases an object may only have 1 or 2 attributes, in which case a
+hashref may be too verbose for your liking. In these cases you can pass in an
+arrayref with only values. The values will be assigned to attributes in the
+order the attributes were listed. When there is inheritance involved the
+attributes from parent classes will come before subclasses.
+
+=back
+
+=head2 HOOKS
+
+=over 4
+
+=item $self->init()
+
+This gives you the chance to set some default values to your fields. The only
+argument is C<$self> with its indexes already set from the constructor.
+
+B<Note:> Term::Table::HashBase checks for an init using C<< $class->can('init') >>
+during construction. It DOES NOT call C<can()> on the created object. Also note
+that the result of the check is cached, it is only ever checked once, the first
+time an instance of your class is created. This means that adding an C<init()>
+method AFTER the first construction will result in it being ignored.
+
+=back
+
+=head1 ACCESSORS
+
+=head2 READ/WRITE
+
+To generate accessors you list them when using the module:
+
+    use Term::Table::HashBase qw/foo/;
+
+This will generate the following subs in your namespace:
+
+=over 4
+
+=item foo()
+
+Getter, used to get the value of the C<foo> field.
+
+=item set_foo()
+
+Setter, used to set the value of the C<foo> field.
+
+=item FOO()
+
+Constant, returns the field C<foo>'s key into the class hashref. Subclasses will
+also get this function as a constant, not simply a method, that means it is
+copied into the subclass namespace.
+
+The main reason for using these constants is to help avoid spelling mistakes
+and similar typos. It will not help you if you forget to prefix the '+' though.
+
+=back
+
+=head2 READ ONLY
+
+    use Term::Table::HashBase qw/-foo/;
+
+=over 4
+
+=item set_foo()
+
+Throws an exception telling you the attribute is read-only. This is exported to
+override any active setters for the attribute in a parent class.
+
+=back
+
+=head2 DEPRECATED SETTER
+
+    use Term::Table::HashBase qw/^foo/;
+
+=over 4
+
+=item set_foo()
+
+This will set the value, but it will also warn you that the method is
+deprecated.
+
+=back
+
+=head2 NO SETTER
+
+    use Term::Table::HashBase qw/<foo/;
+
+Only gives you a reader, no C<set_foo> method is defined at all.
+
+=head2 NO READER
+
+    use Term::Table::HashBase qw/>foo/;
+
+Only gives you a write (C<set_foo>), no C<foo> method is defined at all.
+
+=head2 CONSTANT ONLY
+
+    use Term::Table::HashBase qw/+foo/;
+
+This does not create any methods for you, it just adds the C<FOO> constant.
+
+=head1 SUBCLASSING
+
+You can subclass an existing HashBase class.
+
+    use base 'Another::HashBase::Class';
+    use Term::Table::HashBase qw/foo bar baz/;
+
+The base class is added to C<@ISA> for you, and all constants from base classes
+are added to subclasses automatically.
+
+=head1 GETTING A LIST OF ATTRIBUTES FOR A CLASS
+
+Term::Table::HashBase provides a function for retrieving a list of attributes for an
+Term::Table::HashBase class.
+
+=over 4
+
+=item @list = Term::Table::HashBase::attr_list($class)
+
+=item @list = $class->Term::Table::HashBase::attr_list()
+
+Either form above will work. This will return a list of attributes defined on
+the object. This list is returned in the attribute definition order, parent
+class attributes are listed before subclass attributes. Duplicate attributes
+will be removed before the list is returned.
+
+B<Note:> This list is used in the C<< $class->new(\@ARRAY) >> constructor to
+determine the attribute to which each value will be paired.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for HashBase can be found at
+F<http://github.com/Test-More/HashBase/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut

database/perl/vendor/lib/Term/Table/LineBreak.pm

@@ -0,0 +1,144 @@
+package Term::Table::LineBreak;
+use strict;
+use warnings;
+
+our $VERSION = '0.015';
+
+use Carp qw/croak/;
+use Scalar::Util qw/blessed/;
+use Term::Table::Util qw/uni_length/;
+
+use Term::Table::HashBase qw/string gcstring _len _parts idx/;
+
+sub init {
+    my $self = shift;
+
+    croak "string is a required attribute"
+        unless defined $self->{+STRING};
+}
+
+sub columns { uni_length($_[0]->{+STRING}) }
+
+sub break {
+    my $self = shift;
+    my ($len) = @_;
+
+    $self->{+_LEN} = $len;
+
+    $self->{+IDX} = 0;
+    my $str = $self->{+STRING} . ""; # Force stringification
+
+    my @parts;
+    my @chars = split //, $str;
+    while (@chars) {
+        my $size = 0;
+        my $part = '';
+        until ($size == $len) {
+            my $char = shift @chars;
+            $char = '' unless defined $char;
+
+            my $l = uni_length("$char");
+            last unless $l;
+
+            last if $char eq "\n";
+
+            if ($size + $l > $len) {
+                unshift @chars => $char;
+                last;
+            }
+
+            $size += $l;
+            $part .= $char;
+        }
+
+        # If we stopped just before a newline, grab it
+        shift @chars if $size == $len && @chars && $chars[0] eq "\n";
+
+        until ($size == $len) {
+            $part .= ' ';
+            $size += 1;
+        }
+        push @parts => $part;
+    }
+
+    $self->{+_PARTS} = \@parts;
+}
+
+sub next {
+    my $self = shift;
+
+    if (@_) {
+        my ($len) = @_;
+        $self->break($len) if !$self->{+_LEN} || $self->{+_LEN} != $len;
+    }
+    else {
+        croak "String has not yet been broken"
+            unless $self->{+_PARTS};
+    }
+
+    my $idx   = $self->{+IDX}++;
+    my $parts = $self->{+_PARTS};
+
+    return undef if $idx >= @$parts;
+    return $parts->[$idx];
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Term::Table::LineBreak - Break up lines for use in tables.
+
+=head1 DESCRIPTION
+
+This is meant for internal use. This package takes long lines of text and
+splits them so that they fit in table rows.
+
+=head1 SYNOPSIS
+
+    use Term::Table::LineBreak;
+
+    my $lb = Term::Table::LineBreak->new(string => $STRING);
+
+    $lb->break($SIZE);
+    while (my $part = $lb->next) {
+        ...
+    }
+
+=head1 SOURCE
+
+The source code repository for Term-Table can be found at
+F<http://github.com/exodist/Term-Table/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut

database/perl/vendor/lib/Term/Table/Spacer.pm

@@ -0,0 +1,15 @@
+package Term::Table::Spacer;
+use strict;
+use warnings;
+
+our $VERSION = '0.015';
+
+sub new { bless {}, $_[0] }
+
+sub width { 1 }
+
+sub sanitize  { }
+sub mark_tail { }
+sub reset     { }
+
+1;

database/perl/vendor/lib/Term/Table/Util.pm

@@ -0,0 +1,200 @@
+package Term::Table::Util;
+use strict;
+use warnings;
+
+use Config qw/%Config/;
+
+our $VERSION = '0.015';
+
+use Importer Importer => 'import';
+our @EXPORT_OK = qw/term_size USE_GCS USE_TERM_READKEY USE_TERM_SIZE_ANY uni_length/;
+
+sub DEFAULT_SIZE() { 80 }
+
+my $IO;
+BEGIN {
+    open($IO, '>&', STDOUT) or die "Could not clone STDOUT";
+}
+
+sub try(&) {
+    my $code = shift;
+    local ($@, $?, $!);
+    my $ok = eval { $code->(); 1 };
+    my $err = $@;
+    return ($ok, $err);
+}
+
+my ($tsa) = try { require Term::Size::Any; Term::Size::Any->import('chars') };
+my ($trk) = try { require Term::ReadKey };
+$trk &&= Term::ReadKey->can('GetTerminalSize');
+
+if (!-t $IO) {
+    *USE_TERM_READKEY  = sub() { 0 };
+    *USE_TERM_SIZE_ANY = sub() { 0 };
+    *term_size         = sub {
+        return $ENV{TABLE_TERM_SIZE} if $ENV{TABLE_TERM_SIZE};
+        return DEFAULT_SIZE;
+    };
+}
+elsif ($tsa) {
+    *USE_TERM_READKEY  = sub() { 0 };
+    *USE_TERM_SIZE_ANY = sub() { 1 };
+    *_term_size        = sub {
+        my $size = chars($IO);
+        return DEFAULT_SIZE if !$size;
+        return DEFAULT_SIZE if $size < DEFAULT_SIZE;
+        return $size;
+    };
+}
+elsif ($trk) {
+    *USE_TERM_READKEY  = sub() { 1 };
+    *USE_TERM_SIZE_ANY = sub() { 0 };
+    *_term_size        = sub {
+        my $total;
+        try {
+            my @warnings;
+            {
+                local $SIG{__WARN__} = sub { push @warnings => @_ };
+                ($total) = Term::ReadKey::GetTerminalSize($IO);
+            }
+            @warnings = grep { $_ !~ m/Unable to get Terminal Size/ } @warnings;
+            warn @warnings if @warnings;
+        };
+        return DEFAULT_SIZE if !$total;
+        return DEFAULT_SIZE if $total < DEFAULT_SIZE;
+        return $total;
+    };
+}
+else {
+    *USE_TERM_READKEY  = sub() { 0 };
+    *USE_TERM_SIZE_ANY = sub() { 0 };
+    *term_size         = sub {
+        return $ENV{TABLE_TERM_SIZE} if $ENV{TABLE_TERM_SIZE};
+        return DEFAULT_SIZE;
+    };
+}
+
+if (USE_TERM_READKEY() || USE_TERM_SIZE_ANY()) {
+    if (index($Config{sig_name}, 'WINCH') >= 0) {
+        my $changed = 0;
+        my $polled = -1;
+        $SIG{WINCH} = sub { $changed++ };
+
+        my $size;
+        *term_size = sub {
+            return $ENV{TABLE_TERM_SIZE} if $ENV{TABLE_TERM_SIZE};
+
+            unless ($changed == $polled) {
+                $polled = $changed;
+                $size = _term_size();
+            }
+
+            return $size;
+        }
+    }
+    else {
+        *term_size = sub {
+            return $ENV{TABLE_TERM_SIZE} if $ENV{TABLE_TERM_SIZE};
+            _term_size();
+        };
+    }
+}
+
+my ($gcs, $err) = try { require Unicode::GCString };
+
+if ($gcs) {
+    *USE_GCS    = sub() { 1 };
+    *uni_length = sub   { Unicode::GCString->new($_[0])->columns };
+}
+else {
+    *USE_GCS    = sub() { 0 };
+    *uni_length = sub   { length($_[0]) };
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Term::Table::Util - Utilities for Term::Table.
+
+=head1 DESCRIPTION
+
+This package exports some tools used by Term::Table.
+
+=head1 EXPORTS
+
+=head2 CONSTANTS
+
+=over 4
+
+=item $bool = USE_GCS
+
+True if L<Unicode::GCString> is installed.
+
+=item $bool = USE_TERM_READKEY
+
+True if L<Term::ReadKey> is installed.
+
+=back
+
+=head2 UTILITIES
+
+=over 4
+
+=item $width = term_size()
+
+Get the width of the terminal.
+
+If the C<$TABLE_TERM_SIZE> environment variable is set then that value will be
+returned.
+
+This will default to 80 if there is no good way to get the size, or if the size
+is unreasonably small.
+
+If L<Term::ReadKey> is installed it will be used.
+
+=item $width = uni_length($string)
+
+Get the width (in columns) of the specified string. When L<Unicode::GCString>
+is installed this will work on unicode strings, otherwise it will just use
+C<length($string)>.
+
+=back
+
+=head1 SOURCE
+
+The source code repository for Term-Table can be found at
+F<http://github.com/exodist/Term-Table/>.
+
+=head1 MAINTAINERS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+=cut

database/perl/vendor/lib/Term/UI.pm

@@ -0,0 +1,654 @@
+package Term::UI;
+
+use if $] > 5.017, 'deprecate';
+
+use Carp;
+use Params::Check qw[check allow];
+use Term::ReadLine;
+use Locale::Maketext::Simple Style => 'gettext';
+use Term::UI::History;
+
+use strict;
+
+BEGIN {
+    use vars        qw[$VERSION $AUTOREPLY $VERBOSE $INVALID];
+    $VERBOSE    =   1;
+    $VERSION    =   '0.46';
+    $INVALID    =   loc('Invalid selection, please try again: ');
+}
+
+push @Term::ReadLine::Stub::ISA, __PACKAGE__
+        unless grep { $_ eq __PACKAGE__ } @Term::ReadLine::Stub::ISA;
+
+
+=pod
+
+=head1 NAME
+
+Term::UI - Term::ReadLine UI made easy
+
+=head1 SYNOPSIS
+
+    use Term::UI;
+    use Term::ReadLine;
+
+    my $term = Term::ReadLine->new('brand');
+
+    my $reply = $term->get_reply(
+                    prompt => 'What is your favourite colour?',
+                    choices => [qw|blue red green|],
+                    default => 'blue',
+    );
+
+    my $bool = $term->ask_yn(
+                        prompt => 'Do you like cookies?',
+                        default => 'y',
+                );
+
+
+    my $string = q[some_command -option --no-foo --quux='this thing'];
+
+    my ($options,$munged_input) = $term->parse_options($string);
+
+
+    ### don't have Term::UI issue warnings -- default is '1'
+    $Term::UI::VERBOSE = 0;
+
+    ### always pick the default (good for non-interactive terms)
+    ### -- default is '0'
+    $Term::UI::AUTOREPLY = 1;
+
+    ### Retrieve the entire session as a printable string:
+    $hist = Term::UI::History->history_as_string;
+    $hist = $term->history_as_string;
+
+=head1 DESCRIPTION
+
+C<Term::UI> is a transparent way of eliminating the overhead of having
+to format a question and then validate the reply, informing the user
+if the answer was not proper and re-issuing the question.
+
+Simply give it the question you want to ask, optionally with choices
+the user can pick from and a default and C<Term::UI> will DWYM.
+
+For asking a yes or no question, there's even a shortcut.
+
+=head1 HOW IT WORKS
+
+C<Term::UI> places itself at the back of the C<Term::ReadLine>
+C<@ISA> array, so you can call its functions through your term object.
+
+C<Term::UI> uses C<Term::UI::History> to record all interactions
+with the commandline. You can retrieve this history, or alter
+the filehandle the interaction is printed to. See the
+C<Term::UI::History> manpage or the C<SYNOPSIS> for details.
+
+=head1 METHODS
+
+=head2 $reply = $term->get_reply( prompt => 'question?', [choices => \@list, default => $list[0], multi => BOOL, print_me => "extra text to print & record", allow => $ref] );
+
+C<get_reply> asks a user a question, and then returns the reply to the
+caller. If the answer is invalid (more on that below), the question will
+be reposed, until a satisfactory answer has been entered.
+
+You have the option of providing a list of choices the user can pick from
+using the C<choices> argument. If the answer is not in the list of choices
+presented, the question will be reposed.
+
+If you provide a C<default>  answer, this will be returned when either
+C<$AUTOREPLY> is set to true, (see the C<GLOBAL VARIABLES> section further
+below), or when the user just hits C<enter>.
+
+You can indicate that the user is allowed to enter multiple answers by
+toggling the C<multi> flag. Note that a list of answers will then be
+returned to you, rather than a simple string.
+
+By specifying an C<allow> handler, you can yourself validate the answer
+a user gives. This can be any of the types that the Params::Check C<allow>
+function allows, so please refer to that manpage for details.
+
+Finally, you have the option of adding a C<print_me> argument, which is
+simply printed before the prompt. It's printed to the same file handle
+as the rest of the questions, so you can use this to keep track of a
+full session of Q&A with the user, and retrieve it later using the
+C<< Term::UI->history_as_string >> function.
+
+See the C<EXAMPLES> section for samples of how to use this function.
+
+=cut
+
+sub get_reply {
+    my $term = shift;
+    my %hash = @_;
+
+    my $tmpl = {
+        default     => { default => undef,  strict_type => 0 },
+        prompt      => { default => '',     strict_type => 1, required => 1 },
+        choices     => { default => [],     strict_type => 1 },
+        multi       => { default => 0,      allow => [0, 1] },
+        allow       => { default => qr/.*/ },
+        print_me    => { default => '',     strict_type => 1 },
+    };
+
+    my $args = check( $tmpl, \%hash, $VERBOSE )
+                or ( carp( loc(q[Could not parse arguments]) ), return );
+
+    # Check for legacy default on multi=1
+    if ($args->{multi} and defined $args->{default} and ref($args->{default}) ne "ARRAY") {
+        $args->{default} = [ $args->{default} ];
+    }
+
+    ### add this to the prompt to indicate the default
+    ### answer to the question if there is one.
+    my $prompt_add;
+
+    ### if you supplied several choices to pick from,
+    ### we'll print them separately before the prompt
+    if( @{$args->{choices}} ) {
+        my $i;
+
+        for my $choice ( @{$args->{choices}} ) {
+            $i++;   # the answer counter -- but humans start counting
+                    # at 1 :D
+
+            ### so this choice is the default? add it to 'prompt_add'
+            ### so we can construct a "foo? [DIGIT]" type prompt
+            if (defined $args->{default}) {
+                if ($args->{multi}) {
+                    push @$prompt_add, $i if (scalar(grep { m/^$choice$/ } @{$args->{default}}));
+                }
+                else {
+                    $prompt_add = $i if ($choice eq $args->{default});
+                }
+            }
+
+            ### create a "DIGIT> choice" type line
+            $args->{print_me} .= sprintf "\n%3s> %-s", $i, $choice;
+        }
+
+        $prompt_add = join(" ", @$prompt_add) if ( $prompt_add && $args->{multi} );
+
+        ### we listed some choices -- add another newline for
+        ### pretty printing
+        $args->{print_me} .= "\n" if $i;
+
+        ### allowable answers are now equal to the choices listed
+        $args->{allow} = $args->{choices};
+
+    ### no choices, but a default? set 'prompt_add' to the default
+    ### to construct a 'foo? [DEFAULT]' type prompt
+    } elsif ( defined $args->{default} ) {
+        if ($args->{multi} and ref($args->{default}) eq "ARRAY") {
+            $prompt_add = join(" ", @{$args->{default}});
+        }
+        else {
+            $prompt_add = $args->{default};
+        }
+    }
+
+    ### we set up the defaults, prompts etc, dispatch to the readline call
+    return $term->_tt_readline( %$args, prompt_add => $prompt_add );
+
+}
+
+=head2 $bool = $term->ask_yn( prompt => "your question", [default => (y|1,n|0), print_me => "extra text to print & record"] )
+
+Asks a simple C<yes> or C<no> question to the user, returning a boolean
+indicating C<true> or C<false> to the caller.
+
+The C<default> answer will automatically returned, if the user hits
+C<enter> or if C<$AUTOREPLY> is set to true. See the C<GLOBAL VARIABLES>
+section further below.
+
+Also, you have the option of adding a C<print_me> argument, which is
+simply printed before the prompt. It's printed to the same file handle
+as the rest of the questions, so you can use this to keep track of a
+full session of Q&A with the user, and retrieve it later using the
+C<< Term::UI->history_as_string >> function.
+
+
+See the C<EXAMPLES> section for samples of how to use this function.
+
+=cut
+
+sub ask_yn {
+    my $term = shift;
+    my %hash = @_;
+
+    my $tmpl = {
+        default     => { default => undef, allow => [qw|0 1 y n|],
+                                                            strict_type => 1 },
+        prompt      => { default => '', required => 1,      strict_type => 1 },
+        print_me    => { default => '',                     strict_type => 1 },
+        multi       => { default => 0,                      no_override => 1 },
+        choices     => { default => [qw|y n|],              no_override => 1 },
+        allow       => { default => [qr/^y(?:es)?$/i, qr/^n(?:o)?$/i],
+                         no_override => 1
+                       },
+    };
+
+    my $args = check( $tmpl, \%hash, $VERBOSE ) or return undef;
+
+    ### uppercase the default choice, if there is one, to be added
+    ### to the prompt in a 'foo? [Y/n]' type style.
+    my $prompt_add;
+    {   my @list = @{$args->{choices}};
+        if( defined $args->{default} ) {
+
+            ### if you supplied the default as a boolean, rather than y/n
+            ### transform it to a y/n now
+            $args->{default} = $args->{default} =~ /\d/
+                                ? { 0 => 'n', 1 => 'y' }->{ $args->{default} }
+                                : $args->{default};
+
+            @list = map { lc $args->{default} eq lc $_
+                                ? uc $args->{default}
+                                : $_
+                    } @list;
+        }
+
+        $prompt_add .= join("/", @list);
+    }
+
+    my $rv = $term->_tt_readline( %$args, prompt_add => $prompt_add );
+
+    return $rv =~ /^y/i ? 1 : 0;
+}
+
+
+
+sub _tt_readline {
+    my $term = shift;
+    my %hash = @_;
+
+    local $Params::Check::VERBOSE = 0;  # why is this?
+    local $| = 1;                       # print ASAP
+
+
+    my ($default, $prompt, $choices, $multi, $allow, $prompt_add, $print_me);
+    my $tmpl = {
+        default     => { default => undef,  strict_type => 0,
+                            store => \$default },
+        prompt      => { default => '',     strict_type => 1, required => 1,
+                            store => \$prompt },
+        choices     => { default => [],     strict_type => 1,
+                            store => \$choices },
+        multi       => { default => 0,      allow => [0, 1], store => \$multi },
+        allow       => { default => qr/.*/, store => \$allow, },
+        prompt_add  => { default => '',     store => \$prompt_add, strict_type => 1 },
+        print_me    => { default => '',     store => \$print_me },
+    };
+
+    check( $tmpl, \%hash, $VERBOSE ) or return;
+
+    ### prompts for Term::ReadLine can't be longer than one line, or
+    ### it can display wonky on some terminals.
+    history( $print_me ) if $print_me;
+
+
+    if ($prompt_add) {
+        ### we might have to add a default value to the prompt, to
+        ### show the user what will be picked by default:
+        $prompt .= " [$prompt_add]: " ;
+    }
+    else {
+        $prompt .= " : ";
+    }
+
+
+    ### are we in autoreply mode?
+    if ($AUTOREPLY) {
+
+        ### you used autoreply, but didn't provide a default!
+        carp loc(
+            q[You have '%1' set to true, but did not provide a default!],
+            '$AUTOREPLY'
+        ) if( !defined $default && $VERBOSE);
+
+        ### print it out for visual feedback
+        if ($multi and defined($default)) {
+            history( join ' ', grep { defined } $prompt, @$default );
+            ### and return the default
+            return @$default;
+        }
+        else {
+            history( join ' ', grep { defined } $prompt, $default );
+            ### and return the default
+            return $default;
+        }
+
+    }
+
+    if ($multi and defined($default)) {
+        $default = join(' ', @$default);
+    }
+
+    ### so, no AUTOREPLY, let's see what the user will answer
+    LOOP: {
+
+        ### annoying bug in T::R::Perl that mucks up lines with a \n
+        ### in them; So split by \n, save the last line as the prompt
+        ### and just print the rest
+        {   my @lines   = split "\n", $prompt;
+            $prompt     = pop @lines;
+
+            history( "$_\n" ) for @lines;
+        }
+
+        ### pose the question
+        my $answer  = $term->readline($prompt);
+        $answer     = $default unless length $answer;
+
+        $term->addhistory( $answer ) if length $answer;
+
+        ### add both prompt and answer to the history
+        history( "$prompt $answer", 0 );
+
+        ### if we're allowed to give multiple answers, split
+        ### the answer on whitespace
+        my @answers = $multi ? split(/\s+/, $answer) : $answer;
+
+        ### the return value list
+        my @rv;
+
+        if( @$choices ) {
+
+            for my $answer (@answers) {
+
+                ### a digit implies a multiple choice question,
+                ### a non-digit is an open answer
+                if( $answer =~ /\D/ ) {
+                    push @rv, $answer if allow( $answer, $allow );
+                } else {
+
+                    ### remember, the answer digits are +1 compared to
+                    ### the choices, because humans want to start counting
+                    ### at 1, not at 0
+                    push @rv, $choices->[ $answer - 1 ]
+                        if $answer > 0 && defined $choices->[ $answer - 1 ];
+                }
+            }
+
+        ### no fixed list of choices.. just check if the answers
+        ### (or otherwise the default!) pass the allow handler
+        } else {
+            push @rv, grep { allow( $_, $allow ) } @answers;
+        }
+
+        ### if not all the answers made it to the return value list,
+        ### at least one of them was an invalid answer -- make the
+        ### user do it again
+        if( (@rv != @answers) or
+            (scalar(@$choices) and not scalar(@answers))
+        ) {
+            $prompt = $INVALID;
+            $prompt .= "[$prompt_add] " if $prompt_add;
+            redo LOOP;
+
+        ### otherwise just return the answer, or answers, depending
+        ### on the multi setting
+        } else {
+            return $multi ? @rv : $rv[0];
+        }
+    }
+}
+
+=head2 ($opts, $munged) = $term->parse_options( STRING );
+
+C<parse_options> will convert all options given from an input string
+to a hash reference. If called in list context it will also return
+the part of the input string that it found no options in.
+
+Consider this example:
+
+    my $str =   q[command --no-foo --baz --bar=0 --quux=bleh ] .
+                q[--option="some'thing" -one-dash -single=blah' arg];
+
+    my ($options,$munged) =  $term->parse_options($str);
+
+    ### $options would contain: ###
+    $options = {
+                'foo'       => 0,
+                'bar'       => 0,
+                'one-dash'  => 1,
+                'baz'       => 1,
+                'quux'      => 'bleh',
+                'single'    => 'blah\'',
+                'option'    => 'some\'thing'
+    };
+
+    ### and this is the munged version of the input string,
+    ### ie what's left of the input minus the options
+    $munged = 'command arg';
+
+As you can see, you can either use a single or a double C<-> to
+indicate an option.
+If you prefix an option with C<no-> and do not give it a value, it
+will be set to 0.
+If it has no prefix and no value, it will be set to 1.
+Otherwise, it will be set to its value. Note also that it can deal
+fine with single/double quoting issues.
+
+=cut
+
+sub parse_options {
+    my $term    = shift;
+    my $input   = shift;
+
+    my $return = {};
+
+    ### there's probably a more elegant way to do this... ###
+    while ( $input =~ s/(?:^|\s+)--?([-\w]+=("|').+?\2)(?=\Z|\s+)//  or
+            $input =~ s/(?:^|\s+)--?([-\w]+=\S+)(?=\Z|\s+)//         or
+            $input =~ s/(?:^|\s+)--?([-\w]+)(?=\Z|\s+)//
+    ) {
+        my $match = $1;
+
+        if( $match =~ /^([-\w]+)=("|')(.+?)\2$/ ) {
+            $return->{$1} = $3;
+
+        } elsif( $match =~ /^([-\w]+)=(\S+)$/ ) {
+            $return->{$1} = $2;
+
+        } elsif( $match =~ /^no-?([-\w]+)$/i ) {
+            $return->{$1} = 0;
+
+        } elsif ( $match =~ /^([-\w]+)$/ ) {
+            $return->{$1} = 1;
+
+        } else {
+            carp(loc(q[I do not understand option "%1"\n], $match)) if $VERBOSE;
+        }
+    }
+
+    return wantarray ? ($return,$input) : $return;
+}
+
+=head2 $str = $term->history_as_string
+
+Convenience wrapper around C<< Term::UI::History->history_as_string >>.
+
+Consult the C<Term::UI::History> man page for details.
+
+=cut
+
+sub history_as_string { return Term::UI::History->history_as_string };
+
+1;
+
+=head1 GLOBAL VARIABLES
+
+The behaviour of Term::UI can be altered by changing the following
+global variables:
+
+=head2 $Term::UI::VERBOSE
+
+This controls whether Term::UI will issue warnings and explanations
+as to why certain things may have failed. If you set it to 0,
+Term::UI will not output any warnings.
+The default is 1;
+
+=head2 $Term::UI::AUTOREPLY
+
+This will make every question be answered by the default, and warn if
+there was no default provided. This is particularly useful if your
+program is run in non-interactive mode.
+The default is 0;
+
+=head2 $Term::UI::INVALID
+
+This holds the string that will be printed when the user makes an
+invalid choice.
+You can override this string from your program if you, for example,
+wish to do localization.
+The default is C<Invalid selection, please try again: >
+
+=head2 $Term::UI::History::HISTORY_FH
+
+This is the filehandle all the print statements from this module
+are being sent to. Please consult the C<Term::UI::History> manpage
+for details.
+
+This defaults to C<*STDOUT>.
+
+=head1 EXAMPLES
+
+=head2 Basic get_reply sample
+
+    ### ask a user (with an open question) for their favourite colour
+    $reply = $term->get_reply( prompt => 'Your favourite colour? );
+
+which would look like:
+
+    Your favourite colour?
+
+and C<$reply> would hold the text the user typed.
+
+=head2 get_reply with choices
+
+    ### now provide a list of choices, so the user has to pick one
+    $reply = $term->get_reply(
+                prompt  => 'Your favourite colour?',
+                choices => [qw|red green blue|] );
+
+which would look like:
+
+      1> red
+      2> green
+      3> blue
+
+    Your favourite colour?
+
+C<$reply> will hold one of the choices presented. C<Term::UI> will repose
+the question if the user attempts to enter an answer that's not in the
+list of choices. The string presented is held in the C<$Term::UI::INVALID>
+variable (see the C<GLOBAL VARIABLES> section for details.
+
+=head2 get_reply with choices and default
+
+    ### provide a sensible default option -- everyone loves blue!
+    $reply = $term->get_reply(
+                prompt  => 'Your favourite colour?',
+                choices => [qw|red green blue|],
+                default => 'blue' );
+
+which would look like:
+
+      1> red
+      2> green
+      3> blue
+
+    Your favourite colour? [3]:
+
+Note the default answer after the prompt. A user can now just hit C<enter>
+(or set C<$Term::UI::AUTOREPLY> -- see the C<GLOBAL VARIABLES> section) and
+the sensible answer 'blue' will be returned.
+
+=head2 get_reply using print_me & multi
+
+    ### allow the user to pick more than one colour and add an
+    ### introduction text
+    @reply = $term->get_reply(
+                print_me    => 'Tell us what colours you like',
+                prompt      => 'Your favourite colours?',
+                choices     => [qw|red green blue|],
+                multi       => 1 );
+
+which would look like:
+
+    Tell us what colours you like
+      1> red
+      2> green
+      3> blue
+
+    Your favourite colours?
+
+An answer of C<3 2 1> would fill C<@reply> with C<blue green red>
+
+=head2 get_reply & allow
+
+    ### pose an open question, but do a custom verification on
+    ### the answer, which will only exit the question loop, if
+    ### the answer matches the allow handler.
+    $reply = $term->get_reply(
+                prompt  => "What is the magic number?",
+                allow   => 42 );
+
+Unless the user now enters C<42>, the question will be reposed over
+and over again. You can use more sophisticated C<allow> handlers (even
+subroutines can be used). The C<allow> handler is implemented using
+C<Params::Check>'s C<allow> function. Check its manpage for details.
+
+=head2 an elaborate ask_yn sample
+
+    ### ask a user if he likes cookies. Default to a sensible 'yes'
+    ### and inform him first what cookies are.
+    $bool = $term->ask_yn( prompt   => 'Do you like cookies?',
+                           default  => 'y',
+                           print_me => 'Cookies are LOVELY!!!' );
+
+would print:
+
+    Cookies are LOVELY!!!
+    Do you like cookies? [Y/n]:
+
+If a user then simply hits C<enter>, agreeing with the default,
+C<$bool> would be set to C<true>. (Simply hitting 'y' would also
+return C<true>. Hitting 'n' would return C<false>)
+
+We could later retrieve this interaction by printing out the Q&A
+history as follows:
+
+    print $term->history_as_string;
+
+which would then print:
+
+    Cookies are LOVELY!!!
+    Do you like cookies? [Y/n]:  y
+
+There's a chance we're doing this non-interactively, because a console
+is missing, the user indicated he just wanted the defaults, etc.
+
+In this case, simply setting C<$Term::UI::AUTOREPLY> to true, will
+return from every question with the default answer set for the question.
+Do note that if C<AUTOREPLY> is true, and no default is set, C<Term::UI>
+will warn about this and return C<undef>.
+
+=head1 See Also
+
+C<Params::Check>, C<Term::ReadLine>, C<Term::UI::History>
+
+=head1 BUG REPORTS
+
+Please report bugs or other issues to E<lt>bug-term-ui@rt.cpan.org<gt>.
+
+=head1 AUTHOR
+
+This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+This library is free software; you may redistribute and/or modify it
+under the same terms as Perl itself.
+
+=cut

database/perl/vendor/lib/Term/UI/History.pm

@@ -0,0 +1,142 @@
+package Term::UI::History;
+
+use strict;
+use vars qw[$VERSION];
+use base 'Exporter';
+use base 'Log::Message::Simple';
+
+$VERSION = '0.46';
+
+=pod
+
+=head1 NAME
+
+Term::UI::History - history function
+
+=head1 SYNOPSIS
+
+    use Term::UI::History qw[history];
+
+    history("Some message");
+
+    ### retrieve the history in printable form
+    $hist  = Term::UI::History->history_as_string;
+
+    ### redirect output
+    local $Term::UI::History::HISTORY_FH = \*STDERR;
+
+=head1 DESCRIPTION
+
+This module provides the C<history> function for C<Term::UI>,
+printing and saving all the C<UI> interaction.
+
+Refer to the C<Term::UI> manpage for details on usage from
+C<Term::UI>.
+
+This module subclasses C<Log::Message::Simple>. Refer to its
+manpage for additional functionality available via this package.
+
+=head1 FUNCTIONS
+
+=head2 history("message string" [,VERBOSE])
+
+Records a message on the stack, and prints it to C<STDOUT>
+(or actually C<$HISTORY_FH>, see the C<GLOBAL VARIABLES> section
+below), if the C<VERBOSE> option is true.
+
+The C<VERBOSE> option defaults to true.
+
+=cut
+
+BEGIN {
+    use Log::Message private => 0;
+
+    use vars      qw[ @EXPORT $HISTORY_FH ];
+    @EXPORT     = qw[ history ];
+    my $log     = new Log::Message;
+    $HISTORY_FH = \*STDOUT;
+
+    for my $func ( @EXPORT ) {
+        no strict 'refs';
+
+        *$func = sub {  my $msg     = shift;
+                        $log->store(
+                                message => $msg,
+                                tag     => uc $func,
+                                level   => $func,
+                                extra   => [@_]
+                        );
+                };
+    }
+
+    sub history_as_string {
+        my $class = shift;
+
+        return join $/, map { $_->message } __PACKAGE__->stack;
+    }
+}
+
+
+{
+    package # hide this from PAUSE
+      Log::Message::Handlers;
+
+    sub history {
+        my $self    = shift;
+        my $verbose = shift;
+           $verbose = 1 unless defined $verbose;    # default to true
+
+        ### so you don't want us to print the msg? ###
+        return if defined $verbose && $verbose == 0;
+
+        local $| = 1;
+        my $old_fh = select $Term::UI::History::HISTORY_FH;
+
+        print $self->message . "\n";
+        select $old_fh;
+
+        return;
+    }
+}
+
+
+=head1 GLOBAL VARIABLES
+
+=over 4
+
+=item $HISTORY_FH
+
+This is the filehandle all the messages sent to C<history()> are being
+printed. This defaults to C<*STDOUT>.
+
+=back
+
+=head1 See Also
+
+C<Log::Message::Simple>, C<Term::UI>
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2005 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+All rights reserved.
+
+This library is free software;
+you may redistribute and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
+1;
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4: