view release on metacpan or  search on metacpan

Wyrd/Form.pm  view on Meta::CPAN

		if ($input->can('current_value')) {
			$success = 1;
			$value = $input->current_value;
		} else {
			($value, $success) = $self->_get_value($input->param);
		}
		$input->set($value);
		#use Data::Dumper;
		#warn "Value of input: " . $input->name . " is " . Dumper($input->value);
		$self->_debug("Value of input: " . $input->name . " is " . $input->value);
		#set the running variable amount
		if ($success or $input->null_ok) {
			$self->{'_variables'}->{$input->name} = $input->value;
		}
	}
}

sub _check_errors {
	my $self = shift;
	return scalar(@{$self->{'_errors'}});
}

sub _reload_form {
	#reprocess the form based on current value of _current_form
	my ($self) = @_;
	$self->_info("Loading '" . $self->{'_current_form'} . "' and reprocessing self");
	$self->_data($self->{'_form'}->{$self->{'_current_form'}});
	$self->_process_self;
}

sub _get_value {
	my ($self, $param) = @_;
	my $success = 1;
	if ($self->can('_param_process_' . $param)) {
		$self->_info("found a _param_process_$param I can call");
		eval('$param=$self->_param_process_' . $param);
		$self->_raise_exception($@) if ($@);
	} else {
		if ($self->dbl->param_exists($param)) {
			my @value = $self->dbl->param($param);
			$param = [@value];
			$param = $value[0] if (scalar(@value) == 1);
			$param = undef if (scalar(@value) == 0);
		} else {
			$param = undef;
			$success = 0;
		}
	}
	return ($param, $success);
}

sub _wrap_form {
	my ($self, $form) = @_;
	my $remove_form = $self->dbl->param('_current_form');
	my $default = $self->dbl->self_path;
	$default =~ s/\/$remove_form$//;
	$default .= "/" . $self->{'_current_form'} unless ($self->_flags->no_grow);
	my $action = ($self->{'_action_index'}->{$self->{'_current_form'}} || $self->{'action'} || $default);
	my $method = ($self->{'method'} || 'post');
	my $extra_attributes = '';
	foreach my $attribute (qw(enctype accept-charset onsubmit)) {
		my $attribute_value = $self->{$attribute};
		if ($attribute_value) {
			$extra_attributes .= qq( $attribute="$attribute_value");
		}
	}
	my $name = ($self->{'_current_form'} || 'form');
	my $header = $self->_proof_of_submit . $self->_current_marker;
	$header .= $self->{'_stored_data'} if ($self->{'_stored_data'});
	return "<form name=\"$name\" action=\"$action\" method=\"$method\"$extra_attributes>\n" . $header . $form . "\n</form>";
}

sub _current_marker {
	my $self = shift;
	my $form = $self->{'_current_form'};
	return undef unless ($form);
	return '<input type="hidden" name="_current_form" value="' . $form . '">' . "\n";
}

sub register_child {
	my ($self) = @_;
	$self->_raise_exception($self->_class_name . ' has separate child registers. Do not call register_child.');
}

sub _set_children {
	my ($self) = @_;
	$self->_raise_exception($self->_class_name . ' has separate child registers. Do not call set_children.');
}

=pod

=back

=head1 BUGS/CAVEATS/RESERVED METHODS

Reserves the _setup, the _format_output, AND the _generate_output method.  Subclassing is done via the other hooks, above.

=cut

#standard Wyrd methods
sub _setup {
	my ($self) = @_;
	$self->{'_globals'} = {error_block => undef};
	$self->{'_variables'} = {};
	$self->{'_input_index'} = {};
	$self->{'_input'} = [];
	$self->{'_errortag_index'} = {};
	$self->{'_errortag'} = [];
	$self->{'_view_index'} = {};
	$self->{'_view'} = [];
	$self->{'_errors'} = [];
	$self->{'_triggers'} = {};
	$self->{'_error_messages'} = [];
	$self->{'_current_identifier'} = 0;
	$self->{'_form'} = {};
	$self->{'_form_index'} = [];
	$self->{'_action_index'} = {};
	#use CGI to attempt to set current and next forms.  Forms will set themselves in
	#the first pass of _process_self. NB- subforms can't outclass this.
	$self->{'_next_form'} = $self->dbl->param('_next_form');
	$self->{'_current_form'} =  $self->dbl->param('_current_form');