view release on metacpan or  search on metacpan

Wyrd/Form.pm  view on Meta::CPAN

		$storage = $self->dbl->param("_storage$counter");
	} while ($self->dbl->param("_storage$counter"));
	#now that you have it, decrypt it (CodeRing);
	$stored_data = ${$ring->decrypt(\$stored_data)};
	my $xd = new XML::Dumper;
	my $hash = $xd->xml2pl($stored_data);
	foreach my $var_name (keys(%{$hash})) {
		#warn("Unpacked data: " . $var_name .'='. $hash->{$var_name});
		my $value = $hash->{$var_name};
		if (ref($value) eq 'ARRAY') {
			$value = $value->[0] unless (scalar(@$value) > 1);
		}
		$self->{_variables}->{$var_name} = $value;
	}
}

sub _pack_data {
	my ($self) = @_;
	my $xd = new XML::Dumper;
	my $out = $xd->pl2xml($self->{_variables});
	my $ring = Apache::Wyrd::Services::CodeRing->new;
	$out = ${$ring->encrypt(\$out)};
	my $length_out = length($out)/30000 + 1;
	my @outs = unpack ('a30000' x $length_out, $out);
	#rebuild out out of 30K pieces to overcome crappy IE cgi submission
	my $counter = undef;
	$out = undef;
	foreach my $subpart (@outs) {
			$out .= $self->_set({data => $subpart, name => "_storage$counter"}, $self->_storage_template);
			$counter++;
	}
	$self->{'_stored_data'} = $out;
}

sub _preload_inputs {
	my ($self) = @_;
	$self->_prep_preloads;
	#iterate through the inputs, setting if possible
	foreach my $input (keys(%{$self->{_input_index}})) {
		$input = $self->{'_input'}->[$self->{'_input_index'}->{$input}];
		$input->set($self->{'_variables'}->{$input->name});
	}
	$self->_extra_preloads;
}

sub _check_inputs {
	my ($self) = @_;
	#iterate through the inputs, checking errors
	foreach my $input (keys(%{$self->{_input_index}})) {
		$input = $self->{'_input'}->[$self->{'_input_index'}->{$input}];
		my ($value, $success) = ();
		#inputs can define a current_value method in order to override a normal
		#CGI lookup
		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;