Diff for /loncom/interface/lonmysql.pm between versions 1.11 and 1.24

version 1.11, 2003/03/17 18:35:51 version 1.24, 2004/08/20 01:27:05
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);
   
   my $mysqluser;
   my $mysqlpassword;
   
   sub set_mysql_user_and_password {
       # If we are running under Apache and LONCAPA, use the LON-CAPA 
       # user and password.  Otherwise...? ? ? ?
       ($mysqluser,$mysqlpassword) = @_;
       if (! defined($mysqluser) || ! defined($mysqlpassword)) {
           if (! eval 'require Apache::lonnet();') {
               $mysqluser = 'www';
               $mysqlpassword = $Apache::lonnet::perlvar{'lonSqlAccess'};
           } else {
               $mysqluser = '';
               $mysqlpassword = '';
           }
       }
   }
   
 ######################################################################  ######################################################################
 ######################################################################  ######################################################################
Line 328  connection is established. Line 346  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:loncapa",$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 348  sub connect_to_db { Line 368  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 {
       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;
   }
   
   ###############################
   
   =pod
   
 =item &disconnect_from_db()  =item &disconnect_from_db()
   
 Inputs: none.  Inputs: none.
Line 530  sub update_table_info { Line 580  sub update_table_info {
     $debugstring = "Retrieved table info for $tablename";      $debugstring = "Retrieved table info for $tablename";
     return 1;      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 ();
       }
   }
   
 ###############################  ###############################
   
Line 538  sub update_table_info { Line 609  sub update_table_info {
 =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.
   
 Input formats:  =cut
   
   ###############################
   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 572  Input formats: Line 675  Input formats:
   
     }      }
   
 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
Line 660  sub create_table { Line 761  sub create_table {
         $request.="COMMENT = 'temporary' ";          $request.="COMMENT = 'temporary' ";
     }       } 
     $request .= "TYPE=MYISAM";      $request .= "TYPE=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";  
         return undef;  
     }  
     #  
     # Set up the internal bookkeeping  
     #############################################  
     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;  
 }  }
   
 ###############################  ###############################
Line 806  sub store_row { Line 892  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/,$//;
       $dbh->do($request);
       if ($dbh->err) {
           $errorstring = 'Attempted '.$/.$request.$/.'Got error '.$dbh->errstr();
           return undef;
       }
       return 1;
   }
   
   
 ###############################  ###############################
   
 =pod  =pod
Line 883  sub tables_in_db { Line 1021  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) {      $sth->execute();
         $errorstring = "$dbh ATTEMPTED:\n".'SHOW TABLES'.      my $aref = $sth->fetchall_arrayref;
       if ($sth->err()) {
           $errorstring = 
               "$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'.
             "\nRESULTING ERROR:\n".$sth->errstr;              "\nRESULTING ERROR:\n".$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 973  sub remove_from_table { Line 1113  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
   }
   
   
   
   
   # ---------------------------- 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.11  
changed lines
  Added in v.1.24


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