Diff for /loncom/interface/lonmysql.pm between versions 1.9 and 1.16

version 1.9, 2003/03/13 19:08:52 version 1.16, 2003/12/26 19:12:51
Line 32  package Apache::lonmysql; Line 32  package Apache::lonmysql;
 use strict;  use strict;
 use DBI;  use DBI;
 use Apache::lonnet();  use Apache::lonnet();
   use POSIX qw(strftime mktime);
   
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
Line 348  sub connect_to_db { Line 350  sub connect_to_db {
   
 =pod  =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 {
       my $connection;
       if (! ($connection = DBI->connect("DBI:mysql:loncapa","www",
                                         $Apache::lonnet::perlvar{'lonSqlAccess'},
                                         { RaiseError=>0,PrintError=>0}))) {
           return 0;
       }
       undef($connection);
       return 1;
   }
   
   ###############################
   
   =pod
   
 =item &disconnect_from_db()  =item &disconnect_from_db()
   
 Inputs: none.  Inputs: none.
Line 396  sub number_of_rows { Line 425  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 539  Input formats: Line 588  Input formats:
                   },                    },
         ],          ],
         'PRIMARY KEY' => (index_col_name,...),          'PRIMARY KEY' => (index_col_name,...),
          KEY => { name => 'idx_name',            KEY => [{ name => 'idx_name', 
                   columns => (col1,col2,..),},                    columns => (col1,col2,..),},],
          INDEX => { name => 'idx_name',            INDEX => [{ name => 'idx_name', 
                     columns => (col1,col2,..),},                      columns => (col1,col2,..),},],
          UNIQUE => { index => 'yes',           UNIQUE => [{ index => 'yes',
                      name => 'idx_name',                       name => 'idx_name',
                      columns => (col1,col2,..),},                       columns => (col1,col2,..),},],
          FULLTEXT => { index => 'yes',           FULLTEXT => [{ index => 'yes',
                        name => 'idx_name',                         name => 'idx_name',
                        columns => (col1,col2,..),},                         columns => (col1,col2,..),},],
   
     }      }
   
Line 606  sub create_table { Line 655  sub create_table {
         push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}})          push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}})
               .')');                .')');
     }      }
     foreach ('KEY','INDEX') {      #
         if (exists($table_des->{$_})) {      foreach my $indextype ('KEY','INDEX') {
             my $text = $_.' ';          next if (!exists($table_des->{$indextype}));
             if (exists($table_des->{$_}->{'name'})) {          foreach my $indexdescription (@{$table_des->{$indextype}}) {
                 $text .=$table_des->{$_}->{'name'};              my $text = $indextype.' ';
               if (exists($indexdescription->{'name'})) {
                   $text .=$indexdescription->{'name'};
             }              }
             $text .= ' ('.join(',',@{$table_des->{$_}->{'columns'}}).')';              $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
             push (@Columns,$text);              push (@Columns,$text);
         }          }
     }      }
     foreach ('UNIQUE','FULLTEXT') {      #
         if (exists($table_des->{$_})) {      foreach my $indextype ('UNIQUE','FULLTEXT') {
             my $text = $_.' ';          next if (! exists($table_des->{$indextype}));
             if (exists($table_des->{$_}->{'index'}) &&          foreach my $indexdescription (@{$table_des->{$indextype}}) {
                 $table_des->{$_}->{'index'} eq 'yes') {              my $text = $indextype.' ';
               if (exists($indexdescription->{'index'}) &&
                   $indexdescription->{'index'} eq 'yes') {
                 $text .= 'INDEX ';                  $text .= 'INDEX ';
             }              }
             if (exists($table_des->{$_}->{'name'})) {              if (exists($indexdescription->{'name'})) {
                 $text .=$table_des->{$_}->{'name'};                  $text .=$indexdescription->{'name'};
             }              }
             $text .= ' ('.join(',',@{$table_des->{$_}->{'columns'}}).')';              $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
             push (@Columns,$text);              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' ";
Line 956  sub remove_from_table { Line 1010  sub remove_from_table {
         $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
   }
   
   
   
   
   # ---------------------------- 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);
       }
       return $timestamp;
   }
   
   
 1;  1;
   

Removed from v.1.9  
changed lines
  Added in v.1.16


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.