view release on metacpan or  search on metacpan

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

      dbh => undef,
      dir => $global_directory,

      # Internal parameters:
      filename => "",
      filetime => 0,
      tableName => "",
      keyName => "",
      queries => {},
      defaultquery => undef,
   }, $pkg);
   
   # pick up default arguments, if any
   $self->{cmd} = shift if (@_ > 0 && $_[0] !~ /^\-[a-z]+$/);

   # process switched arguments
   while (@_ > 0 && $_[0] =~ /^\-[a-z]+$/)
   {
      my $key = shift;
      my $value = shift;
      $key =~ s/^\-//;
      $self->{$key} = $value;
   }

   if (@_ > 0)
   {
      &carp("Too many arguments");
      return undef;
   }

   # Validate "dbh"
   if (!$self->getDBH()) {
      &carp("The DBH object is undefined");
      return undef;
   }
   if (ref($self->getDBH()) !~ /^DBI\b/ && ref($self->getDBH()) !~ /^DBD\b/) {
      &carp("The DBH object is not a valid DBI/DBD connection: " . ref($self->getDBH()));
      return undef;
   }

   # Validate "cmd"
   if ($self->{cmd} !~ /^(\w+[\/\\])*\w+(|\.\w+)$/)
   {
      &carp("Command keyword is not alphanumeric: $$self{cmd}");
      return undef;
   }

   # Use "dir" and "cmd" to get the SQL template
   $self->{filename} = File::Spec->catfile($self->{dir}, $self->{cmd});
   local *FILE;
   if (!open(FILE, $self->{filename}))
   {
      &carp("Cannot open sql command '$$self{filename}': $!");
      return undef;
   }
   local $/ = undef;
   $self->{sql} = <FILE>;
   close(FILE);

   # Record the last-mod time of the file so we can notice if it changes
   $self->{filetime} = (stat($self->{filename}))[9];

   # Set up the statistics data structures
   if (!exists $global_stats{cmds}->{$self->{cmd}})
   {
      # Any changes to this data structure should be propagated into
      # _incrStats() and the documentation for statistics()
      $global_stats{cmds}->{$self->{cmd}} = {
         queries => 0,
         time => 0,
         query => {},
      };
   }

   my $struct = CAM::XML->parse($self->{sql});

   if ((!$struct) || $struct->{name} ne "sqlxml")
   {
      &carp("XML parsing of the SQL query failed");
      return undef;
   }

   # Read the table data
   my ($tabledata) = $struct->getNodes(-path => "/sqlxml/table");
   if ($tabledata)
   {
      if ($tabledata->getAttribute("name"))
      {
         $self->{tableName} = $tabledata->getAttribute("name");
      }
      if ($tabledata->getAttribute("primarykey"))
      {
         $self->{keyName} = $tabledata->getAttribute("primarykey");
      }
   }

   # Extract all of the queries
   my @queries = $struct->getNodes(-path => "/sqlxml/query");
   if (@queries < 1)
   {
      &carp("There are no query tags in $$self{filename}");
      return undef;
   }
   
   foreach my $query (@queries)
   {
      my $name = $query->getAttribute("name");
      $name = "_default" if (!$name);
      if (exists $self->{queries}->{$name})
      {
         &carp("Multiple queries named $name in $$self{filename}");
         return undef;
      }
      
      # Throw away whitespace elements in the query body
      my $queryarray = [grep({$_->isa("CAM::XML") || $_->{text} =~ /\S/} $query->getChildren())];
      
      $self->{queries}->{$name} = $queryarray;
      if ((!$self->{defaultquery}) || $name eq "_default")
      {
         $self->{defaultquery} = $queryarray;
      }
   }

   # Set up statistics data structure
   foreach my $queryname ("retrieveByKey", keys %{$self->{queries}})
   {
      # Any changes to this data structure should be propagated into
      # _incrStats() and the documentation for statistics()
      $global_stats{cmds}->{$self->{cmd}}->{query}->{$queryname} = {
         queries => 0,
         time => 0,
      };
   }

   return $self;
}


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

=item getMgr CMD, CMD, ...

=item getMgr -dbh => DBH, CMD, CMD, ...

Like new() above, but caches the manager objects for later
re-requests.  Unlike new(), the database handle and SQL file directory
must already be set.  Use this function like:

  CAM::SQLManager->getMgr("foo.xml");

If more than one command is specified, the first one that results in a
real file is used.

=cut

sub getMgr
{
   my $pkg = shift;
   my @args = ();
   if ($_[0] && $_[0] eq "-dbh")
   {
      push @args, shift, shift;
   }
   my @cmds = (@_);

   foreach my $cmd (@cmds)
   {
      if (-e File::Spec->catfile($global_directory, $cmd))
      {
         if (exists $global_cache{$cmd})
         {
            # Check to make sure the SQL file has not changed
            if ($global_cache{$cmd}->{filetime} < (stat($global_cache{$cmd}->{filename}))[9])
            {
               $global_cache{$cmd} = $pkg->new($cmd, @args);
            }
         }
         else
         {
            $global_cache{$cmd} = $pkg->new($cmd, @args);
         }
         return $global_cache{$cmd};
      }
   }
   return undef;
}
#------------------

=item getAllCmds

Search the SQL directory for all command files.  This is mostly just
useful for the testCommands() method.

=cut

sub getAllCmds
{
   my $pkg = shift;

   my @files;
   my $regex = join("|", map {quotemeta} @global_extensions);
   my @dirs = ($global_directory);
   my %seendirs;
   while (@dirs > 0)
   {
      local *DIR;
      my $dir = shift @dirs;
      next if ($seendirs{$dir}++);
      
      if (!opendir(DIR, $dir))
      {
         if ($dir eq $global_directory)
         {
            &carp("Failed to read the SQL library directory '$dir': $!");
            return ();
         }
      }
      else
      {
         my @entries = readdir(DIR);
         closedir(DIR);
         
         @entries = map {File::Spec->catfile($dir, $_)} grep !/^\.\.?$/, @entries;
         push @files, grep /($regex)$/, @entries;
         push @dirs, grep {-d $_} @entries;
      }
   }
   return @files;
}
#------------------

=item setDirectory DIRECTORY