[BACK]Return to lonmysql.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonmysql.pm between versions 1.8 and 1.41

version 1.8, 2003/03/10 21:22:36 version 1.41, 2019/11/20 18:02:55
Line 31  package Apache::lonmysql; Line 31  package Apache::lonmysql;
   
 use strict;  use strict;
 use DBI;  use DBI;
 use Apache::lonnet();  use POSIX qw(strftime mktime);
   use Apache::lonnet;
   
   my $mysqluser;
   my $mysqlpassword;
   my $mysqldatabase;
   my %db_config;
   
   sub set_mysql_user_and_password {
       # If we are running under Apache and LONCAPA, use the LON-CAPA 
       # user and password.  Otherwise...? ? ? ?
       my ($input_mysqluser,$input_mysqlpassword,$input_mysqldatabase) = @_;
       if (! defined($mysqldatabase)) {
           $mysqldatabase = 'loncapa';
       }
       if (defined($input_mysqldatabase)) {
           $mysqldatabase = $input_mysqldatabase;
       }
       if (! defined($mysqluser) || ! defined($mysqlpassword)) {
           if (! eval 'require Apache::lonnet();') {
               $mysqluser = 'www';
               $mysqlpassword = $Apache::lonnet::perlvar{'lonSqlAccess'};
           } else {
               $mysqluser = '';
               $mysqlpassword = '';
           }
       }
       if (defined($input_mysqluser)) {
           $mysqluser = $input_mysqluser;
       } 
       if (defined($input_mysqlpassword)) {
           $mysqlpassword = $input_mysqlpassword;
       }
   }
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
Line 54  and provide a common interface.  The goa Line 87  and provide a common interface.  The goa
 a complete reimplementation of the DBI interface.  Instead we try to   a complete reimplementation of the DBI interface.  Instead we try to 
 make using mysql as painless as possible.  make using mysql as painless as possible.
   
 Each table has a numeric ID that is a parameter to most lonmysql functions.  Each table has a numeric ID that is a parameter to most lonmysql
 The table id is returned by &create_table.    functions.  The table id is returned by &create_table.  If you lose
 If you lose the table id, it is lost forever.  the table id, it is lost forever.  The table names in MySQL correspond
 The table names in MySQL correspond to   to $env{'user.name'}.'_'.$env{'user.domain'}.'_'.$table_id. (With all
 $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$table_id.  If the table id   non-word characters removed form user.name and user.domain) If the
 is non-numeric, it is assumed to be the full name of a table.  If you pass  table id is non-numeric, it is assumed to be the full name of a table.
 the table id in a form, you MUST ensure that what you send to lonmysql is  If you pass the table id in a form, you MUST ensure that what you send
 numeric, otherwise you are opening up all the tables in the MySQL database.  to lonmysql is numeric, otherwise you are opening up all the tables in
   the MySQL database.
   
 =over 4  =over 4
   
Line 71  To create a table, you need a descriptio Line 105  To create a table, you need a descriptio
 for &create_table for a description of what is needed.  for &create_table for a description of what is needed.
   
  $table_id = &create_table({    $table_id = &create_table({ 
             columns => {       id      => 'tableid',      # usually you will use the returned id
                 id => {       columns => (
                     type => 'INT',                   { name => 'id',
                     restrictions => 'NOT NULL',                     type => 'INT',
                     primary_key => 'yes',                     restrictions => 'NOT NULL',
                     auto_inc    => 'yes'                     primary_key => 'yes',
                     }                     auto_inc    => 'yes'
                 verbage => { type => 'TEXT' },                     },
             },                   { name => 'verbage',
             column_order => [qw/id verbage idx_verbage/],                     type => 'TEXT' },
             fulltext => [qw/verbage/],                   ),
                          fulltext => [qw/verbage/],
         });          });
   
 The above command will create a table with two columns, 'id' and 'verbage'.  The above command will create a table with two columns, 'id' and 'verbage'.
Line 230  an array reference which holds the order Line 265  an array reference which holds the order
   
 The statement handler for row inserts.  The statement handler for row inserts.
   
   =item row_replace_sth 
   
   The statement handler for row inserts.
   
 =back  =back
   
 Col_order and row_insert_sth are kept internally by lonmysql and are not  Col_order and row_insert_sth are kept internally by lonmysql and are not
Line 323  connection is established. Line 362  connection is established.
 ###############################  ###############################
 sub connect_to_db {   sub connect_to_db { 
     return 1 if ($dbh);      return 1 if ($dbh);
     if (! ($dbh = DBI->connect("DBI:mysql:loncapa","www",      if (! defined($mysqluser) || ! defined($mysqlpassword)) {
                                $Apache::lonnet::perlvar{'lonSqlAccess'},          &set_mysql_user_and_password();
       }
       if (! ($dbh = DBI->connect("DBI:mysql:$mysqldatabase",$mysqluser,$mysqlpassword,
                                { RaiseError=>0,PrintError=>0}))) {                                 { RaiseError=>0,PrintError=>0}))) {
         $debugstring = "Unable to connect to loncapa database.";              $debugstring = "Unable to connect to loncapa database.";    
         if (! defined($dbh)) {          if (! defined($dbh)) {
Line 336  sub connect_to_db { Line 377  sub connect_to_db {
         return undef;          return undef;
     }      }
     $debugstring = "Successfully connected to loncapa database.";          $debugstring = "Successfully connected to loncapa database.";    
       # Determine DB configuration
       undef(%db_config);
       my $sth = $dbh->prepare("SHOW VARIABLES");
       $sth->execute();
       if ($sth->err()) {
           $debugstring = "Unable to retrieve db config variables";
           return undef;
       }
       foreach my $row (@{$sth->fetchall_arrayref}) {
           $db_config{$row->[0]} = $row->[1];
       }
       #&Apache::lonnet::logthis("MySQL configuration variables");
       #while (my ($k,$v) = each(%db_config)) {
       #    &Apache::lonnet::logthis("    '$k' => '$v'");
       #}
       #
       return 1;
   }
   
   ###############################
   
   =pod
   
   =item &verify_sql_connection()
   
   Inputs: none.
   
   Returns: 0 (failure) or 1 (success)
   
   Checks to make sure the database can be connected to.  It does not
   initialize anything in the lonmysql package.
   
   =cut
   
   ###############################
   sub verify_sql_connection {
       if (! defined($mysqluser) || ! defined($mysqlpassword)) {
           &set_mysql_user_and_password();
       }
       my $connection;
       if (! ($connection = DBI->connect("DBI:mysql:loncapa",
                                         $mysqluser,$mysqlpassword,
                                         { RaiseError=>0,PrintError=>0}))) {
           return 0;
       }
       undef($connection);
     return 1;      return 1;
 }  }
   
Line 362  sub disconnect_from_db { Line 449  sub disconnect_from_db {
         if (exists($Tables{$_}->{'row_insert_sth'})) {          if (exists($Tables{$_}->{'row_insert_sth'})) {
             delete($Tables{$_}->{'row_insert_sth'});              delete($Tables{$_}->{'row_insert_sth'});
         }          }
           if (exists($Tables{$_}->{'row_replace_sth'})) {
               delete($Tables{$_}->{'row_replace_sth'});
           }
     }      }
     $dbh->disconnect if ($dbh);      $dbh->disconnect if ($dbh);
     $debugstring = "Disconnected from database.";      $debugstring = "Disconnected from database.";
Line 388  sub number_of_rows { Line 478  sub number_of_rows {
     return undef if (! defined(&update_table_info($table_id)));      return undef if (! defined(&update_table_info($table_id)));
     return $Tables{&translate_id($table_id)}->{'Rows'};      return $Tables{&translate_id($table_id)}->{'Rows'};
 }  }
   ###############################
   
   =pod
   
   =item &get_dbh()
   
   Input: nothing
   
   Returns: the database handler, or undef on error.
   
   This routine allows the programmer to gain access to the database handler.
   Be careful.
   
   =cut
   
   ###############################
   sub get_dbh { 
       return undef if (! defined(&connect_to_db()));
       return $dbh;
   }
   
 ###############################  ###############################
   
Line 462  sub update_table_info { Line 572  sub update_table_info {
     #      #
     # Get MySQLs table status information.      # Get MySQLs table status information.
     #      #
     my @tabledesc = qw/  
         Name Type Row_format Rows Avg_row_length Data_length  
             Max_data_length Index_length Data_free Auto_increment   
                 Create_time Update_time Check_time Create_options Comment /;  
     my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";      my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";
     my $sth = $dbh->prepare($db_command);      my $sth = $dbh->prepare($db_command);
     $sth->execute();      $sth->execute();
Line 475  sub update_table_info { Line 581  sub update_table_info {
         &disconnect_from_db();          &disconnect_from_db();
         return undef;          return undef;
     }      }
       my @column_name = @{$sth->{NAME}};
     #      #
     my @info=$sth->fetchrow_array;      my @info=$sth->fetchrow_array;
     for (my $i=0;$i<= $#info ; $i++) {      for (my $i=0;$i<= $#info ; $i++) {
         $Tables{$tablename}->{$tabledesc[$i]}= $info[$i];          if ($column_name[$i] =~ /^(Create_|Update_|Check_)time$/) {
               $Tables{$tablename}->{$column_name[$i]}= 
                   &unsqltime($info[$i]);
           } else {
               $Tables{$tablename}->{$column_name[$i]}= $info[$i];
           }
     }      }
     #      #
     # Determine the column order      # Determine the column order
Line 507  sub update_table_info { Line 619  sub update_table_info {
   
 =pod  =pod
   
   =item &table_information()
   
   Inputs: table id
   
   Returns: hash with the table status
   
   =cut
   
   ###############################
   sub table_information {
       my $table_id=shift;
       if (&update_table_info($table_id)) {
    return %{$Tables{$table_id}};
       } else {
    return ();
       }
   }
   
   ###############################
   
   =pod
   
   =item &col_order()
   
   Inputs: table id
   
   Returns: array with column order
   
   =cut
   
   ###############################
   sub col_order {
       my $table_id=shift;
       if (&update_table_info($table_id)) {
    return @{$Tables{$table_id}->{'Col_order'}};
       } else {
    return ();
       }
   }
   
   ###############################
   
   =pod
   
 =item &create_table()  =item &create_table()
   
 Inputs:   Inputs: 
     table description      table description, see &build_table_creation_request
   Returns:
       undef on error, table id on success.
   
   =cut
   
 Input formats:  ###############################
   sub create_table {
       return undef if (!defined(&connect_to_db($dbh)));
       my ($table_des)=@_;
       my ($request,$table_id) = &build_table_creation_request($table_des);
       #
       # Execute the request to create the table
       #############################################
       my $count = $dbh->do($request);
       if (! defined($count)) {
           $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
               $dbh->errstr();
           return undef;
       }
       my $tablename = &translate_id($table_id);
       delete($Tables{$tablename}) if (exists($Tables{$tablename}));
       return undef if (! defined(&update_table_info($table_id)));
       $debugstring = "Created table $tablename at time ".time.
           " with request\n$request";
       return $table_id;
   }
   
   ###############################
   
   =pod
   
   =item build_table_creation_request
   
   Input: table description
   
     table description = {      table description = {
         permanent  => 'yes' or 'no',          permanent  => 'yes' or 'no',
Line 530  Input formats: Line 718  Input formats:
                       ...                        ...
                   },                    },
         ],          ],
           'PRIMARY KEY' => (index_col_name,...),
            KEY => [{ name => 'idx_name', 
                     columns => (col1,col2,..),},],
            INDEX => [{ name => 'idx_name', 
                       columns => (col1,col2,..),},],
            UNIQUE => [{ index => 'yes',
                        name => 'idx_name',
                        columns => (col1,col2,..),},],
            FULLTEXT => [{ index => 'yes',
                          name => 'idx_name',
                          columns => (col1,col2,..),},],
   
     }      }
   
 Returns:  Returns: scalar string containing mysql commands to create the table
     undef on error, table id on success.  
   
 =cut  =cut
   
 ###############################  ###############################
 sub create_table {  sub build_table_creation_request {
     return undef if (!defined(&connect_to_db($dbh)));  
     my ($table_des)=@_;      my ($table_des)=@_;
     #      #
     # Build request to create table      # Build request to create table
     ##################################      ##################################
     my @Columns;      my @Columns;
     my $col_des;      my $col_des;
     my $table_id = &get_new_table_id();      my $table_id;
       if (exists($table_des->{'id'})) {
           $table_id = $table_des->{'id'};
       } else {
           $table_id = &get_new_table_id();
       }
     my $tablename = &translate_id($table_id);      my $tablename = &translate_id($table_id);
     my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";      my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
     foreach my $coldata (@{$table_des->{'columns'}}) {      foreach my $coldata (@{$table_des->{'columns'}}) {
Line 577  sub create_table { Line 780  sub create_table {
         # skip blank items.          # skip blank items.
         push (@Columns,$col_des) if ($col_des ne '');          push (@Columns,$col_des) if ($col_des ne '');
     }      }
     if (exists($table_des->{'fulltext'}) && (@{$table_des->{'fulltext'}})) {      if (exists($table_des->{'PRIMARY KEY'})) {
         push (@Columns,'FULLTEXT ('.join(',',@{$table_des->{'fulltext'}}).')');          push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}})
                 .')');
       }
       #
       foreach my $indextype ('KEY','INDEX') {
           next if (!exists($table_des->{$indextype}));
           foreach my $indexdescription (@{$table_des->{$indextype}}) {
               my $text = $indextype.' ';
               if (exists($indexdescription->{'name'})) {
                   $text .=$indexdescription->{'name'};
               }
               $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
               push (@Columns,$text);
           }
       }
       #
       foreach my $indextype ('UNIQUE','FULLTEXT') {
           next if (! exists($table_des->{$indextype}));
           foreach my $indexdescription (@{$table_des->{$indextype}}) {
               my $text = $indextype.' ';
               if (exists($indexdescription->{'index'}) &&
                   $indexdescription->{'index'} eq 'yes') {
                   $text .= 'INDEX ';
               }
               if (exists($indexdescription->{'name'})) {
                   $text .=$indexdescription->{'name'};
               }
               $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
               push (@Columns,$text);
           }
     }      }
       #
     $request .= "(".join(", ",@Columns).") ";      $request .= "(".join(", ",@Columns).") ";
     unless($table_des->{'permanent'} eq 'yes') {      unless($table_des->{'permanent'} eq 'yes') {
         $request.="COMMENT = 'temporary' ";          $request.="COMMENT = 'temporary' ";
     }       } 
     $request .= "TYPE=MYISAM";      $request .= "ENGINE=MYISAM";
     #      return $request,$table_id;
     # Execute the request to create the table  }
     #############################################  
     my $count = $dbh->do($request);  ###############################
     if (! defined($count)) {  
         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n";  =pod
         return undef;  
     }  =item &get_table_prefix()
     #  
     # Set up the internal bookkeeping  returns the cleaned version of user.name and user.domain for us in table names
     #############################################  
     delete($Tables{$tablename}) if (exists($Tables{$tablename}));  =cut
     return undef if (! defined(&update_table_info($table_id)));  
     $debugstring = "Created table $tablename at time ".time.  ###############################
         " with request\n$request";  sub get_table_prefix {
     return $table_id;      my $clean_name   = $env{'user.name'};
       my $clean_domain = $env{'user.domain'};
       $clean_name =~ s/\W//g;
       $clean_domain =~ s/\W//g;
       return $clean_name.'_'.$clean_domain.'_';
 }  }
   
 ###############################  ###############################
Line 617  Used internally to prevent table name co Line 854  Used internally to prevent table name co
 sub get_new_table_id {  sub get_new_table_id {
     my $newid = 0;      my $newid = 0;
     my @tables = &tables_in_db();      my @tables = &tables_in_db();
       my $prefix = &get_table_prefix();
     foreach (@tables) {      foreach (@tables) {
         if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) {          if (/^\Q$prefix\E(\d+)$/) {
             $newid = $1 if ($1 > $newid);              $newid = $1 if ($1 > $newid);
         }          }
     }      }
Line 652  sub get_rows { Line 890  sub get_rows {
         return undef;          return undef;
     }      }
     my $tablename = &translate_id($table_id);      my $tablename = &translate_id($table_id);
     my $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition;      my $request;
       if (defined($condition) && $condition ne '') {
           $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition;
       } else {
           $request = 'SELECT * FROM '.$tablename;
           $condition = 'no condition';
       }
     my $sth=$dbh->prepare($request);      my $sth=$dbh->prepare($request);
     $sth->execute();      $sth->execute();
     if ($sth->err) {      if ($sth->err) {
Line 725  sub store_row { Line 969  sub store_row {
     return 1;      return 1;
 }  }
   
   
   ###############################
   
   =pod
   
   =item &bulk_store_rows()
   
   Inputs: table id, [columns],[[row data1].[row data2],...]
   
   returns undef on error, 1 on success.
   
   =cut
   
   ###############################
   sub bulk_store_rows {
       my ($table_id,$columns,$rows) = @_;
       # 
       return undef if (! defined(&connect_to_db()));
       my $dbh = &get_dbh();
       return undef if (! defined($dbh));
       my $table_status = &check_table($table_id);
       return undef if (! defined($table_status));
       if (! $table_status) {
           $errorstring = "table $table_id does not exist.";
           return undef;
       }
       #
       my $tablename = &translate_id($table_id);
       #
       my $request = 'INSERT IGNORE INTO '.$tablename.' ';
       if (defined($columns) && ref($columns) eq 'ARRAY') {
           $request .= join(',',@$columns).' ';
       }
       if (! defined($rows) || ref($rows) ne 'ARRAY') {
           $errorstring = "no input rows given.";
           return undef;
       }
       $request .= 'VALUES ';
       foreach my $row (@$rows) {
           # avoid doing row stuff here...
           $request .= '('.join(',',@$row).'),';
       }
       $request =~ s/,$//;
       # $debugstring = "Executed ".$/.$request; # commented out - this is big
       $dbh->do($request);
       if ($dbh->err) {
           $errorstring = 'Attempted '.$/.$request.$/.'Got error '.$dbh->errstr();
           return undef;
       }
       return 1;
   }
   
   
   ###############################
   
   =pod
   
   =item &replace_row()
   
   Inputs: table id, row data
   
   returns undef on error, 1 on success.
   
   Acts like &store_row() but uses the 'REPLACE' command instead of 'INSERT'.
   
   =cut
   
   ###############################
   sub replace_row {
       my ($table_id,$rowdata) = @_;
       # 
       return undef if (! defined(&connect_to_db()));
       my $table_status = &check_table($table_id);
       return undef if (! defined($table_status));
       if (! $table_status) {
           $errorstring = "table $table_id does not exist.";
           return undef;
       }
       #
       my $tablename = &translate_id($table_id);
       #
       my $sth;
       if (exists($Tables{$tablename}->{'row_replace_sth'})) {
           $sth = $Tables{$tablename}->{'row_replace_sth'};
       } else {
           # Build the insert statement handler
           return undef if (! defined(&update_table_info($table_id)));
           my $replace_request = 'REPLACE INTO '.$tablename.' VALUES(';
           foreach (@{$Tables{$tablename}->{'Col_order'}}) {
               $replace_request.="?,";
           }
           chop $replace_request;
           $replace_request.=")";
           $sth=$dbh->prepare($replace_request);
           $Tables{$tablename}->{'row_replace_sth'}=$sth;
       }
       my @Parameters; 
       if (ref($rowdata) eq 'ARRAY') {
           @Parameters = @$rowdata;
       } elsif (ref($rowdata) eq 'HASH') {
           foreach (@{$Tables{$tablename}->{'Col_order'}}) {
               push(@Parameters,$rowdata->{$_});
           }
       } 
       $sth->execute(@Parameters);
       if ($sth->err) {
           $errorstring = "$dbh ATTEMPTED replace @Parameters RESULTING ERROR:\n".
               $sth->errstr;
           return undef;
       }
       $debugstring = "Stored row.";    
       return 1;
   }
   
 ###########################################  ###########################################
   
 =pod  =pod
Line 737  Returns undef on error. Line 1095  Returns undef on error.
 =cut  =cut
   
 ###########################################  ###########################################
   
   ########## Show-Tables Cache
   my $have_read_tables = 0;
   my $dbh_sth;
   ##########
   
 sub tables_in_db {  sub tables_in_db {
     return undef if (!defined(&connect_to_db()));      return undef if (!defined(&connect_to_db()));
     my $sth=$dbh->prepare('SHOW TABLES');      
     $sth->execute();      ########## Show-Tables Cache
     if ($sth->err) {      if(!$have_read_tables) { 
         $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'.       $dbh_sth=$dbh->prepare('SHOW TABLES');
             "\nRESULTING ERROR:\n".$sth->errstr;       $have_read_tables = 1;
       }   
       $dbh_sth->execute();
       #$dbh_sth->execute(); # Removed strange execute - from release 119
       ##########    
       
       my $aref = $dbh_sth->fetchall_arrayref;
       if ($dbh_sth->err()) {
           $errorstring = 
               "$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'.
               "\nRESULTING ERROR:\n".$dbh_sth->errstr;
         return undef;          return undef;
     }      }
     my $aref = $sth->fetchall_arrayref;      my @table_list;
     my @table_list=();  
     foreach (@$aref) {      foreach (@$aref) {
         push @table_list,$_->[0];          push(@table_list,$_->[0]);
     }      }
     $debugstring = "Got list of tables in DB: @table_list";      $debugstring = "Got list of tables in DB: ".join(',',@table_list);
     return @table_list;      return(@table_list);
 }  }
   
 ###########################################  ###########################################
Line 775  sub translate_id { Line 1148  sub translate_id {
     # id should be a digit.  If it is not a digit we assume the given id      # id should be a digit.  If it is not a digit we assume the given id
     # is complete and does not need to be translated.      # is complete and does not need to be translated.
     return $id if ($id =~ /\D/);        return $id if ($id =~ /\D/);  
     return $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.$id;      return &get_table_prefix().$id;
 }  }
   
 ###########################################  ###########################################
Line 800  sub check_table { Line 1173  sub check_table {
     my @Table_list = &tables_in_db();      my @Table_list = &tables_in_db();
     my $result = 0;      my $result = 0;
     foreach (@Table_list) {      foreach (@Table_list) {
         if (/^$table_id$/) {          if ($_ eq $table_id) {
             $result = 1;              $result = 1;
             last;              last;
         }          }
Line 831  sub remove_from_table { Line 1204  sub remove_from_table {
     return undef if (!defined(&connect_to_db()));      return undef if (!defined(&connect_to_db()));
     #      #
     $table_id = &translate_id($table_id);      $table_id = &translate_id($table_id);
     my $command = 'DELETE FROM '.$table_id.' WHERE '.$dbh->quote($column).      my $command = 'DELETE FROM '.$table_id.' WHERE '.$column.
         " LIKE BINARY ".$dbh->quote($value);          " LIKE BINARY ".$dbh->quote($value);
     my $sth = $dbh->prepare($command);       my $sth = $dbh->prepare($command); 
     $sth->execute();      unless ($sth->execute()) {
     if ($sth->err) {  
         $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;          $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
         return undef;          return undef;
     }      }
       $debugstring = $command;
     my $rows = $sth->rows;      my $rows = $sth->rows;
     return $rows;      return $rows;
 }  }
   
   ###########################################
   
   =pod
   
   =item drop_table($table_id)
   
   Issues a 'drop table if exists' command
   
   =cut
   
   ###########################################
   
   sub drop_table {
       my ($table_id) = @_;
       return undef if (!defined(&connect_to_db()));
       #
       $table_id = &translate_id($table_id);
       my $command = 'DROP TABLE IF EXISTS '.$table_id;
       my $sth = $dbh->prepare($command); 
       $sth->execute();
       if ($sth->err) {
           $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
           return undef;
       }
       $debugstring = $command;
       delete($Tables{$table_id}); # remove any knowledge of the table
       return 1; # if we got here there was no error, so return a 'true' value
   }
   
   ##########################################
   
   =pod
   
   =item fix_table_name 
   
   Fixes a table name so that it will work with MySQL.
   
   =cut
   
   ##########################################
   sub fix_table_name {
       my ($name) = @_;
       $name =~ s/^(\d+[eE]\d+)/_$1/;
       $name =~ s/\W//g;
       return $name;
   }
   
   
   # ---------------------------- convert 'time' format into a datetime sql format
   sub sqltime {
       my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
    localtime(&unsqltime($_[0]));
       $mon++; $year+=1900;
       return "$year-$mon-$mday $hour:$min:$sec";
   }
   
   sub maketime {
       my %th=@_;
       return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},
                             $th{'day'},$th{'month'}-1,
                             $th{'year'}-1900,0,0,$th{'dlsav'}));
   }
   
   
   #########################################
   #
   # Retro-fixing of un-backward-compatible time format
   
   sub unsqltime {
       my $timestamp=shift;
       if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
           $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,
                                'hours'=>$4,'minutes'=>$5,'seconds'=>$6,'dlsav'=>-1);
       }
       return $timestamp;
   }
   
   
 1;  1;
   
Removed from v.1.8  
changed lines
  Added in v.1.41

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>