Initial Commit
This commit is contained in:
147
database/perl/vendor/lib/Term/Table/Cell.pm
vendored
Normal file
147
database/perl/vendor/lib/Term/Table/Cell.pm
vendored
Normal file
@@ -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
|
||||
130
database/perl/vendor/lib/Term/Table/CellStack.pm
vendored
Normal file
130
database/perl/vendor/lib/Term/Table/CellStack.pm
vendored
Normal file
@@ -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
|
||||
473
database/perl/vendor/lib/Term/Table/HashBase.pm
vendored
Normal file
473
database/perl/vendor/lib/Term/Table/HashBase.pm
vendored
Normal file
@@ -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
|
||||
144
database/perl/vendor/lib/Term/Table/LineBreak.pm
vendored
Normal file
144
database/perl/vendor/lib/Term/Table/LineBreak.pm
vendored
Normal file
@@ -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
|
||||
15
database/perl/vendor/lib/Term/Table/Spacer.pm
vendored
Normal file
15
database/perl/vendor/lib/Term/Table/Spacer.pm
vendored
Normal file
@@ -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;
|
||||
200
database/perl/vendor/lib/Term/Table/Util.pm
vendored
Normal file
200
database/perl/vendor/lib/Term/Table/Util.pm
vendored
Normal file
@@ -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
|
||||
Reference in New Issue
Block a user