view release on metacpan or  search on metacpan

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

   foreach my $key (qw(cgi dbh session config))
   {
      $self->{$key} = $params{$key} if (exists $params{$key});
   }
   if (!$self->{config})
   {
      $self->{config} = {};
   }
   $self->init();
   return $self;
}

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

=item init

After an object is constructed, this method is called.  Subclasses may
want to override this method to apply tweaks before calling the
superclass initializer.  An example:

   sub init {
      my $self = shift;
      $self->{config}->{sqldir} = "../lib/sql";
      return $self->SUPER::init();
   }

This init function does the following:

* Sets up some of the basic configuration parameters 
(myURL, fullURL, cgidir, cgiurl)

* Creates a new CGI object if one does not exist (as per getCGI)

* Sets up the DBH object if one exists

* Tells CAM::SQLManager where the sqldir is located if possible

=cut

sub init
{
   my $self = shift;

   my $cfg = $self->{config}; # shorthand

   #$SIG{__DIE__} = sub {$self->{dying}=1;$self->error(@_)};

   ## Initialize session package
   $cfg->{sessionclass} ||= "CAM::Session";

   ## Initialize CGI
   $self->getCGI(); # initialize CGI if possible/appropriate

   ## Initialize myURL
   if (!exists $cfg->{myURL})
   {
      $cfg->{myURL} = CGI->url();
   }
   if (!exists $cfg->{fullURL} && $self->getCGI())
   {
      # For file uploads, the self_url call generates a
      #    "Use of uninitialized value at (eval 29) line 8."
      # error because of a bug in CGI v2.46.
      # Block this by turning off warnings for this line.
      no warnings;
      $cfg->{fullURL} = $self->getCGI()->self_url();
      use warnings;
   }

   ## Initialize cgiurl
   if ($cfg->{myURL} && (!exists $cfg->{cgiurl}))
   {
      # Truncate the filename from the URL
      ($cfg->{cgiurl} = $cfg->{myURL}) =~ s,/[^/\\]*$,,;
   }

   ## Initialize cgidir
   if (!exists $cfg->{cgidir})
   {
      $cfg->{cgidir} = $self->computeDir();
   }

   ## Initialize DBH
   if ($self->{dbh})
   {
      # Note that unlike getDBH(), the DBH is NOT cached in this case.
      # This is the correct behavior.  Since the calling script handed
      # us the DBH, it's assumed that the caller will handle any
      # caching

      $self->applyDBH();
   }

   ## Initialize sqldir
   if ($CAM::SQLManager::VERSION && $self->{config}->{sqldir})
   {
      CAM::SQLManager->setDirectory($self->{config}->{sqldir});
   }

   return $self;
}
#--------------------------------#

=item computeDir

Returns the directory in which this CGI script is located.  This can
be a class or instance method.

=cut

sub computeDir
{
   my $pkg_or_self = shift;

   my $cgidir;
   if ($ENV{SCRIPT_FILENAME})
   {
      ($cgidir = $ENV{SCRIPT_FILENAME}) =~ s,/[^/\\]*$,,;
   }
   elsif ($ENV{PATH_TRANSLATED})
   {