Apache-Wyrd

 view release on metacpan or  search on metacpan

Wyrd/Input.pm  view on Meta::CPAN

"default" value before giving up and initializing to null.

=head2 HTML ATTRIBUTES

=over

=item regular attributes

Most Input objects also accept the attributes of their HTML
counterparts.  For example, B<text>-type Inputs accept name, value,
size, class, id, maxlength, tabindex, accesskey, onchange, onselect,
onblur, etc.  Dev Note: Derived classes should maintain this support by
including conditionals in the template (see the code).

=item description

A description for this input, to be used in error messages.

=item maxlength

Maximum length of the inputted text, applies both to text and textarea

Wyrd/Input.pm  view on Meta::CPAN

=item (scalar) C<_template_foo> (scalar)

the C<_template> methods should provide an
C<Apache::Wyrd::Interfaces::Setter>-style template for a given input.
Built-in templates are text, textarea, password

=cut

sub _template_text {
	return '<input type="text" name="$:param" value="$:value"?:size{ size="$:size"}?:class{ class="$:class"}?:style{ style="$:style"}?:id{ id="$:id"}?:maxlength{ maxlength="$:maxlength"}?:tabindex{ tabindex="$:tabindex"}?:accesskey{ accesskey="$:tabinde...
}

sub _template_textarea {
	return '<textarea name="$:param"?:cols{ cols="$:cols"}?:rows{ rows="$:rows"}?:wrap{ wrap="$:wrap"}?:id{ id="$:id"}?:class{ class="$:class"}?:style{ style="$:style"}?:tabindex{ tabindex="$:tabindex"}?:accesskey{ accesskey="$:accesskey"}?:onblur{ onbl...
}

sub _template_password {
	return '<input type="password" name="$:param" value="$:value"?:size{ size="$:size"}?:id{ id="$:id"}?:maxlength{ maxlength="$:maxlength"}?:class{ class="$:class"}?:style{ style="$:style"}?:tabindex{ tabindex="$:tabindex"}?:accesskey{ accesskey="$:tab...
}

sub _template_hidden {
	return '<input type="hidden" name="$:param" value="$:value">';
}

=pod

=back

Wyrd/Input/URLInput.pm  view on Meta::CPAN

sub _smart_type {
	my ($self) = @_;
	return 'text';
}

sub _startup_url {
	my ($self, $value, $params) = @_;
	use Apache::Wyrd::Datum;
	$self->{'_datum'} ||= (Apache::Wyrd::Datum::Text->new($value, $params));
	$self->{'_template'} ||= '<input type="text" name="$:name" value="$:value"?:size{ size="$:size"}?:id{ id="$:id"}?:maxlength{ maxlength="$:maxlength"}?:tabindex{ tabindex="$:tabindex"}?:accesskey{ accesskey="$:tabindex"}?:onchange{ onchange="$:onchan...
}

sub _check_param {
	my ($self, $value) = @_;
	$self->_info("Checking URL with value $value");
	my $error = 1;
	if (not($value) or ($value eq 'NULL')) {
		#do nothing.  Blank is OK, so are NULL placemarkers
	} elsif ($value !~ m#\w{3,6}://#) {
		#check for protocol/machine

Wyrd/Services/Index.pm  view on Meta::CPAN

		return $self->db;
	} elsif ($self->status eq 'RW') {
		$self->close_db;
	}
	my %index = ();
	my $index = tie %index, 'BerkeleyDB::Btree', -Filename => $self->file, -Flags => DB_RDONLY, -Env => $self->env, -Mode => 0660;
	$self->set_error ("Can't open the index for reading.") unless ($index);
	$self->check_error;
	$self->{'db'} = $index;
	if ($self->bigfile) {
		my %bindex = ();
		my $bindex = tie %bindex, 'BerkeleyDB::Btree', -Filename => $self->bigfilename, -Flags => DB_RDONLY, -Env => $self->env, -Mode => 0660;
		$self->set_error("Can't open the wholetext index for reading.") unless ($bindex);
		$self->check_error;
		$self->{'db_big'} = $bindex;
	}
	$self->newstatus('R');
	return $index;
}

sub write_db {
	my ($self) = @_;
	if ($self->status eq 'RW') {
		return $self->db;
 	} elsif ($self->status eq 'R') {
		$self->close_db;
	}
	my %index = ();
	my $index = tie (%index, 'BerkeleyDB::Btree', -Filename => $self->file, -Flags => DB_CREATE, -Env => $self->env, -Mode => 0660);
	$self->set_error ("Can't open/create the index for writing.") unless ($index);
	$self->check_error;
	$self->{'db'} = $index;
	if ($self->bigfile) {
		my %bindex = ();
		my $bindex = tie %bindex, 'BerkeleyDB::Btree', -Filename => $self->bigfilename, -Flags => DB_CREATE, -Env => $self->env, -Mode => 0660;
		$self->{'db_big'} = $bindex;
		$self->set_error("Can't open/create the wholetext index for writing.") unless ($bindex);
		$self->check_error;
	}
	my $fingerprint = int(rand(100000));
	$index->db_put("\xff%fingerprint", $fingerprint);
	$index->db_get("\xff%fingerprint", my $challenge);
	$self->set_error("open returned an unwriteable DB on write_db() -- '$challenge' should be '$fingerprint'") unless ($fingerprint == $challenge);
	$self->check_error;
	$self->newstatus('RW');
	return $index;
}

Wyrd/Services/Index.pm  view on Meta::CPAN

		);
		my %index = ();
		my $errors = '';
		my $index = tie (%index, 'BerkeleyDB::Btree', -Filename => $self->file, -Flags => DB_CREATE, -Env => $env, -Mode => 0660);
		$error = 1 unless ($index);
		$errors .= $env->status . "\n" if ($error and $env);
		$index->db_close if ($index);
		$index = undef;
		%index = ();
		if ($self->bigfile) {
			my %bindex = ();
			my $bindex = tie %bindex, 'BerkeleyDB::Btree', -Filename => $self->bigfilename, -Flags => DB_CREATE, -Env => $env, -Mode => 0660;
			$self->{'db_big'} = $bindex;
			$error = 1 unless ($bindex);
			$errors .= $env->status . "\n" if ($error and $env);
			$bindex->db_close if ($bindex);
			$bindex = undef;
			%bindex = ();
		}
		if ($error) {
			warn 'attempting recovery using DB_RECOVER_FATAL environment flag';
			$error = 0;
			my $env = BerkeleyDB::Env->new(
				-Home			=> $self->directory,
				-Flags			=> DB_INIT_LOCK | DB_INIT_MPOOL | DB_INIT_LOG | DB_INIT_TXN | DB_RECOVER_FATAL | DB_CREATE,
				-ErrFile		=> *STDERR,
				-Verbose		=> 1,
			);
			die "could not init fatal recovery environment" unless ($env);
			my $index = tie (%index, 'BerkeleyDB::Btree', -Filename => $self->file, -Flags => DB_CREATE, -Env => $env, -Mode => 0660);
			$error = 1 unless($index);
			$errors .= $env->status . "\n" if ($error);
			$index->db_close if ($index);
			$index = undef;
			%index = ();
			if ($self->bigfile) {
				my %bindex = ();
				my $bindex = tie %bindex, 'BerkeleyDB::Btree', -Filename => $self->bigfilename, -Flags => DB_CREATE, -Env => $env, -Mode => 0660;
				$self->{'db_big'} = $bindex;
				$error = 1 unless ($bindex);
				$errors .= $env->status . "\n" if ($error);
				$bindex->db_close if ($bindex);
				$bindex = undef;
				%bindex = ();
			}
			die ("recovery of database failed for both DB_RECOVER and DB_RECOVER_FATAL: $errors") if ($error);
			$self->check_error;
		}
	}
}

sub close_db {
	my ($self) = @_;
	my $index = $self->{'db'};