view release on metacpan or  search on metacpan

Wyrd/Bot.pm  view on Meta::CPAN

sub _process_results {
	my ($self, $status, $view) = @_;
	my $status_message = "Unknown";
	$status_message = "Finished" if ($status == 0);
	$status_message = "Working..." if ($status == 1);
	return ($status_message, $view);
}

=pod

=back

=head1 BUGS/CAVEATS

Spawns shells, invokes interpreters.  All security caveats
associated with these actions must be taken into account.

Many reserved methods in addition to C<_format_output>:
C<errfile>, C<expire>, C<go>, C<lib>, C<outfile>, C<params>,
C<perl>, C<pidfile>, C<refresh>, C<template>, C<_cleanup>,
C<_go>, C<_init_params>, C<_message>, C<_prepare>,
C<_process_params>, C<_read_message>, C<_write_message>.

=cut

sub go {
	my ($class) = @_;
	my $self = {};
	bless $self, $class;
	$self->_go;
	exit 0;
}


sub _init_params {
	my ($self) = @_;
	$self->{'message'} = {};
	$self->_data($self->template) unless $self->_data;
	my $params = $self->params;
	$params = {} unless (ref($params) eq 'HASH');
	foreach my $attribute (qw(basefile pidfile errfile outfile refresh expire perl)) {
		#allow html-specified attributes to override builtin defaults
		$params->{$attribute} = $self->{$attribute} || $params->{$attribute};
	}
	$params = $self->_process_params($params);
	map {$self->{$_} = $$params{$_}} keys %$params;
	$self->_message($params);
}

sub _format_output {
	my ($self) = @_;
	$self->_init_params;
	my $running = 0;
	my $start = 1;
	my $view = '';
	my $status = 0;
	my $meta = '';
	if (-f $self->pidfile) {
		my $pid = ${slurp_file($self->pidfile)};
		($pid) = $pid =~ /^(\d+)$/; #untainting
		$running = kill(0, $pid) if ($pid);
		if (not($pid)) {
			$self->_raise_exception("Pidfile " . $self->pidfile . " exists, but can't be read. Cannot continue.");
		} elsif ($running) {
			$self->_info("An instance of this Bot is running.  A new bot will not be launched.");
			$start = 0;
		} else {
			sleep 1;#making sure the other process wasn't just about to remove the file, and we caught it in mid-state
			if (-f $self->pidfile) {
				$self->_error("A stale pidfile was found.  Removing it and continuing... ");
				unlink($self->pidfile) || $self->_raise_exception("Could not remove stale pidfile " . $self->pidfile . ". Cannot continue.");
			}
		}
	}
	if (not($running) and (-f $self->outfile)) {
		my @stat = stat _;
		#warn "$stat[9] -- " . time;
		if ($stat[9] < (time - $self->expire)) {
			$self->_error("Found old results.  Cleaning up.");
			unlink $self->outfile || $self->_raise_exception("Could not remove stale outfile " . $self->outfile);
		} else {
			$start = 0;
		}
	}
	$view = ${slurp_file($self->outfile)} || '';
	$view = join("\n", reverse(split("\n", $view))) if ($self->_flags->reverse);
	$view = "<pre>$view</pre>" unless($self->_flags->raw);
	if ($start) {
		my $lib = '';
		$lib = ' -I' . $self->lib if ($self->lib);
		my $command = '| ' . $self->{'perl'} . $lib . ' -M' . $self->_class_name . q( -e') . $self->_class_name . q(->go');
		#warn $command;
		my $result = open (SPAWN, $command);
		#warn "result was $result";
		my $message = $self->_write_message;
		print SPAWN $message;
		close (SPAWN) || $self->_raise_exception("Failed to send message:\n$message\n to daemon.  It probably died.");
		#$self->_raise_exception("Spawned Bot failed and could not recover") if ($result > 1);
		#$self->_error("Spawned Bot detected another instance and is letting it continue") if ($result == 1);
		$running = 1;
	}
	if ($running) {
		$status = 1;
		$meta = '<meta http-equiv="refresh" content="' . $self->refresh . ';url=' . $self->dbl->req->parsed_uri->unparse . '">'
	}
	($status, $view) = $self->_process_results($status, $view);
	$self->_data($self->_set({status => $status, view => $view, meta => $meta}));
	unlink ($self->outfile) unless($running);

}

sub _process_params {
	my ($self, $params) = @_;
	my $basefile = $params->{'basefile'};
	$self->_raise_exception("basefile is required.  Please supply a value for the key 'basefile' in your initialization hash.") unless ($basefile);
	$self->_raise_exception("basefile requires an absolute pathname") unless ($basefile =~ /^\//);
	$params->{'pidfile'} ||= $basefile . '.pid';
	$params->{'outfile'} ||= $basefile . '.out';
	$params->{'errfile'} ||= $basefile . '.err';
	$params->{'refresh'} ||= 2;