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

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

version 1.4, 2002/08/05 12:43:18 version 1.9, 2003/03/13 19:08:52
Line 71  To create a table, you need a descriptio Line 71  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 231  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 327  sub connect_to_db { Line 332  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;
Line 359  sub disconnect_from_db { Line 367  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 424  sub get_debug { Line 435  sub get_debug {
   
 =pod  =pod
   
 =item &update_table_info($table_id)  =item &update_table_info()
   
 Inputs: table id  Inputs: table id
   
Line 481  sub update_table_info { Line 492  sub update_table_info {
     # Determine the column order      # Determine the column order
     #      #
     $db_command = "DESCRIBE $tablename";      $db_command = "DESCRIBE $tablename";
     my $sth = $dbh->prepare($db_command);      $sth = $dbh->prepare($db_command);
     $sth->execute();      $sth->execute();
     if ($sth->err) {      if ($sth->err) {
         $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".          $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
Line 504  sub update_table_info { Line 515  sub update_table_info {
   
 =pod  =pod
   
 =item &create_table  =item &create_table()
   
 Inputs:   Inputs: 
     table description      table description
Line 513  Input formats: Line 524  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,
             }                    },
             colB  => { .. }                      { name => 'colB',
             colZ  => { .. }                        ...
         },                    },
         column_order => [ colA, colB, ..., colZ],                      { name => 'colC',
                         ...
                     },
           ],
           '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 540  sub create_table { Line 566  sub 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 $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'}) =~ /(enum|set)/) { # 'enum' or 'set'
             $col_des.=$column." ".$coldata->{'type'}."('".              $col_des.=$column." ".$coldata->{'type'}."('".
                 join("', '",@{$coldata->{'values'}})."')";                  join("', '",@{$coldata->{'values'}})."')";
Line 570  sub create_table { Line 602  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 ('KEY','INDEX') {
           if (exists($table_des->{$_})) {
               my $text = $_.' ';
               if (exists($table_des->{$_}->{'name'})) {
                   $text .=$table_des->{$_}->{'name'};
               }
               $text .= ' ('.join(',',@{$table_des->{$_}->{'columns'}}).')';
               push (@Columns,$text);
           }
       }
       foreach ('UNIQUE','FULLTEXT') {
           if (exists($table_des->{$_})) {
               my $text = $_.' ';
               if (exists($table_des->{$_}->{'index'}) &&
                   $table_des->{$_}->{'index'} eq 'yes') {
                   $text .= 'INDEX ';
               }
               if (exists($table_des->{$_}->{'name'})) {
                   $text .=$table_des->{$_}->{'name'};
               }
               $text .= ' ('.join(',',@{$table_des->{$_}->{'columns'}}).')';
               push (@Columns,$text);
           }
     }      }
     $request .= "(".join(", ",@Columns).") ";      $request .= "(".join(", ",@Columns).") ";
     unless($table_des->{'permanent'} eq 'yes') {      unless($table_des->{'permanent'} eq 'yes') {
Line 600  sub create_table { Line 657  sub create_table {
   
 =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 609  Used internally to prevent table name co Line 666  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 623  sub get_new_table_id { Line 679  sub get_new_table_id {
   
 =pod  =pod
   
 =item &get_rows  =item &get_rows()
   
 Inputs: $table_id,$condition  Inputs: $table_id,$condition
   
Line 646  sub get_rows { Line 702  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 657  sub get_rows { Line 719  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 669  sub get_rows { Line 726  sub get_rows {
   
 =pod  =pod
   
 =item &store_row  =item &store_row()
   
 Inputs: table id, row data  Inputs: table id, row data
   
Line 711  sub store_row { Line 768  sub store_row {
         @Parameters = @$rowdata;          @Parameters = @$rowdata;
     } elsif (ref($rowdata) eq 'HASH') {      } elsif (ref($rowdata) eq 'HASH') {
         foreach (@{$Tables{$tablename}->{'Col_order'}}) {          foreach (@{$Tables{$tablename}->{'Col_order'}}) {
             push(@Parameters,&Apache::lonnet::escape($rowdata->{$_}));              push(@Parameters,$rowdata->{$_});
         }          }
     }       } 
     $sth->execute(@Parameters);      $sth->execute(@Parameters);
Line 724  sub store_row { Line 781  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 738  Returns undef on error. Line 856  Returns undef on error.
 ###########################################  ###########################################
 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;');      my $sth=$dbh->prepare('SHOW TABLES');
     $sth->execute();      $sth->execute();
     if ($sth->err) {      if ($sth->err) {
         $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'.          $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'.
Line 758  sub tables_in_db { Line 876  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 781  sub translate_id { Line 899  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 797  sub check_table { Line 917  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 808  sub check_table { Line 928  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 '.$dbh->quote($column).
           " LIKE BINARY ".$dbh->quote($value);
       my $sth = $dbh->prepare($command); 
       $sth->execute();
       if ($sth->err) {
           $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
           return undef;
       }
       my $rows = $sth->rows;
       return $rows;
   }
   
   
 1;  1;
   
 __END__;  __END__;
   
   =pod
   
   =back
   
   =cut
Removed from v.1.4  
changed lines
  Added in v.1.9

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