The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Validation::Class::Base;
{
    $Validation::Class::Base::VERSION = '7.86';
}

use strict;
use warnings;

our $VERSION = '7.86';    # VERSION

use Exporter ();
use Carp 'confess';

our @ISA    = qw(Exporter);
our @EXPORT = qw(

  has
  hold

);

sub has {

    my ($attrs, $default) = @_;

    return unless $attrs;

    confess "Error creating accessor, default must be a coderef or constant"
      if ref $default && ref $default ne 'CODE';

    $attrs = [$attrs] unless ref $attrs eq 'ARRAY';

    for my $attr (@$attrs) {

        confess "Error creating accessor '$attr', name has invalid characters"
          unless $attr =~ /^[a-zA-Z_]\w*$/;

        my $code;

        if (defined $default) {

            $code = sub {

                if (@_ == 1) {
                    return $_[0]->{$attr} if exists $_[0]->{$attr};
                    return $_[0]->{$attr} =
                      ref $default eq 'CODE' ? $default->($_[0]) : $default;
                }
                $_[0]->{$attr} = $_[1];
                $_[0];

            };

        }

        else {

            $code = sub {

                return $_[0]->{$attr} if @_ == 1;
                $_[0]->{$attr} = $_[1];
                $_[0];

            };

        }

        no strict 'refs';
        no warnings 'redefine';

        my $class = caller(0);

        *{"$class\::$attr"} = $code;

    }

}

sub hold {

    my ($attrs, $default) = @_;

    return unless $attrs;

    confess
      "Error creating accessor, default is required and must be a coderef"
      if ref $default ne 'CODE';

    $attrs = [$attrs] unless ref $attrs eq 'ARRAY';

    for my $attr (@$attrs) {

        confess "Error creating accessor '$attr', name has invalid characters"
          unless $attr =~ /^[a-zA-Z_]\w*$/;

        my $code;

        $code = sub {

            if (@_ == 1) {
                return $_[0]->{$attr} if exists $_[0]->{$attr};
                return $_[0]->{$attr} = $default->($_[0]);
            }

            # values are read-only cannot be changed
            confess
              "Error attempting to modify the read-only attribute ($attr)";

        };

        no strict 'refs';
        no warnings 'redefine';

        my $class = caller(0);

        *{"$class\::$attr"} = $code;

    }

}

sub import {

    strict->import;
    warnings->import;

    __PACKAGE__->export_to_level(1, @_);

}

1;