view release on metacpan or  search on metacpan

MxScreen/Form/Button.pm  view on Meta::CPAN

use Getargs::Long qw(ignorecase);

# index of the array
BEGIN {
    sub NAME ()           {0}
    sub TARGET ()         {1}
    sub ACTION ()         {2}
    sub VALUE ()          {3}
    sub DYN_TARGET ()     {4}
    sub ON_ERROR ()       {5}
    sub DYN_ON_ERROR ()   {6}

    sub CGI_ARGS ()       {7}
}


#
# ->make
#
# Arguments: (that are considered, others values are kept aside) 
#   -name           => string
#   -action         => 
#   -target         => 'symbol' or ['symbol' , @arg ]
#   -value          => string to display (optional, defaults to name)
#   -dyn_target     => 'symbol' or ['symbol' , @arg ]
#   -on_error       => 'symbol' or ['symbol' , @arg ]
#   -dyn_on_error   => 'symbol' or ['symbol' , @arg ]
#
sub make {
    DFEATURE my $f_;
    my $self = bless [], shift;
	my ($name, $value, $target, $dyn_target, $action,
		$on_error, $dyn_on_error) =
	cxgetargs(@_, { -strict => 0, -extra => 0 },
		-name			=> 's',
		-value			=> ['s'],
		-target			=> [],
		-dyn_target		=> [],
		-action			=> [],
		-on_error		=> [],
		-dyn_on_error	=> [],
	);

    VERIFY defined $target || defined $dyn_target,
		"must specify one of -target or -dyn_target";

    VERIFY !defined $on_error || !defined $dyn_on_error,
		"cannot specify both -on_error and -dyn_on_error";

    VERIFY implies(defined $on_error || defined $dyn_on_error, defined $action),
		"must specify -action when using -on_error or -dyn_on_error";

	$self->[VALUE] = $value eq '' ? $name : $value;
    $self->update(@_);
    return DVAL $self;
}

#
# ->update
#
sub update {
    DFEATURE my $f;
    my $self = shift;
 
    ($self->[NAME], 
     $self->[ACTION],
     $self->[TARGET], 
     $self->[DYN_TARGET], 
     $self->[ON_ERROR], 
     $self->[DYN_ON_ERROR], 
     @{$self->[CGI_ARGS]}) =
		cxgetargs(@_, {-strict => 0},
			-name			=> 's',
			-action			=> ['ARRAY'],
			-target			=> [undef],
			-dyn_target		=> [undef],
			-on_error		=> [undef],
			-dyn_on_error	=> [undef],
		);

    DREQUIRE equiv(defined $self->[DYN_TARGET], !defined $self->[TARGET]);

    unshift @{$self->[CGI_ARGS]}, (-name => $self->name);
    return DVOID;
}


# Temporary method
#
# To Be Removed
# when storable would be able to select what is stored with
# Storable::Hook
sub cleanup {
    DFEATURE my $f_;
    my $self = shift;
    
    $#{$self} = DYN_ON_ERROR;

    return DVOID;
}


#########################################################################
# Class Feature: usable from the external world                         # 
#########################################################################
sub name           { $_[0]->[NAME] }
sub action         { $_[0]->[ACTION] }
sub target         { $_[0]->[TARGET] }
sub dyn_target     { $_[0]->[DYN_TARGET] }
sub on_error       { $_[0]->[ON_ERROR] }
sub dyn_on_error   { $_[0]->[DYN_ON_ERROR] }
sub value          { $_[0]->[VALUE] }

sub is_computed_target { defined $_[0]->[DYN_TARGET] }
sub has_error_trap
	{ defined $_[0]->[ON_ERROR] || defined $_[0]->[DYN_ON_ERROR] }

#
# ->properties
#
# return the full list of arg that were given at creation time. The