view release on metacpan or  search on metacpan

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

      $cgidir =~ s,/\.$,,g;           # change "path/." to "path"
      $cgidir =~ s,\\\.$,,g;          # change "path\." to "path"
      $cgidir =~ s,//+$,/,g;          # change "path///path" to "path/path"
      $cgidir =~ s,\\\\+$,\\,g;       # change "path\\\path" to "path\path"
   }
   return $cgidir;
}
#--------------------------------#

=item authenticate

Test the login information, if any.  Currently no tests are performed
-- this is a no-op.  Subclasses may override this method to test login
credentials.  Even though it's currently trivial, subclass methods
should alway include the line:

    return undef if (!$self->SUPER::authenticate());

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})
   {

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

   my $self = shift;
   my $params = shift;

   # Find the first key alphabetically, if any
   my $key = (sort keys %$params)[0];
   if ($key)
   {
      return @{$params->{$key}};
   }
   return ();
}

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

=item applyDBH

Tell other packages to use this new DBH object.  This method is called
from init() and getDBH() as needed.  This contacts the following
modules, if they are already loaded: 
CAM::Session, CAM::SQLManager, and CAM::Template::Cache.

=cut

sub applyDBH
{
   my $self = shift;

   my $dbh = $self->{dbh};
   CAM::Session->setDBH($dbh)         if ($CAM::Session::VERSION);
   CAM::SQLManager->setDBH($dbh)      if ($CAM::SQLManager::VERSION);
   CAM::Template::Cache->setDBH($dbh) if ($CAM::Template::Cache::VERSION);
}
#--------------------------------#

=item getSession

Return a CAM::Session object for this application.  If one has not yet
been created, make one now.  Note!  This must be called before the CGI
header is printed, if at all.

To use a class other than CAM::Session, set the C<sessionclass> config
variable.

=cut

sub getSession
{
   my $self = shift;
   my $dbname = shift;

   if (!exists $self->{session})
   {
      my $class = $self->{config}->{sessionclass};
      if (!$self->loadModule($class))
      {
         $self->error("Internal error: Failed to load the $class library");
      }

      if ($self->{config}->{cookiename})
      {
         $class->setCookieName($self->{config}->{cookiename});
      }
      if ($self->{config}->{sessiontable})
      {
         $class->setTableName($self->{config}->{sessiontable});
      }
      if ($self->{config}->{sessiontime})
      {
         $class->setExpiration($self->{config}->{sessiontime});
      }
      if (!$class->getDBH())
      {
         if (!$self->getDBH($dbname))
         {
            $self->error("No database connection, so a session could not be recorded");
         }
         $class->setDBH($self->getDBH($dbname));
      }
      $self->{session} = $class->new();
   }
   return $self->{session};
}
#--------------------------------#

=item getTemplate FILE, [KEY => VALUE, KEY => VALUE, ...]

Creates, prefills and returns a CAM::Template object.  The FILE should
be the template filename relative to the template directory specified
in the Config file.

See the prefillTemplate() method to see which key-value pairs are
preset.

=cut

sub getTemplate {
   my $self = shift;
   my $file = shift;

   return $self->_template("CAM::Template", $file, undef, @_);
}
#--------------------------------#

=item getTemplateCache CACHEKEY, FILE, [KEY => VALUE, KEY => VALUE, ...]

Creates, prefills and returns a CAM::Template::Cache object.  The
CACHEKEY should be the unique string that identifies the filled
template in the database cache.

=cut

sub getTemplateCache {
   my $self = shift;
   my $key = shift;
   my $file = shift;

   return $self->_template("CAM::Template::Cache", $file, $key, @_);
}
#--------------------------------#

=item getEmailTemplate FILE, [KEY => VALUE, KEY => VALUE, ...]