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

Diff for /loncom/interface/lonmysql.pm between versions 1.29 and 1.40

version 1.29, 2005/04/07 06:56:23 version 1.40, 2016/08/14 16:13:22
Line 37  use Apache::lonnet; Line 37  use Apache::lonnet;
 my $mysqluser;  my $mysqluser;
 my $mysqlpassword;  my $mysqlpassword;
 my $mysqldatabase;  my $mysqldatabase;
   my %db_config;
   
 sub set_mysql_user_and_password {  sub set_mysql_user_and_password {
     # If we are running under Apache and LONCAPA, use the LON-CAPA       # If we are running under Apache and LONCAPA, use the LON-CAPA 
Line 86  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 375  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;      return 1;
 }  }
   
Line 554  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 567  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++) {
         if ($tabledesc[$i] !~ /^(Create_|Update_|Check_)time$/) {          if ($column_name[$i] =~ /^(Create_|Update_|Check_)time$/) {
             $Tables{$tablename}->{$tabledesc[$i]}=               $Tables{$tablename}->{$column_name[$i]}= 
                 &unsqltime($info[$i]);                  &unsqltime($info[$i]);
         } else {          } else {
             $Tables{$tablename}->{$tabledesc[$i]}= $info[$i];              $Tables{$tablename}->{$column_name[$i]}= $info[$i];
         }          }
     }      }
     #      #
Line 802  sub build_table_creation_request { Line 817  sub build_table_creation_request {
     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;      return $request,$table_id;
 }  }
   
Line 810  sub build_table_creation_request { Line 825  sub build_table_creation_request {
   
 =pod  =pod
   
   =item &get_table_prefix()
   
   returns the cleaned version of user.name and user.domain for us in table names
   
   =cut
   
   ###############################
   sub get_table_prefix {
       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.'_';
   }
   
   ###############################
   
   =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 820  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 977  sub bulk_store_rows { Line 1012  sub bulk_store_rows {
         $request .= '('.join(',',@$row).'),';          $request .= '('.join(',',@$row).'),';
     }      }
     $request =~ s/,$//;      $request =~ s/,$//;
       # $debugstring = "Executed ".$/.$request; # commented out - this is big
     $dbh->do($request);      $dbh->do($request);
     if ($dbh->err) {      if ($dbh->err) {
         $errorstring = 'Attempted '.$/.$request.$/.'Got error '.$dbh->errstr();          $errorstring = 'Attempted '.$/.$request.$/.'Got error '.$dbh->errstr();
Line 1059  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
     $sth->execute();      if(!$have_read_tables) { 
     my $aref = $sth->fetchall_arrayref;       $dbh_sth=$dbh->prepare('SHOW TABLES');
     if ($sth->err()) {       $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 =           $errorstring = 
             "$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'.              "$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'.
             "\nRESULTING ERROR:\n".$sth->errstr;              "\nRESULTING ERROR:\n".$dbh_sth->errstr;
         return undef;          return undef;
     }      }
     my @table_list;      my @table_list;
Line 1099  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 1238  sub unsqltime { Line 1287  sub unsqltime {
     my $timestamp=shift;      my $timestamp=shift;
     if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {      if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
         $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,          $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,
                              'hours'=>$4,'minutes'=>$5,'seconds'=>$6);                               'hours'=>$4,'minutes'=>$5,'seconds'=>$6,'dlsav'=>-1);
     }      }
     return $timestamp;      return $timestamp;
 }  }
Removed from v.1.29  
changed lines
  Added in v.1.40

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