view release on metacpan or  search on metacpan

lib/CAM/App.pm  view on Meta::CPAN

In case the parent authenticate() method adds a test in the future.

=cut

sub authenticate {
   my $self = shift;

   # No checks

   return $self;
}

#--------------------------------#

=item header

Compose and return a CGI header, including the CAM::Session cookie, if
applicable (i.e. if getSession() has been called first).  Returns the
empty string if the header has already been printed.

=cut

sub header {
   my $self = shift;

   my $cgi = $self->getCGI();
   if (!$cgi)
   {
      if (!$self->{header_printed})
      {
         $self->{header_printed} = 1;
         return "Content-Type: text/html\n\n";
      }
      else
      {
         return "";
      }
   }
   elsif (!$cgi->{'.header_printed'})
   {
      if ($self->{session})
      {
         return $cgi->header(-cookie => $self->{session}->getCookie(), @_);
      }
      else
      {
         return $cgi->header(@_);
      }
   }
   else
   {
      return "";
   }
}
#--------------------------------#

=item isAllowedHost

This function is called from authenticate().  Checks the incoming host
and returns false if it should be blocked.  Currently no tests are
performed -- this is a no-op.  Subclasses may override this behavior.

=cut

sub isAllowedHost {
   my $self = shift;

   # For now, let any host view the site
   # Return undef to block access to a host
   return $self;
}
#--------------------------------#

=item getConfig

Returns the configuration hash.

=cut

sub getConfig
{
   my $self = shift;
   return $self->{config};
}
#--------------------------------#

=item getCGI

Returns the CGI object.  If a CGI object does not exist, one is
created.  If this application is initialized explicitly like 
C<new(cgi =E<gt> undef)>, then no new CGI object is created.  This
behavior is useful for non-CGI applications, like SOAP handlers.

CGI::Compress::Gzip is preferred over CGI.  The former will be used if
it is installed and the client browser supports gzip encoding.

=cut

sub getCGI
{
   my $self = shift;
   if (!exists $self->{cgi})
   {
      if ($ENV{HTTP_ACCEPT_ENCODING} && # don't bother unless it's possible
          $self->loadModule("CGI::Compress::Gzip"))
      {
         $self->{cgi} = CGI::Compress::Gzip->new();
      }
      else
      {
         $self->{cgi} = CGI->new();
      }
   }
   return $self->{cgi};
}
#--------------------------------#

=item getDBH

=item getDBH NAME