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

Diff for /loncom/interface/lonmysql.pm between versions 1.2 and 1.18

version 1.2, 2002/07/28 18:21:13 version 1.18, 2003/12/27 16:58:36
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 71  To create a table, you need a descriptio Line 73  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' },                     },
                 idx_verbage => { type => 'FULLTEXT',                   { name => 'verbage',
                                  target => 'verbage'                     type => 'TEXT' },
                                  }                   ),
             },                         fulltext => [qw/verbage/],
             column_order => [qw/id verbage idx_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 94  The above command will create a table wi Line 95  The above command will create a table wi
 text string to be stored.  Depending on your intentions for this database,  text string to be stored.  Depending on your intentions for this database,
 setting restrictions => 'NOT NULL' may help you avoid storing empty data.  setting restrictions => 'NOT NULL' may help you avoid storing empty data.
   
 'idx_verbage' sets up the 'verbage' column for 'FULLTEXT' searching.  the fulltext element sets up the 'verbage' column for 'FULLTEXT' searching.
   
   
   
Line 120  Since the above table was created with t Line 121  Since the above table was created with t
 autoincrement, providing a value is unnecessary even though the column was  autoincrement, providing a value is unnecessary even though the column was
 marked as 'NOT NULL'.  marked as 'NOT NULL'.
   
 In the future an array of arrays or hashes may be supported, but currently  
 the system only performs one insert at a time.  Given the nature of this   
 interface, transactions (locking of the table) are not supported.  
   
   
   
 =item Retrieving rows  =item Retrieving rows
Line 168  The following entries are allowed in the Line 165  The following entries are allowed in the
   
 =over 4  =over 4
   
 =item columns   =item Name
   
   Table name.
   
   =item Type            
   
   The type of table, typically MyISAM.
   
   =item Row_format
   
   Describes how rows should be stored in the table.  DYNAMIC or STATIC.
   
   =item Create_time
   
   The date of the tables creation.
   
   =item Update_time
   
   The date of the last modification of the table.
   
   =item Check_time
   
   Usually NULL. 
   
   =item Avg_row_length
   
   The average length of the rows.
   
 The columns information required by &create_table.  =item Data_length
   
 =item column_order  The length of the data stored in the table (bytes)
   
 Reference to an array containing the order of columns in the table.  =item Max_data_length
   
 =item table_info  The maximum possible size of the table (bytes).
   
 Set to the results of &get_table_info.  =item Index_length
   
 =item row_insert_sth  The length of the index for the table (bytes)
   
   =item Data_free
   
   I have no idea what this is.
   
   =item Comment 
   
   The comment associated with the table.
   
   =item Rows
   
   The number of rows in the table.
   
   =item Auto_increment
   
   The value of the next auto_increment field.
   
   =item Create_options
   
   I have no idea.
   
   =item Col_order
   
   an array reference which holds the order of columns in the table.
   
   =item row_insert_sth 
   
   The statement handler for row inserts.
   
   =item row_replace_sth 
   
 The statement handler for row inserts.  The statement handler for row inserts.
   
 =back  =back
   
   Col_order and row_insert_sth are kept internally by lonmysql and are not
   part of the usual MySQL table information.
   
 =cut  =cut
   
 ##################################################  ##################################################
Line 278  sub connect_to_db { Line 334  sub connect_to_db {
                                $Apache::lonnet::perlvar{'lonSqlAccess'},                                 $Apache::lonnet::perlvar{'lonSqlAccess'},
                                { RaiseError=>0,PrintError=>0}))) {                                 { RaiseError=>0,PrintError=>0}))) {
         $debugstring = "Unable to connect to loncapa database.";              $debugstring = "Unable to connect to loncapa database.";    
         if ($dbh->err) {          if (! defined($dbh)) {
               $debugstring = "Unable to connect to loncapa database.";
               $errorstring = "dbh was undefined.";
           } elsif ($dbh->err) {
             $errorstring = "Connection error: ".$dbh->errstr;              $errorstring = "Connection error: ".$dbh->errstr;
         }          }
         return undef;          return undef;
     }      }
     # The code below will let us switch to a different database.  
     # my $db_command = "USE $db;";  
     # my $sth = $dbh->prepare($db_command);  
     # $sth->execute();  
     # if ($sth->err) {  
     #     # Unable to use the database.  Interesting...  
     #     $dbh->disconnect;  
     #     return undef;  
     # }  
     $debugstring = "Successfully connected to loncapa database.";          $debugstring = "Successfully connected to loncapa database.";    
     return 1;      return 1;
 }  }
Line 300  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 319  sub disconnect_from_db { Line 396  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 334  sub disconnect_from_db { Line 414  sub disconnect_from_db {
   
 Input: table identifier  Input: table identifier
   
 Returns: the number of rows in the given table.  Returns: the number of rows in the given table, undef on error.
   
 =cut  =cut
   
 ###############################  ###############################
 sub number_of_rows {   sub number_of_rows { 
     my ($table_id) = @_;      my ($table_id) = @_;
     # Update the table information      return undef if (! defined(&connect_to_db()));
     my %Table_Info = %{&get_table_info($table_id)};      return undef if (! defined(&update_table_info($table_id)));
     # return the number of rows.      return $Tables{&translate_id($table_id)}->{'Rows'};
     if (defined(%Table_Info)) {  }
         return $Table_Info{'Rows'};  ###############################
     }  
     return undef;  =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 388  sub get_debug { Line 484  sub get_debug {
   
 =pod  =pod
   
 =item &get_table_info($table_id)  =item &update_table_info()
   
 Inputs: table id  Inputs: table id
   
 Returns: undef or a pointer to a hash of data about a table.  Returns: undef on error, 1 on success.
   
   &update_table_info updates the %Tables hash with current information about
   the given table.  
   
 &get_table_info returns all of the information it can about a table in the  The default MySQL table status fields are:
 form of a hash.  Currently the fields in the hash are:  
   
    Name             Type            Row_format     Name             Type            Row_format
    Max_data_length  Index_length    Data_free     Max_data_length  Index_length    Data_free
Line 403  form of a hash.  Currently the fields in Line 501  form of a hash.  Currently the fields in
    Avg_row_length   Data_length     Comment      Avg_row_length   Data_length     Comment 
    Rows             Auto_increment  Create_options     Rows             Auto_increment  Create_options
   
   Additionally, "Col_order" is updated as well.
   
 =cut  =cut
   
 ###############################  ###############################
 sub get_table_info {   sub update_table_info { 
     my ($table_id) = @_;      my ($table_id) = @_;
       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 $tablename = &translate_id($table_id);
     return undef if (! &check_table($table_id));      #
     my %tableinfo;      # Get MySQLs table status information.
       #
     my @tabledesc = qw/      my @tabledesc = qw/
         Name Type Row_format Rows Avg_row_length Data_length          Name Type Row_format Rows Avg_row_length Data_length
             Max_data_length Index_length Data_free Auto_increment               Max_data_length Index_length Data_free Auto_increment 
Line 419  sub get_table_info { Line 527  sub get_table_info {
     my $sth = $dbh->prepare($db_command);      my $sth = $dbh->prepare($db_command);
     $sth->execute();      $sth->execute();
     if ($sth->err) {      if ($sth->err) {
         # Unable to use the database.  Interesting...  
         $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".          $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
             $sth->errstr;              $sth->errstr;
         $dbh->disconnect;          &disconnect_from_db();
         return undef;          return undef;
     }      }
     #      #
     my @info=$sth->fetchrow_array;      my @info=$sth->fetchrow_array;
     for (my $i=0;$i<= $#info ; $i++) {      for (my $i=0;$i<= $#info ; $i++) {
         $tableinfo{$tabledesc[$i]}= $info[$i];          $Tables{$tablename}->{$tabledesc[$i]}= $info[$i];
       }
       #
       # Determine the column order
       #
       $db_command = "DESCRIBE $tablename";
       $sth = $dbh->prepare($db_command);
       $sth->execute();
       if ($sth->err) {
           $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
               $sth->errstr;
           &disconnect_from_db();
           return undef;
       }
       my $aref=$sth->fetchall_arrayref;
       $Tables{$tablename}->{'Col_order'}=[]; # Clear values.
       # The values we want are the 'Field' entries, the first column.
       for (my $i=0;$i< @$aref ; $i++) {
           push @{$Tables{$tablename}->{'Col_order'}},$aref->[$i]->[0];
     }      }
     #      #
     $debugstring = "Retrieved table info for $tablename";      $debugstring = "Retrieved table info for $tablename";
     return \%tableinfo;      return 1;
 }  }
   ###############################
   
   =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  =pod
   
 =item &create_table  =item &create_table()
   
 Inputs:   Inputs: 
     table description      table description
Line 448  Input formats: Line 593  Input formats:
   
     table description = {      table description = {
         permanent  => 'yes' or 'no',          permanent  => 'yes' or 'no',
         columns => {          columns => [
             colA => {                      { name         => 'colA',
                 type         => mysql type,                        type         => mysql type,
                 restrictions => 'NOT NULL' or empty,                        restrictions => 'NOT NULL' or empty,
                 primary_key  => 'yes' or empty,                        primary_key  => 'yes' or empty,
                 auto_inc     => 'yes' or empty,                        auto_inc     => 'yes' or empty,
                 target       => 'colB' (only if type eq 'FULLTEXT'),                    },
             }                      { name => 'colB',
             colB  => { .. }                        ...
             colZ  => { .. }                    },
         },                      { name => 'colC',
         column_order => [ colA, colB, ..., colZ],                        ...
                     },
           ],
           '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:
Line 469  Returns: Line 628  Returns:
   
 ###############################  ###############################
 sub create_table {  sub create_table {
     return undef if (!&connect_to_db($dbh));      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 $tableid = &get_new_table_id();      my $table_id;
     my $tablename = &translate_id($tableid);      if (exists($table_des->{'id'})) {
           $table_id = $table_des->{'id'};
       } else {
           $table_id = &get_new_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 $column (@{$table_des->{'column_order'}}) {      foreach my $coldata (@{$table_des->{'columns'}}) {
           my $column = $coldata->{'name'};
           next if (! defined($column));
         $col_des = '';          $col_des = '';
         my $coldata = $table_des->{'columns'}->{$column};          if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
         if (lc($coldata->{'type'}) eq 'fulltext') {  
             $col_des.='FULLTEXT '.$column." (".$coldata->{'target'}.")";  
             next; # Skip to the continue block and store the column data  
         } elsif (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'  
             $col_des.=$column." ".$coldata->{'type'}."('".              $col_des.=$column." ".$coldata->{'type'}."('".
                 join("', '",@{$coldata->{'values'}})."')";                  join("', '",@{$coldata->{'values'}})."')";
         } else {          } else {
Line 501  sub create_table { Line 663  sub create_table {
         if (exists($coldata->{'default'})) {          if (exists($coldata->{'default'})) {
             $col_des.=" DEFAULT '".$coldata->{'default'}."'";              $col_des.=" DEFAULT '".$coldata->{'default'}."'";
         }          }
         $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}));          $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
         $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}));                                          ($coldata->{'auto_inc'} eq 'yes'));
           $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}) &&
                                           ($coldata->{'primary_key'} eq 'yes'));
     } continue {      } continue {
         # 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->{'PRIMARY KEY'})) {
           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' ";
Line 517  sub create_table { Line 714  sub create_table {
     #############################################      #############################################
     my $count = $dbh->do($request);      my $count = $dbh->do($request);
     if (! defined($count)) {      if (! defined($count)) {
         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".          $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n";
         return undef;          return undef;
     }      }
     #      #
     # Set up the internal bookkeeping      # Set up the internal bookkeeping
     #############################################      #############################################
     delete($Tables{$tablename}) if (exists($Tables{$tablename}));      delete($Tables{$tablename}) if (exists($Tables{$tablename}));
     my @column_order_copy = @{$table_des->{'column_order'}};      return undef if (! defined(&update_table_info($table_id)));
     $Tables{$tablename} = {       $debugstring = "Created table $tablename at time ".time.
         columns      => $table_des->{'columns'},  
         column_order => $table_des->{'column_order'},  
         table_info   => &get_table_info($tableid),  
     };  
     $debugstring = "$dbh Created table $tablename at time ".time.  
         " with request\n$request";          " with request\n$request";
     return $tableid;      return $table_id;
 }  }
   
 ###############################  ###############################
   
 =pod  =pod
   
 =item &get_new_table_id  =item &get_new_table_id()
   
 Used internally to prevent table name collisions.  Used internally to prevent table name collisions.
   
Line 548  Used internally to prevent table name co Line 740  Used internally to prevent table name co
 ###############################  ###############################
 sub get_new_table_id {  sub get_new_table_id {
     my $newid = 0;      my $newid = 0;
     my $name_regex = '^'.$ENV{'user.name'}.'_'.$ENV{'user.domain'}."_(\d+)\$";  
     my @tables = &tables_in_db();      my @tables = &tables_in_db();
     foreach (@tables) {      foreach (@tables) {
         if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) {          if (/^$ENV{'user.name'}_$ENV{'user.domain'}_(\d+)$/) {
Line 562  sub get_new_table_id { Line 753  sub get_new_table_id {
   
 =pod  =pod
   
 =item &execute_db_command  =item &get_rows()
   
 Currently unimplemented  
   
 =cut  
   
 ###############################  
 sub execute_db_command {  
     my ($tablename,$command) = @_;  
     return 1;  
 }  
   
 ###############################  
   
 =pod  
   
 =item &get_rows  
   
 Inputs: $table_id,$condition  Inputs: $table_id,$condition
   
Line 593  greater than 0 being returned. Line 768  greater than 0 being returned.
 ###############################  ###############################
 sub get_rows {  sub get_rows {
     my ($table_id,$condition) = @_;      my ($table_id,$condition) = @_;
       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 $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 605  sub get_rows { Line 793  sub get_rows {
     }      }
     $debugstring = "Got rows matching $condition";      $debugstring = "Got rows matching $condition";
     my @Results = @{$sth->fetchall_arrayref};      my @Results = @{$sth->fetchall_arrayref};
     foreach my $row (@Results) {  
         for(my $i=0;$i<@$row;$i++) {  
             $row->[$i]=&Apache::lonnet::unescape($row->[$i]);  
         }  
     }  
     return @Results;      return @Results;
 }  }
   
Line 617  sub get_rows { Line 800  sub get_rows {
   
 =pod  =pod
   
 =item &store_row  =item &store_row()
   
 Inputs: table id, row data  Inputs: table id, row data
   
Line 628  returns undef on error, 1 on success. Line 811  returns undef on error, 1 on success.
 ###############################  ###############################
 sub store_row {  sub store_row {
     my ($table_id,$rowdata) = @_;      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 $tablename = &translate_id($table_id);
     my $table = $Tables{$tablename};      #
     my $sth;      my $sth;
     if (exists($table->{'row_insert_sth'})) {      if (exists($Tables{$tablename}->{'row_insert_sth'})) {
         $sth = $table->{'row_insert_sth'};          $sth = $Tables{$tablename}->{'row_insert_sth'};
     } else {      } else {
         # We need to build a statement handler          # Build the insert statement handler
           return undef if (! defined(&update_table_info($table_id)));
         my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';          my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
         foreach (@{$table->{'column_order'}}) {          foreach (@{$Tables{$tablename}->{'Col_order'}}) {
             # Skip the 'fulltext' columns.  
             next if (lc($table->{'columns'}->{$_}->{'type'}) eq 'fulltext');  
             $insert_request.="?,";              $insert_request.="?,";
         }          }
         chop $insert_request;          chop $insert_request;
         $insert_request.=")";          $insert_request.=")";
         $sth=$dbh->prepare($insert_request);          $sth=$dbh->prepare($insert_request);
           $Tables{$tablename}->{'row_insert_sth'}=$sth;
     }      }
     my @Parameters;       my @Parameters; 
     if (ref($rowdata) eq 'ARRAY') {      if (ref($rowdata) eq 'ARRAY') {
         @Parameters = @$rowdata;          @Parameters = @$rowdata;
     } elsif (ref($rowdata) eq 'HASH') {      } elsif (ref($rowdata) eq 'HASH') {
         foreach (@{$table->{'column_order'}}) {          foreach (@{$Tables{$tablename}->{'Col_order'}}) {
             # Is this appropriate?  Am I being presumptious? ACK!!!!!              push(@Parameters,$rowdata->{$_});
             next if (lc($table->{'columns'}->{$_}->{'type'}) eq 'fulltext');  
             push(@Parameters,&Apache::lonnet::escape($rowdata->{$_}));  
         }          }
     }       } 
     $sth->execute(@Parameters);      $sth->execute(@Parameters);
Line 665  sub store_row { Line 855  sub store_row {
     return 1;      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
   
 =item tables_in_db  =item &tables_in_db()
   
 Returns a list containing the names of all the tables in the database.  Returns a list containing the names of all the tables in the database.
 Returns undef on error.  Returns undef on error.
Line 678  Returns undef on error. Line 929  Returns undef on error.
   
 ###########################################  ###########################################
 sub tables_in_db {  sub tables_in_db {
     return undef if (! &connect_to_db()); # bail out if we cannot connect      return undef if (!defined(&connect_to_db()));
     my $sth=$dbh->prepare('SHOW TABLES;');      my $sth=$dbh->prepare('SHOW TABLES');
     $sth->execute();      $sth->execute();
     if ($sth->err) {      if ($sth->err) {
         $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'."\nRESULTING ERROR:\n".          $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'.
             $sth->errstr;              "\nRESULTING ERROR:\n".$sth->errstr;
         return undef;          return undef;
     }      }
     my $aref = $sth->fetchall_arrayref;      my $aref = $sth->fetchall_arrayref;
Line 699  sub tables_in_db { Line 950  sub tables_in_db {
   
 =pod  =pod
   
 =item &translate_id  =item &translate_id()
   
 Used internally to translate a numeric table id into a MySQL table name.  Used internally to translate a numeric table id into a MySQL table name.
 If the input $id contains non-numeric characters it is assumed to have   If the input $id contains non-numeric characters it is assumed to have 
Line 722  sub translate_id { Line 973  sub translate_id {
   
 =pod  =pod
   
 =item &check_table($id)  =item &check_table()
   
   Input: table id
   
 Checks to see if the requested table exists.  Returns 0 (no), 1 (yes), or   Checks to see if the requested table exists.  Returns 0 (no), 1 (yes), or 
 undef (error).  undef (error).
Line 732  undef (error). Line 985  undef (error).
 ###########################################  ###########################################
 sub check_table {  sub check_table {
     my $table_id = shift;      my $table_id = shift;
       return undef if (!defined(&connect_to_db()));
       #
     $table_id = &translate_id($table_id);      $table_id = &translate_id($table_id);
     return undef if (! &connect_to_db());  
     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 748  sub check_table { Line 1002  sub check_table {
     return $result;      return $result;
 }  }
   
   ###########################################
   
   =pod
   
   =item &remove_from_table()
   
   Input: $table_id, $column, $value
   
   Returns: the number of rows deleted.  undef on error.
   
   Executes a "delete from $tableid where $column like binary '$value'".
   
   =cut
   
   ###########################################
   sub remove_from_table {
       my ($table_id,$column,$value) = @_;
       return undef if (!defined(&connect_to_db()));
       #
       $table_id = &translate_id($table_id);
       my $command = 'DELETE FROM '.$table_id.' WHERE '.$column.
           " LIKE BINARY ".$dbh->quote($value);
       my $sth = $dbh->prepare($command); 
       unless ($sth->execute()) {
           $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
           return undef;
       }
       $debugstring = $command;
       my $rows = $sth->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;
   
 __END__;  __END__;
   
   =pod
   
   =back
   
   =cut
Removed from v.1.2  
changed lines
  Added in v.1.18

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