view release on metacpan or  search on metacpan

Interact.pm  view on Meta::CPAN

                        : ($key => $$parms->{$key}{type})
                    : ()
                } else {
                    $$parms->{$_}{type} ne $args{type}
                    ?
                        $wantarray
                        ? $_
                        : ($_ => $$parms->{$_}{type})
                    : ()
                }
            } keys %{$$parms};

        } else {
            @return = map
            {
                # if an aref
                if (ref $$parms->{$_}{type}) {
                    my $key = $_;
                    grep( $key, @{$$parms->{$_}{type}} )
                    ?
                        $wantarray
                        ? $key
                        : ($key => $$parms->{$_}{type})
                    : ()
                } else {
                    $$parms->{$_}{type} eq $args{type}
                    ?
                        $wantarray
                        ? $_
                        : ($_ => $$parms->{$_}{type})
                    : ()
                }
            } keys %{$$parms};
        }
        # return list of parms or href with relevant parm=>type pairs
        return $wantarray ? @return : { @return };

    } elsif ($args{default}) {
        my @return = map
        {
            exists $$parms->{$_}{default}
            ? (
                $wantarray
                ? $_
                : ($_, $$parms->{$_}{default})
              )
            : ()
        } keys %{$$parms};

        # return list of parms or href with relevant parm=>default pairs
        return $wantarray ? @return : { @return };
    }

    # all other cases
    return $wantarray ? keys %{$$parms} : $$parms;
}


sub new {
    my $class = shift;
    my $self = bless {} => $class;
    my $args = $self->process_args( @_ );
    for (keys %{ $args }) {
        $self->{$_} = $args->{$_};
    }
    return $self;
}

# regex for recognizing a date already in epoch form -- used by more than one method()
my $qr_epoch = qr/^\-?\d+$/;

sub process_args {
    my $self = shift;

    ### @_ processing
    # we'll accept key value pairs as an array, aref, or an href
    if ($#_ == 0) {
        if (ref $_[0] eq 'HASH') {
            @_ = %{ $_[0] };
        } elsif (ref $_[0] eq 'ARRAY') {
            @_ = @{ $_[0] };
        } else {
            die "invalid arg";
        }
    }
    my %args = @_;

    ### $self processing
    # use anything from self that hasn't been specified by args
    for (keys %{$self}) {
        unless (exists $args{$_}) {
            $args{$_} = $self->{$_};
        }
    }

    my $defaults = $self->parameters(default=>1);

    for (keys %{$defaults}) {
        unless (exists $args{$_}) {
            $args{$_} = $defaults->{$_};
        }
    }

    # get term width settings if we can, otherwise we'll silently move on
    open SAVEERR, ">&STDERR" or die;
    open STDERR, ">" . File::Spec->devnull or die;
    eval {
        my ($width) = GetTerminalSize( $args{FH_OUT} );
        $args{term_width} = ($width < $args{term_width} ? $width : $args{term_width});
    };
    open STDERR, ">&SAVEERR" or die;
    close SAVEERR;

    # autoformat settings
    $args{shared_autoformat_args} = {all => 1, fill => 0, right => $args{term_width}};

    ### Date related setup
    if (defined $args{type} and $args{type} eq 'date') {
        # accomodate time zone deficiency of Date::Manip under Win32
        set_TZ( (defined $args{time_zone}) ? $args{time_zone} : undef) if ($^O eq 'MSWin32');