summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Util/HashBase.pm289
1 files changed, 289 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm b/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm
new file mode 100755
index 00000000000..76041efe5ee
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Test2/Util/HashBase.pm
@@ -0,0 +1,289 @@
+package Test2::Util::HashBase;
+use strict;
+use warnings;
+
+#################################################################
+# #
+# 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. #
+# #
+#################################################################
+
+{
+ no warnings 'once';
+ $Test2::Util::HashBase::VERSION = '0.002';
+ *Test2::Util::HashBase::ATTR_SUBS = \%Object::HashBase::ATTR_SUBS;
+}
+
+
+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 %STRIP = (
+ '^' => 1,
+ '-' => 1,
+);
+
+sub import {
+ my $class = shift;
+ my $into = caller;
+
+ my $isa = _isa($into);
+ my $attr_subs = $Test2::Util::HashBase::ATTR_SUBS{$into} ||= {};
+ my %subs = (
+ ($into->can('new') ? () : (new => \&_new)),
+ (map %{$Test2::Util::HashBase::ATTR_SUBS{$_} || {}}, @{$isa}[1 .. $#$isa]),
+ (
+ map {
+ my $p = substr($_, 0, 1);
+ my $x = $_;
+ substr($x, 0, 1) = '' if $STRIP{$p};
+ my ($sub, $attr) = (uc $x, $x);
+ $sub => ($attr_subs->{$sub} = sub() { $attr }),
+ $attr => sub { $_[0]->{$attr} },
+ $p eq '-' ? ("set_$attr" => sub { Carp::croak("'$attr' is read-only") })
+ : $p eq '^' ? ("set_$attr" => sub { Carp::carp("set_$attr() is deprecated"); $_[0]->{$attr} = $_[1] })
+ : ("set_$attr" => sub { $_[0]->{$attr} = $_[1] }),
+ } @_
+ ),
+ );
+
+ no strict 'refs';
+ *{"$into\::$_"} = $subs{$_} for keys %subs;
+}
+
+sub _new {
+ my ($class, %params) = @_;
+ my $self = bless \%params, $class;
+ $self->init if $self->can('init');
+ $self;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Util::HashBase - Build hash based classes.
+
+=head1 SYNOPSIS
+
+A class:
+
+ package My::Class;
+ use strict;
+ use warnings;
+
+ # Generate 3 accessors
+ use Test2::Util::HashBase qw/foo -bar ^baz/;
+
+ # Chance to initialize defaults
+ sub init {
+ my $self = shift; # No other args
+ $self->{+FOO} ||= "foo";
+ $self->{+BAR} ||= "bar";
+ $self->{+BAZ} ||= "baz";
+ }
+
+ sub print {
+ print join ", " => map { $self->{$_} } FOO, BAR, BAZ;
+ }
+
+Subclass it
+
+ package My::Subclass;
+ use strict;
+ use warnings;
+
+ # Note, you should subclass before loading HashBase.
+ use base 'My::Class';
+ use Test2::Util::HashBase qw/bat/;
+
+ sub init {
+ my $self = shift;
+
+ # We get the constants from the base class for free.
+ $self->{+FOO} ||= 'SubFoo';
+ $self->{+BAT} ||= 'bat';
+
+ $self->SUPER::init();
+ }
+
+use it:
+
+ package main;
+ use strict;
+ use warnings;
+ use My::Class;
+
+ my $one = My::Class->new(foo => 'MyFoo', bar => 'MyBar');
+
+ # Accessors!
+ my $foo = $one->foo; # 'MyFoo'
+ my $bar = $one->bar; # 'MyBar'
+ my $baz = $one->baz; # Defaulted to: 'baz'
+
+ # 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');
+
+ $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(@VALUES)
+
+Create a new instance using key/value pairs.
+
+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<Test2::Util::HashBase>.
+
+ package My::Package;
+
+ # predeclare new() so that HashBase does not give us one.
+ sub new;
+
+ use Test2::Util::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.
+
+=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.
+
+=back
+
+=head1 ACCESSORS
+
+To generate accessors you list them when using the module:
+
+ use Test2::Util::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
+
+=head1 SUBCLASSING
+
+You can subclass an existing HashBase class.
+
+ use base 'Another::HashBase::Class';
+ use Test2::Util::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 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 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