view release on metacpan or  search on metacpan

Wyrd/DBL.pm  view on Meta::CPAN

	};
	if (UNIVERSAL::isa($$init{'database'}, 'DBI::db')) {
		if ($$init{'database'}->can('ping') && $$init{'database'}->ping) {
			$data->{'dbh'} = $$init{'database'};
			$data->{'dbh_ok'} = 1;
		} else {
			$data->log_bug('DBI-type Database apparently passed to Das Blinkenlights, but was not valid')
		}
	}
	return $data;
}

=pod

=item verify_dbl_compatibility

Used by Apache::Wyrd to confirm it's been passed the right sort of object for a
DBL.

=cut

sub verify_dbl_compatibility {
	return 1;
}

=item (scalar) C<strict> (void)

Optional read-only method for "strict" conditions.  Not used by the default install.

=cut

sub strict {
	my ($self) = @_;
	return $self->{'strict'};
}

=pod

=item (scalar) C<loglevel> (void)

Optional read-only method for "loglevel" conditions.  Not used by the default install.

=cut

sub loglevel {
	my ($self) = @_;
	return $self->{'loglevel'};
}

=pod

=item (void) C<log_bug> (scalar)

insert a debugging message in the session log.

=cut

sub log_bug {
	return unless (ref($_[0]) and ($_[0]->{'debug'}));
	my ($self, $value) = @_;
	my @caller = caller();
	$caller[0] =~ s/.+://;
	$caller[2] =~ s/.+://;
	my $id = "($caller[0]:$caller[2])";
	$value = join(':', $id, $value);
	push @{$self->{'dbl_log'}}, $value;
	warn $value;
}

=pod

=item (void) C<set_logfile> (filehandle typeglob)

give DBL a file in which to store it's events. The filehandle is then kept in
the logfile attribute.

=cut

sub set_logfile {
	my ($self, $fh) = @_;
	$| = 1;
	$self->{'logfile'} = $fh;
}

=pod

=item (void) C<close_logfile> (void)

flush logfile to disk.  Necessary in mod_perl situation, it seems.

=cut

sub close_logfile {
	my ($self, $fh) = @_;
	$self->{'logfile'} = $fh;
	close ($fh) if ($fh);
	eval("system('/bin/sync')");
}

=pod

=item (void) C<log_event> (scalar)

same as log_bug, but don't send the output to STDERR. Instead, make it HTML escaped and store it for later dumping.

=cut

sub log_event {
	my ($self, $value) = @_;
	$self->{'dbl_log'} = [@{$self->{'dbl_log'}}, $value];
	my $fh = $self->{'logfile'};
	if ($fh) {
		print $fh (Apache::Util::escape_html($value) . "<br>\n");
	}
}

=pod

=item (hashref) C<base_class> (void)

return the base class of this set of Wyrds.