view release on metacpan or  search on metacpan

ContentHandler.pm  view on Meta::CPAN

      my $request = $self->{request};
      $request->content_type('text/html');
      $request->no_cache(1);
      $request->send_http_header;
      return OK if $request->header_only;
      print $html;
      return OK;
    } else {
      print $self->{cgi}->header;
      print $html;
    }
  } else {
    return $work;
  }
}

############################################################
# Standard CGI Functions:

=back

=head1 PROTECTED METHODS

=over 4

=item * _init

Private: called by new. Override to put your application specific
variables here.

=cut

sub _init {
  my $self = shift || die 'need $self';
  my $request = shift;

  $self->{mod_perl} = exists $ENV{"MOD_PERL"};

  if ($self->{mod_perl}) {
    $self->{request} = $request;
  }

  $self->{cgi} = new CGI; # used in various places regardless of mod_perl

  $self->{url}       = ($self->{mod_perl}
			? $request->uri
			: $self->url(-absolute=>1));

  $self->{title}     = 'Untitled Application';
  $self->{subtitle}  = '';
  $self->{action}    = $self->arg('action');
  $self->{default_action} = 'does_not_exist';
  $self->{debug}     = $self->arg('debug') || 0;
  $self->{error}     = {};
  $self->{redirect}  = '';
  $self->{noprint}   = 0;

  $self->{error_email}  = 'root';
  $self->{dbi_driver}   = '';
  $self->{dbi_user}     = '';
  $self->{dbi_password} = '';
}

=item * $val = $self->arg($key)

Returns a CGI/mod_perl parameter for the key $key.

=cut

sub arg {
  my $self = shift;
  my $key = shift;

  if ($self->{mod_perl}) {
    my %args = $self->{request}->args;
    return $args{$key};
  } else {
    return param($key);
  }
}

=item * @keys = $self->args

Returns a list of all of the mod_perl/cgi parameters.

=cut

sub args {
  my $self = shift;

  if ($self->{mod_perl}) {
    my %args = $self->{request}->args;
    return keys %args;
  } else {
    return param();
  }
}

=item * $s = $hc->header

Returns a string containing the preheader, an HTML title, and a
postheader. You probably do not want to override this unless you want
a different type of title.

=cut

sub header {
  my $self = shift || die 'need $self';

  return join(
	      '',
	      $self->preheader(),
	      h1($self->{title}),
	      ($self->{subtitle} ? "<small>$self->{subtitle}</small><BR>\n" : ''),
	      $self->postheader(),
	     );
}

=item * $s = $hc->work

Runs a method corresponding to the $action parameter, or the default

ContentHandler.pm  view on Meta::CPAN

sub postwork {
  return '';
}

=item * $s = $hc->prefooter

Returns the contents of the prefooter. Override to add something
before the footer.

=cut

sub prefooter {
  return '';
}

=item * $s = $hc->postfooter

Returns the contents of the postfooter. Override to add something
after the footer.

=cut

sub postfooter {
  return '';
}

############################################################
# Utility/Accessor/Helper Methods

=item * $s = $hc->reportError

Sends an email to the addresses listed in error_email, detailing an
error with as much debugging content as possible. Used for fatal
conditions.

=cut

sub reportError {
  my $self = shift;

  my $mailer = new Mail::Mailer;
  $mailer->open({
		'To' => $self->{error_email},
		'Subject' => "Error in " . $self->{url},
	       });

  print $mailer join ("\n",
		      "Error:",
		      ($self->{mod_perl}
		       ? '$url = ' . $self->{url} . '?' . $self->{request}->args
		       : $self->{cgi}->self_url),
		      @_);

  $mailer->close;
}

=item * $s = $hc->dbi

Returns a DBI connection. Override _init and add values for
dbi_driver, dbi_user, and dbi_password to make this connection.

=cut

sub dbi {
  my $self = shift;

  unless (defined $self->{dbi}) {
    $self->{dbi} = DBI->connect($self->{dbi_driver},
				$self->{dbi_user},
				$self->{dbi_password});

    if ($self->{dbi}) {
      $self->{dbi}->do('SET DateStyle = \'ISO\'') ||
	print '<H2>', $DBI::errstr, "</H2>\n";
    } else {
      print '<H2>', $DBI::errstr, "</H2>\n";
    }
  }

  return $self->{dbi};
}

=item * $s = $hc->sqlToTable

Returns an HTML representation of a SQL statement in table form.

=cut

sub sqlToTable {
  my $self = shift;
  my $sql = shift;

  my $result = '';
  my $dbi = $self->dbi();

  my $sth = $dbi->prepare($sql);
  if ( !defined $sth ) {
    die "Cannot prepare statement: $DBI::errstr\n";
  }
  $sth->execute();

  my $head = $sth->{NAME};

  $result .= "<TABLE>\n";
  $result .= "<TR><TH>\n";
  $result .= join("</TH> <TH>", @$head);
  $result .= "</TH></TR>\n";

  my @row;
  while (@row = $sth->fetchrow) {
    $result .= "<TR><TD>\n";
    $result .= join("</TD> <TD>", @row);
    $result .= "</TD></TR>\n";
  }
  $result .= "</TABLE>\n";

  $sth->finish;
  return $result;
}

=item * $s = $hc->sqlToArrays

Returns an array representing a SQL query.

=cut

sub sqlToArrays {
  my $self = shift;
  my $sql = shift;
  my $result = [];