view release on metacpan or  search on metacpan

Wyrd/Interfaces/Dater.pm  view on Meta::CPAN

	return substr('0000' . $year, -4) . substr('00' . $month, -2) . substr('00' . $day, -2);
}

sub _yy2yyyy {
	my ($self, $year) = @_;
	return $self->_normalize_year($year);
}

=item  _normalize_year

Given a year in digits (2 or 4 are best), attempt a guess as to which year is
meant.  Uses the simple 50-year window method for interpreting 2 digit
years.  Used internally.

=cut

sub _normalize_year {
	my ($self, $year) = @_;
	if ($year >= 100 and $year < 199) {
		#assume a perl localtime year
		$year += 1900;

Wyrd/Interfaces/Setter.pm  view on Meta::CPAN

=cut

sub _cgi_hash {
	my ($self, $temp, $modifier) = @_;
	my $hash = {};
	my @params = ();
	unless ($temp) {
		#give up and use CGIs params
		@params = $self->dbl->param;
	} else {
		#guess at the params from the template
		@params = ($temp =~ m/[\$\?\!]\:([a-zA-Z_][a-zA-Z0-9_]+)/g);
	}
	foreach my $param (@params) {
		if ($modifier eq 'escaped') {
			$hash->{$param} = Apache::Util::escape_html(scalar($self->dbl->param($param)));
		} elsif ($modifier eq 'quoted') {
			#scalar is used because of some funny business in dbh -- worth investigating?
			$hash->{$param} = $self->dbl->dbh->quote(scalar($self->dbl->param($param)));
		} else {
			$hash->{$param} = $self->dbl->param($param);

Wyrd/Site/IndexBot.pm  view on Meta::CPAN

			}
		} elsif (($attribute eq "\x00") and not(-f ($root . $current_id))) {
			if ($current_id !~ m#^https?://#) {
				my $error = $index->db_del($id);
				my $ord = unpack "C", $id;
				print "WARNING: purged reverse filemap for nonexistent file $current_id — " . ($instance->attribute_list->[$ord] || "Unknown attribute [$ord]") . " (id# $current_id): ". ($error ? 'failed!' : 'succeeded.');
			};
		} elsif ($attribute eq "\xff") {
			#do nothing to global metadata
		} elsif (not($current_id)) {
			print "Strange null entry under attribute " . $instance->attribute_list->[unpack "C", $id] . "... Your guess is as good ad mine...";
		} elsif ($force_purge{$current_id} or (not(($attribute eq "\x00")) and not($exists{$current_id}))) {
			my $error = $index->db_del($id);
			my $ord = unpack "C", $id;
			print "WARNING: purged corrupt data for nonexistent id $current_id — " . ($instance->attribute_list->[$ord] || "Unknown attribute [$ord]") . " (id# $current_id): ". ($error ? 'failed!' : 'succeeded.');
		}
	} until ($cursor->c_get($id, $document, DB_NEXT));
	$cursor->c_close;
	$instance->close_db;
	print "</p>";
	return @no_skip;