File:  [LON-CAPA] / loncom / interface / lonmysql.pm
Revision 1.37: download - view: text, annotated - select for diffs
Wed Apr 11 22:37:17 2007 UTC (17 years ago) by albertel
Branches: MAIN
CVS tags: version_2_8_X, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, version_2_6_2, version_2_6_1, version_2_6_0, version_2_5_X, version_2_5_99_1, version_2_5_99_0, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_X, version_2_4_99_0, version_2_4_2, version_2_4_1, version_2_4_0, version_2_3_99_0, HEAD, GCI_1
- log spew

    1: # The LearningOnline Network with CAPA
    2: # MySQL utility functions
    3: #
    4: # $Id: lonmysql.pm,v 1.37 2007/04/11 22:37:17 albertel Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ######################################################################
   29: 
   30: package Apache::lonmysql;
   31: 
   32: use strict;
   33: use DBI;
   34: use POSIX qw(strftime mktime);
   35: use Apache::lonnet;
   36: 
   37: my $mysqluser;
   38: my $mysqlpassword;
   39: my $mysqldatabase;
   40: my %db_config;
   41: 
   42: sub set_mysql_user_and_password {
   43:     # If we are running under Apache and LONCAPA, use the LON-CAPA 
   44:     # user and password.  Otherwise...? ? ? ?
   45:     my ($input_mysqluser,$input_mysqlpassword,$input_mysqldatabase) = @_;
   46:     if (! defined($mysqldatabase)) {
   47:         $mysqldatabase = 'loncapa';
   48:     }
   49:     if (defined($input_mysqldatabase)) {
   50:         $mysqldatabase = $input_mysqldatabase;
   51:     }
   52:     if (! defined($mysqluser) || ! defined($mysqlpassword)) {
   53:         if (! eval 'require Apache::lonnet();') {
   54:             $mysqluser = 'www';
   55:             $mysqlpassword = $Apache::lonnet::perlvar{'lonSqlAccess'};
   56:         } else {
   57:             $mysqluser = '';
   58:             $mysqlpassword = '';
   59:         }
   60:     }
   61:     if (defined($input_mysqluser)) {
   62:         $mysqluser = $input_mysqluser;
   63:     } 
   64:     if (defined($input_mysqlpassword)) {
   65:         $mysqlpassword = $input_mysqlpassword;
   66:     }
   67: }
   68: 
   69: ######################################################################
   70: ######################################################################
   71: 
   72: =pod 
   73: 
   74: =head1 Name
   75: 
   76: lonmysql - LONCAPA MySQL utility functions
   77: 
   78: =head1 Synopsis
   79: 
   80: lonmysql contains utility functions to make accessing the mysql loncapa
   81: database easier.  
   82: 
   83: =head1 Description
   84: 
   85: lonmysql does its best to encapsulate all the database/table functions
   86: and provide a common interface.  The goal, however, is not to provide 
   87: a complete reimplementation of the DBI interface.  Instead we try to 
   88: make using mysql as painless as possible.
   89: 
   90: Each table has a numeric ID that is a parameter to most lonmysql
   91: functions.  The table id is returned by &create_table.  If you lose
   92: the table id, it is lost forever.  The table names in MySQL correspond
   93: to $env{'user.name'}.'_'.$env{'user.domain'}.'_'.$table_id. (With all
   94: non-word characters removed form user.name and user.domain) If the
   95: table id is non-numeric, it is assumed to be the full name of a table.
   96: If you pass the table id in a form, you MUST ensure that what you send
   97: to lonmysql is numeric, otherwise you are opening up all the tables in
   98: the MySQL database.
   99: 
  100: =over 4
  101: 
  102: =item Creating a table
  103: 
  104: To create a table, you need a description of its structure.  See the entry
  105: for &create_table for a description of what is needed.
  106: 
  107:  $table_id = &create_table({ 
  108:      id      => 'tableid',      # usually you will use the returned id
  109:      columns => (
  110:                  { name => 'id',
  111:                    type => 'INT',
  112:                    restrictions => 'NOT NULL',
  113:                    primary_key => 'yes',
  114:                    auto_inc    => 'yes'
  115:                    },
  116:                  { name => 'verbage',
  117:                    type => 'TEXT' },
  118:                  ),
  119:                        fulltext => [qw/verbage/],
  120:         });
  121: 
  122: The above command will create a table with two columns, 'id' and 'verbage'.
  123: 
  124: 'id' will be an integer which is autoincremented and non-null.
  125: 
  126: 'verbage' will be of type 'TEXT', which (conceivably) allows any length
  127: text string to be stored.  Depending on your intentions for this database,
  128: setting restrictions => 'NOT NULL' may help you avoid storing empty data.
  129: 
  130: the fulltext element sets up the 'verbage' column for 'FULLTEXT' searching.
  131: 
  132: 
  133: 
  134: =item Storing rows
  135: 
  136: Storing a row in a table requires calling &store_row($table_id,$data)
  137: 
  138: $data is either a hash reference or an array reference.  If it is an array
  139: reference, the data is passed as is (after being escaped) to the 
  140: "INSERT INTO <table> VALUES( ... )" SQL command.  If $data is a hash reference,
  141: the data will be placed into an array in the proper column order for the table
  142: and then passed to the database.
  143: 
  144: An example of inserting into the table created above is:
  145: 
  146: &store_row($table_id,[undef,'I am not a crackpot!']);
  147: 
  148: or equivalently,
  149: 
  150: &store_row($table_id,{ verbage => 'I am not a crackpot!'});
  151: 
  152: Since the above table was created with the first column ('id') as 
  153: autoincrement, providing a value is unnecessary even though the column was
  154: marked as 'NOT NULL'.
  155: 
  156: 
  157: 
  158: =item Retrieving rows
  159: 
  160: Retrieving rows requires calling get_rows:
  161: 
  162: @row = &Apache::lonmysql::get_rows($table_id,$condition)
  163: 
  164: This results in the query "SELECT * FROM <table> HAVING $condition".
  165: 
  166: @row = &Apache::lonmysql::get_rows($table_id,'id>20'); 
  167: 
  168: returns all rows with column 'id' greater than 20.
  169: 
  170: =back
  171: 
  172: =cut
  173: 
  174: ######################################################################
  175: ######################################################################
  176: =pod
  177: 
  178: =head1 Package Variables
  179: 
  180: =over 4
  181: 
  182: =cut
  183: 
  184: ##################################################
  185: ##################################################
  186: 
  187: =pod
  188: 
  189: =item %Tables
  190: 
  191: Holds information regarding the currently open connections.  Each key
  192: in the %Tables hash will be a unique table key.  The value associated 
  193: with a key is a hash reference.  Most values are initialized when the 
  194: table is created.
  195: 
  196: The following entries are allowed in the hash reference:
  197: 
  198: =over 4
  199: 
  200: =item Name
  201: 
  202: Table name.
  203: 
  204: =item Type            
  205: 
  206: The type of table, typically MyISAM.
  207: 
  208: =item Row_format
  209: 
  210: Describes how rows should be stored in the table.  DYNAMIC or STATIC.
  211: 
  212: =item Create_time
  213: 
  214: The date of the tables creation.
  215: 
  216: =item Update_time
  217: 
  218: The date of the last modification of the table.
  219: 
  220: =item Check_time
  221: 
  222: Usually NULL. 
  223: 
  224: =item Avg_row_length
  225: 
  226: The average length of the rows.
  227: 
  228: =item Data_length
  229: 
  230: The length of the data stored in the table (bytes)
  231: 
  232: =item Max_data_length
  233: 
  234: The maximum possible size of the table (bytes).
  235: 
  236: =item Index_length
  237: 
  238: The length of the index for the table (bytes)
  239: 
  240: =item Data_free
  241: 
  242: I have no idea what this is.
  243: 
  244: =item Comment 
  245: 
  246: The comment associated with the table.
  247: 
  248: =item Rows
  249: 
  250: The number of rows in the table.
  251: 
  252: =item Auto_increment
  253: 
  254: The value of the next auto_increment field.
  255: 
  256: =item Create_options
  257: 
  258: I have no idea.
  259: 
  260: =item Col_order
  261: 
  262: an array reference which holds the order of columns in the table.
  263: 
  264: =item row_insert_sth 
  265: 
  266: The statement handler for row inserts.
  267: 
  268: =item row_replace_sth 
  269: 
  270: The statement handler for row inserts.
  271: 
  272: =back
  273: 
  274: Col_order and row_insert_sth are kept internally by lonmysql and are not
  275: part of the usual MySQL table information.
  276: 
  277: =cut
  278: 
  279: ##################################################
  280: ##################################################
  281: my %Tables;
  282: 
  283: ##################################################
  284: ##################################################
  285: =pod
  286: 
  287: =item $errorstring
  288: 
  289: Holds the last error.
  290: 
  291: =cut
  292: ##################################################
  293: ##################################################
  294: my $errorstring;
  295: 
  296: ##################################################
  297: ##################################################
  298: =pod
  299: 
  300: =item $debugstring
  301: 
  302: Describes current events within the package.
  303: 
  304: =cut
  305: ##################################################
  306: ##################################################
  307: my $debugstring;
  308: 
  309: ##################################################
  310: ##################################################
  311: 
  312: =pod
  313: 
  314: =item $dbh
  315: 
  316: The database handler; The actual connection to MySQL via the perl DBI.
  317: 
  318: =cut
  319: 
  320: ##################################################
  321: ##################################################
  322: my $dbh;
  323: 
  324: ##################################################
  325: ##################################################
  326: 
  327: # End of global variable declarations
  328: 
  329: =pod
  330: 
  331: =back
  332: 
  333: =cut
  334: 
  335: ######################################################################
  336: ######################################################################
  337: 
  338: =pod
  339: 
  340: =head1 Internals
  341: 
  342: =over 4
  343: 
  344: =cut
  345: 
  346: ######################################################################
  347: ######################################################################
  348: 
  349: =pod
  350: 
  351: =item &connect_to_db()
  352: 
  353: Inputs: none.  
  354: 
  355: Returns: undef on error, 1 on success.
  356: 
  357: Checks to make sure the database has been connected to.  If not, the
  358: connection is established.  
  359: 
  360: =cut
  361: 
  362: ###############################
  363: sub connect_to_db { 
  364:     return 1 if ($dbh);
  365:     if (! defined($mysqluser) || ! defined($mysqlpassword)) {
  366:         &set_mysql_user_and_password();
  367:     }
  368:     if (! ($dbh = DBI->connect("DBI:mysql:$mysqldatabase",$mysqluser,$mysqlpassword,
  369:                                { RaiseError=>0,PrintError=>0}))) {
  370:         $debugstring = "Unable to connect to loncapa database.";    
  371:         if (! defined($dbh)) {
  372:             $debugstring = "Unable to connect to loncapa database.";
  373:             $errorstring = "dbh was undefined.";
  374:         } elsif ($dbh->err) {
  375:             $errorstring = "Connection error: ".$dbh->errstr;
  376:         }
  377:         return undef;
  378:     }
  379:     $debugstring = "Successfully connected to loncapa database.";    
  380:     # Determine DB configuration
  381:     undef(%db_config);
  382:     my $sth = $dbh->prepare("SHOW VARIABLES");
  383:     $sth->execute();
  384:     if ($sth->err()) {
  385:         $debugstring = "Unable to retrieve db config variables";
  386:         return undef;
  387:     }
  388:     foreach my $row (@{$sth->fetchall_arrayref}) {
  389:         $db_config{$row->[0]} = $row->[1];
  390:     }
  391:     #&Apache::lonnet::logthis("MySQL configuration variables");
  392:     #while (my ($k,$v) = each(%db_config)) {
  393:     #    &Apache::lonnet::logthis("    '$k' => '$v'");
  394:     #}
  395:     #
  396:     return 1;
  397: }
  398: 
  399: ###############################
  400: 
  401: =pod
  402: 
  403: =item &verify_sql_connection()
  404: 
  405: Inputs: none.
  406: 
  407: Returns: 0 (failure) or 1 (success)
  408: 
  409: Checks to make sure the database can be connected to.  It does not
  410: initialize anything in the lonmysql package.
  411: 
  412: =cut
  413: 
  414: ###############################
  415: sub verify_sql_connection {
  416:     if (! defined($mysqluser) || ! defined($mysqlpassword)) {
  417:         &set_mysql_user_and_password();
  418:     }
  419:     my $connection;
  420:     if (! ($connection = DBI->connect("DBI:mysql:loncapa",
  421:                                       $mysqluser,$mysqlpassword,
  422:                                       { RaiseError=>0,PrintError=>0}))) {
  423:         return 0;
  424:     }
  425:     undef($connection);
  426:     return 1;
  427: }
  428: 
  429: ###############################
  430: 
  431: =pod
  432: 
  433: =item &disconnect_from_db()
  434: 
  435: Inputs: none.
  436: 
  437: Returns: Always returns 1.
  438: 
  439: Severs the connection to the mysql database.
  440: 
  441: =cut
  442: 
  443: ###############################
  444: sub disconnect_from_db { 
  445:     foreach (keys(%Tables)) {
  446:         # Supposedly, having statement handlers running around after the
  447:         # database connection has been lost will cause trouble.  So we 
  448:         # kill them off just to be sure.
  449:         if (exists($Tables{$_}->{'row_insert_sth'})) {
  450:             delete($Tables{$_}->{'row_insert_sth'});
  451:         }
  452:         if (exists($Tables{$_}->{'row_replace_sth'})) {
  453:             delete($Tables{$_}->{'row_replace_sth'});
  454:         }
  455:     }
  456:     $dbh->disconnect if ($dbh);
  457:     $debugstring = "Disconnected from database.";
  458:     $dbh = undef;
  459:     return 1;
  460: }
  461: 
  462: ###############################
  463: 
  464: =pod
  465: 
  466: =item &number_of_rows()
  467: 
  468: Input: table identifier
  469: 
  470: Returns: the number of rows in the given table, undef on error.
  471: 
  472: =cut
  473: 
  474: ###############################
  475: sub number_of_rows { 
  476:     my ($table_id) = @_;
  477:     return undef if (! defined(&connect_to_db()));
  478:     return undef if (! defined(&update_table_info($table_id)));
  479:     return $Tables{&translate_id($table_id)}->{'Rows'};
  480: }
  481: ###############################
  482: 
  483: =pod
  484: 
  485: =item &get_dbh()
  486: 
  487: Input: nothing
  488: 
  489: Returns: the database handler, or undef on error.
  490: 
  491: This routine allows the programmer to gain access to the database handler.
  492: Be careful.
  493: 
  494: =cut
  495: 
  496: ###############################
  497: sub get_dbh { 
  498:     return undef if (! defined(&connect_to_db()));
  499:     return $dbh;
  500: }
  501: 
  502: ###############################
  503: 
  504: =pod
  505: 
  506: =item &get_error()
  507: 
  508: Inputs: none.
  509: 
  510: Returns: The last error reported.
  511: 
  512: =cut
  513: 
  514: ###############################
  515: sub get_error {
  516:     return $errorstring;
  517: }
  518: 
  519: ###############################
  520: 
  521: =pod
  522: 
  523: =item &get_debug()
  524: 
  525: Inputs: none.
  526: 
  527: Returns: A string describing the internal state of the lonmysql package.
  528: 
  529: =cut
  530: 
  531: ###############################
  532: sub get_debug {
  533:     return $debugstring;
  534: }
  535: 
  536: ###############################
  537: 
  538: =pod
  539: 
  540: =item &update_table_info()
  541: 
  542: Inputs: table id
  543: 
  544: Returns: undef on error, 1 on success.
  545: 
  546: &update_table_info updates the %Tables hash with current information about
  547: the given table.  
  548: 
  549: The default MySQL table status fields are:
  550: 
  551:    Name             Type            Row_format
  552:    Max_data_length  Index_length    Data_free
  553:    Create_time      Update_time     Check_time
  554:    Avg_row_length   Data_length     Comment 
  555:    Rows             Auto_increment  Create_options
  556: 
  557: Additionally, "Col_order" is updated as well.
  558: 
  559: =cut
  560: 
  561: ###############################
  562: sub update_table_info { 
  563:     my ($table_id) = @_;
  564:     return undef if (! defined(&connect_to_db()));
  565:     my $table_status = &check_table($table_id);
  566:     return undef if (! defined($table_status));
  567:     if (! $table_status) {
  568:         $errorstring = "table $table_id does not exist.";
  569:         return undef;
  570:     }
  571:     my $tablename = &translate_id($table_id);
  572:     #
  573:     # Get MySQLs table status information.
  574:     #
  575:     my $db_command = "SHOW TABLE STATUS FROM loncapa LIKE '$tablename'";
  576:     my $sth = $dbh->prepare($db_command);
  577:     $sth->execute();
  578:     if ($sth->err) {
  579:         $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
  580:             $sth->errstr;
  581:         &disconnect_from_db();
  582:         return undef;
  583:     }
  584:     my @column_name = @{$sth->{NAME}};
  585:     #
  586:     my @info=$sth->fetchrow_array;
  587:     for (my $i=0;$i<= $#info ; $i++) {
  588:         if ($column_name[$i] =~ /^(Create_|Update_|Check_)time$/) {
  589:             $Tables{$tablename}->{$column_name[$i]}= 
  590:                 &unsqltime($info[$i]);
  591:         } else {
  592:             $Tables{$tablename}->{$column_name[$i]}= $info[$i];
  593:         }
  594:     }
  595:     #
  596:     # Determine the column order
  597:     #
  598:     $db_command = "DESCRIBE $tablename";
  599:     $sth = $dbh->prepare($db_command);
  600:     $sth->execute();
  601:     if ($sth->err) {
  602:         $errorstring = "$dbh ATTEMPTED:\n".$db_command."\nRESULTING ERROR:\n".
  603:             $sth->errstr;
  604:         &disconnect_from_db();
  605:         return undef;
  606:     }
  607:     my $aref=$sth->fetchall_arrayref;
  608:     $Tables{$tablename}->{'Col_order'}=[]; # Clear values.
  609:     # The values we want are the 'Field' entries, the first column.
  610:     for (my $i=0;$i< @$aref ; $i++) {
  611:         push @{$Tables{$tablename}->{'Col_order'}},$aref->[$i]->[0];
  612:     }
  613:     #
  614:     $debugstring = "Retrieved table info for $tablename";
  615:     return 1;
  616: }
  617: 
  618: ###############################
  619: 
  620: =pod
  621: 
  622: =item &table_information()
  623: 
  624: Inputs: table id
  625: 
  626: Returns: hash with the table status
  627: 
  628: =cut
  629: 
  630: ###############################
  631: sub table_information {
  632:     my $table_id=shift;
  633:     if (&update_table_info($table_id)) {
  634: 	return %{$Tables{$table_id}};
  635:     } else {
  636: 	return ();
  637:     }
  638: }
  639: 
  640: ###############################
  641: 
  642: =pod
  643: 
  644: =item &col_order()
  645: 
  646: Inputs: table id
  647: 
  648: Returns: array with column order
  649: 
  650: =cut
  651: 
  652: ###############################
  653: sub col_order {
  654:     my $table_id=shift;
  655:     if (&update_table_info($table_id)) {
  656: 	return @{$Tables{$table_id}->{'Col_order'}};
  657:     } else {
  658: 	return ();
  659:     }
  660: }
  661: 
  662: ###############################
  663: 
  664: =pod
  665: 
  666: =item &create_table()
  667: 
  668: Inputs: 
  669:     table description, see &build_table_creation_request
  670: Returns:
  671:     undef on error, table id on success.
  672: 
  673: =cut
  674: 
  675: ###############################
  676: sub create_table {
  677:     return undef if (!defined(&connect_to_db($dbh)));
  678:     my ($table_des)=@_;
  679:     my ($request,$table_id) = &build_table_creation_request($table_des);
  680:     #
  681:     # Execute the request to create the table
  682:     #############################################
  683:     my $count = $dbh->do($request);
  684:     if (! defined($count)) {
  685:         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
  686:             $dbh->errstr();
  687:         return undef;
  688:     }
  689:     my $tablename = &translate_id($table_id);
  690:     delete($Tables{$tablename}) if (exists($Tables{$tablename}));
  691:     return undef if (! defined(&update_table_info($table_id)));
  692:     $debugstring = "Created table $tablename at time ".time.
  693:         " with request\n$request";
  694:     return $table_id;
  695: }
  696: 
  697: ###############################
  698: 
  699: =pod
  700: 
  701: =item build_table_creation_request
  702: 
  703: Input: table description
  704: 
  705:     table description = {
  706:         permanent  => 'yes' or 'no',
  707:         columns => [
  708:                     { name         => 'colA',
  709:                       type         => mysql type,
  710:                       restrictions => 'NOT NULL' or empty,
  711:                       primary_key  => 'yes' or empty,
  712:                       auto_inc     => 'yes' or empty,
  713:                   },
  714:                     { name => 'colB',
  715:                       ...
  716:                   },
  717:                     { name => 'colC',
  718:                       ...
  719:                   },
  720:         ],
  721:         'PRIMARY KEY' => (index_col_name,...),
  722:          KEY => [{ name => 'idx_name', 
  723:                   columns => (col1,col2,..),},],
  724:          INDEX => [{ name => 'idx_name', 
  725:                     columns => (col1,col2,..),},],
  726:          UNIQUE => [{ index => 'yes',
  727:                      name => 'idx_name',
  728:                      columns => (col1,col2,..),},],
  729:          FULLTEXT => [{ index => 'yes',
  730:                        name => 'idx_name',
  731:                        columns => (col1,col2,..),},],
  732: 
  733:     }
  734: 
  735: Returns: scalar string containing mysql commands to create the table
  736: 
  737: =cut
  738: 
  739: ###############################
  740: sub build_table_creation_request {
  741:     my ($table_des)=@_;
  742:     #
  743:     # Build request to create table
  744:     ##################################
  745:     my @Columns;
  746:     my $col_des;
  747:     my $table_id;
  748:     if (exists($table_des->{'id'})) {
  749:         $table_id = $table_des->{'id'};
  750:     } else {
  751:         $table_id = &get_new_table_id();
  752:     }
  753:     my $tablename = &translate_id($table_id);
  754:     my $request = "CREATE TABLE IF NOT EXISTS ".$tablename." ";
  755:     foreach my $coldata (@{$table_des->{'columns'}}) {
  756:         my $column = $coldata->{'name'};
  757:         next if (! defined($column));
  758:         $col_des = '';
  759:         if (lc($coldata->{'type'}) =~ /(enum|set)/) { # 'enum' or 'set'
  760:             $col_des.=$column." ".$coldata->{'type'}."('".
  761:                 join("', '",@{$coldata->{'values'}})."')";
  762:         } else {
  763:             $col_des.=$column." ".$coldata->{'type'};
  764:             if (exists($coldata->{'size'})) {
  765:                 $col_des.="(".$coldata->{'size'}.")";
  766:             }
  767:         }
  768:         # Modifiers
  769:         if (exists($coldata->{'restrictions'})){
  770:             $col_des.=" ".$coldata->{'restrictions'};
  771:         }
  772:         if (exists($coldata->{'default'})) {
  773:             $col_des.=" DEFAULT '".$coldata->{'default'}."'";
  774:         }
  775:         $col_des.=' AUTO_INCREMENT' if (exists($coldata->{'auto_inc'}) &&
  776:                                         ($coldata->{'auto_inc'} eq 'yes'));
  777:         $col_des.=' PRIMARY KEY'    if (exists($coldata->{'primary_key'}) &&
  778:                                         ($coldata->{'primary_key'} eq 'yes'));
  779:     } continue {
  780:         # skip blank items.
  781:         push (@Columns,$col_des) if ($col_des ne '');
  782:     }
  783:     if (exists($table_des->{'PRIMARY KEY'})) {
  784:         push (@Columns,'PRIMARY KEY ('.join(',',@{$table_des->{'PRIMARY KEY'}})
  785:               .')');
  786:     }
  787:     #
  788:     foreach my $indextype ('KEY','INDEX') {
  789:         next if (!exists($table_des->{$indextype}));
  790:         foreach my $indexdescription (@{$table_des->{$indextype}}) {
  791:             my $text = $indextype.' ';
  792:             if (exists($indexdescription->{'name'})) {
  793:                 $text .=$indexdescription->{'name'};
  794:             }
  795:             $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
  796:             push (@Columns,$text);
  797:         }
  798:     }
  799:     #
  800:     foreach my $indextype ('UNIQUE','FULLTEXT') {
  801:         next if (! exists($table_des->{$indextype}));
  802:         foreach my $indexdescription (@{$table_des->{$indextype}}) {
  803:             my $text = $indextype.' ';
  804:             if (exists($indexdescription->{'index'}) &&
  805:                 $indexdescription->{'index'} eq 'yes') {
  806:                 $text .= 'INDEX ';
  807:             }
  808:             if (exists($indexdescription->{'name'})) {
  809:                 $text .=$indexdescription->{'name'};
  810:             }
  811:             $text .= ' ('.join(',',@{$indexdescription->{'columns'}}).')';
  812:             push (@Columns,$text);
  813:         }
  814:     }
  815:     #
  816:     $request .= "(".join(", ",@Columns).") ";
  817:     unless($table_des->{'permanent'} eq 'yes') {
  818:         $request.="COMMENT = 'temporary' ";
  819:     } 
  820:     $request .= "TYPE=MYISAM";
  821:     return $request,$table_id;
  822: }
  823: 
  824: ###############################
  825: 
  826: =pod
  827: 
  828: =item &get_table_prefix()
  829: 
  830: returns the cleaned version of user.name and user.domain for us in table names
  831: 
  832: =cut
  833: 
  834: ###############################
  835: sub get_table_prefix {
  836:     my $clean_name   = $env{'user.name'};
  837:     my $clean_domain = $env{'user.domain'};
  838:     $clean_name =~ s/\W//g;
  839:     $clean_domain =~ s/\W//g;
  840:     return $clean_name.'_'.$clean_domain.'_';
  841: }
  842: 
  843: ###############################
  844: 
  845: =pod
  846: 
  847: =item &get_new_table_id()
  848: 
  849: Used internally to prevent table name collisions.
  850: 
  851: =cut
  852: 
  853: ###############################
  854: sub get_new_table_id {
  855:     my $newid = 0;
  856:     my @tables = &tables_in_db();
  857:     my $prefix = &get_table_prefix();
  858:     foreach (@tables) {
  859:         if (/^\Q$prefix\E(\d+)$/) {
  860:             $newid = $1 if ($1 > $newid);
  861:         }
  862:     }
  863:     return ++$newid;
  864: }
  865: 
  866: ###############################
  867: 
  868: =pod
  869: 
  870: =item &get_rows()
  871: 
  872: Inputs: $table_id,$condition
  873: 
  874: Returns: undef on error, an array ref to (array of) results on success.
  875: 
  876: Internally, this function does a 'SELECT * FROM table WHERE $condition'.
  877: $condition = 'id>0' will result in all rows where column 'id' has a value
  878: greater than 0 being returned.
  879: 
  880: =cut
  881: 
  882: ###############################
  883: sub get_rows {
  884:     my ($table_id,$condition) = @_;
  885:     return undef if (! defined(&connect_to_db()));
  886:     my $table_status = &check_table($table_id);
  887:     return undef if (! defined($table_status));
  888:     if (! $table_status) {
  889:         $errorstring = "table $table_id does not exist.";
  890:         return undef;
  891:     }
  892:     my $tablename = &translate_id($table_id);
  893:     my $request;
  894:     if (defined($condition) && $condition ne '') {
  895:         $request = 'SELECT * FROM '.$tablename.' WHERE '.$condition;
  896:     } else {
  897:         $request = 'SELECT * FROM '.$tablename;
  898:         $condition = 'no condition';
  899:     }
  900:     my $sth=$dbh->prepare($request);
  901:     $sth->execute();
  902:     if ($sth->err) {
  903:         $errorstring = "$dbh ATTEMPTED:\n".$request."\nRESULTING ERROR:\n".
  904:             $sth->errstr;
  905:         $debugstring = "Failed to get rows matching $condition";
  906:         return undef;
  907:     }
  908:     $debugstring = "Got rows matching $condition";
  909:     my @Results = @{$sth->fetchall_arrayref};
  910:     return @Results;
  911: }
  912: 
  913: ###############################
  914: 
  915: =pod
  916: 
  917: =item &store_row()
  918: 
  919: Inputs: table id, row data
  920: 
  921: returns undef on error, 1 on success.
  922: 
  923: =cut
  924: 
  925: ###############################
  926: sub store_row {
  927:     my ($table_id,$rowdata) = @_;
  928:     # 
  929:     return undef if (! defined(&connect_to_db()));
  930:     my $table_status = &check_table($table_id);
  931:     return undef if (! defined($table_status));
  932:     if (! $table_status) {
  933:         $errorstring = "table $table_id does not exist.";
  934:         return undef;
  935:     }
  936:     #
  937:     my $tablename = &translate_id($table_id);
  938:     #
  939:     my $sth;
  940:     if (exists($Tables{$tablename}->{'row_insert_sth'})) {
  941:         $sth = $Tables{$tablename}->{'row_insert_sth'};
  942:     } else {
  943:         # Build the insert statement handler
  944:         return undef if (! defined(&update_table_info($table_id)));
  945:         my $insert_request = 'INSERT INTO '.$tablename.' VALUES(';
  946:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
  947:             $insert_request.="?,";
  948:         }
  949:         chop $insert_request;
  950:         $insert_request.=")";
  951:         $sth=$dbh->prepare($insert_request);
  952:         $Tables{$tablename}->{'row_insert_sth'}=$sth;
  953:     }
  954:     my @Parameters; 
  955:     if (ref($rowdata) eq 'ARRAY') {
  956:         @Parameters = @$rowdata;
  957:     } elsif (ref($rowdata) eq 'HASH') {
  958:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
  959:             push(@Parameters,$rowdata->{$_});
  960:         }
  961:     } 
  962:     $sth->execute(@Parameters);
  963:     if ($sth->err) {
  964:         $errorstring = "$dbh ATTEMPTED insert @Parameters RESULTING ERROR:\n".
  965:             $sth->errstr;
  966:         return undef;
  967:     }
  968:     $debugstring = "Stored row.";    
  969:     return 1;
  970: }
  971: 
  972: 
  973: ###############################
  974: 
  975: =pod
  976: 
  977: =item &bulk_store_rows()
  978: 
  979: Inputs: table id, [columns],[[row data1].[row data2],...]
  980: 
  981: returns undef on error, 1 on success.
  982: 
  983: =cut
  984: 
  985: ###############################
  986: sub bulk_store_rows {
  987:     my ($table_id,$columns,$rows) = @_;
  988:     # 
  989:     return undef if (! defined(&connect_to_db()));
  990:     my $dbh = &get_dbh();
  991:     return undef if (! defined($dbh));
  992:     my $table_status = &check_table($table_id);
  993:     return undef if (! defined($table_status));
  994:     if (! $table_status) {
  995:         $errorstring = "table $table_id does not exist.";
  996:         return undef;
  997:     }
  998:     #
  999:     my $tablename = &translate_id($table_id);
 1000:     #
 1001:     my $request = 'INSERT IGNORE INTO '.$tablename.' ';
 1002:     if (defined($columns) && ref($columns) eq 'ARRAY') {
 1003:         $request .= join(',',@$columns).' ';
 1004:     }
 1005:     if (! defined($rows) || ref($rows) ne 'ARRAY') {
 1006:         $errorstring = "no input rows given.";
 1007:         return undef;
 1008:     }
 1009:     $request .= 'VALUES ';
 1010:     foreach my $row (@$rows) {
 1011:         # avoid doing row stuff here...
 1012:         $request .= '('.join(',',@$row).'),';
 1013:     }
 1014:     $request =~ s/,$//;
 1015:     # $debugstring = "Executed ".$/.$request; # commented out - this is big
 1016:     $dbh->do($request);
 1017:     if ($dbh->err) {
 1018:         $errorstring = 'Attempted '.$/.$request.$/.'Got error '.$dbh->errstr();
 1019:         return undef;
 1020:     }
 1021:     return 1;
 1022: }
 1023: 
 1024: 
 1025: ###############################
 1026: 
 1027: =pod
 1028: 
 1029: =item &replace_row()
 1030: 
 1031: Inputs: table id, row data
 1032: 
 1033: returns undef on error, 1 on success.
 1034: 
 1035: Acts like &store_row() but uses the 'REPLACE' command instead of 'INSERT'.
 1036: 
 1037: =cut
 1038: 
 1039: ###############################
 1040: sub replace_row {
 1041:     my ($table_id,$rowdata) = @_;
 1042:     # 
 1043:     return undef if (! defined(&connect_to_db()));
 1044:     my $table_status = &check_table($table_id);
 1045:     return undef if (! defined($table_status));
 1046:     if (! $table_status) {
 1047:         $errorstring = "table $table_id does not exist.";
 1048:         return undef;
 1049:     }
 1050:     #
 1051:     my $tablename = &translate_id($table_id);
 1052:     #
 1053:     my $sth;
 1054:     if (exists($Tables{$tablename}->{'row_replace_sth'})) {
 1055:         $sth = $Tables{$tablename}->{'row_replace_sth'};
 1056:     } else {
 1057:         # Build the insert statement handler
 1058:         return undef if (! defined(&update_table_info($table_id)));
 1059:         my $replace_request = 'REPLACE INTO '.$tablename.' VALUES(';
 1060:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
 1061:             $replace_request.="?,";
 1062:         }
 1063:         chop $replace_request;
 1064:         $replace_request.=")";
 1065:         $sth=$dbh->prepare($replace_request);
 1066:         $Tables{$tablename}->{'row_replace_sth'}=$sth;
 1067:     }
 1068:     my @Parameters; 
 1069:     if (ref($rowdata) eq 'ARRAY') {
 1070:         @Parameters = @$rowdata;
 1071:     } elsif (ref($rowdata) eq 'HASH') {
 1072:         foreach (@{$Tables{$tablename}->{'Col_order'}}) {
 1073:             push(@Parameters,$rowdata->{$_});
 1074:         }
 1075:     } 
 1076:     $sth->execute(@Parameters);
 1077:     if ($sth->err) {
 1078:         $errorstring = "$dbh ATTEMPTED replace @Parameters RESULTING ERROR:\n".
 1079:             $sth->errstr;
 1080:         return undef;
 1081:     }
 1082:     $debugstring = "Stored row.";    
 1083:     return 1;
 1084: }
 1085: 
 1086: ###########################################
 1087: 
 1088: =pod
 1089: 
 1090: =item &tables_in_db()
 1091: 
 1092: Returns a list containing the names of all the tables in the database.
 1093: Returns undef on error.
 1094: 
 1095: =cut
 1096: 
 1097: ###########################################
 1098: sub tables_in_db {
 1099:     return undef if (!defined(&connect_to_db()));
 1100:     my $sth=$dbh->prepare('SHOW TABLES');
 1101:     $sth->execute();
 1102:     $sth->execute();
 1103:     my $aref = $sth->fetchall_arrayref;
 1104:     if ($sth->err()) {
 1105:         $errorstring = 
 1106:             "$dbh ATTEMPTED:\n".'fetchall_arrayref after SHOW TABLES'.
 1107:             "\nRESULTING ERROR:\n".$sth->errstr;
 1108:         return undef;
 1109:     }
 1110:     my @table_list;
 1111:     foreach (@$aref) {
 1112:         push(@table_list,$_->[0]);
 1113:     }
 1114:     $debugstring = "Got list of tables in DB: ".join(',',@table_list);
 1115:     return(@table_list);
 1116: }
 1117: 
 1118: ###########################################
 1119: 
 1120: =pod
 1121: 
 1122: =item &translate_id()
 1123: 
 1124: Used internally to translate a numeric table id into a MySQL table name.
 1125: If the input $id contains non-numeric characters it is assumed to have 
 1126: already been translated.
 1127: 
 1128: Checks are NOT performed to see if the table actually exists.
 1129: 
 1130: =cut
 1131: 
 1132: ###########################################
 1133: sub translate_id {
 1134:     my $id = shift;
 1135:     # id should be a digit.  If it is not a digit we assume the given id
 1136:     # is complete and does not need to be translated.
 1137:     return $id if ($id =~ /\D/);  
 1138:     return &get_table_prefix().$id;
 1139: }
 1140: 
 1141: ###########################################
 1142: 
 1143: =pod
 1144: 
 1145: =item &check_table()
 1146: 
 1147: Input: table id
 1148: 
 1149: Checks to see if the requested table exists.  Returns 0 (no), 1 (yes), or 
 1150: undef (error).
 1151: 
 1152: =cut
 1153: 
 1154: ###########################################
 1155: sub check_table {
 1156:     my $table_id = shift;
 1157:     return undef if (!defined(&connect_to_db()));
 1158:     #
 1159:     $table_id = &translate_id($table_id);
 1160:     my @Table_list = &tables_in_db();
 1161:     my $result = 0;
 1162:     foreach (@Table_list) {
 1163:         if ($_ eq $table_id) {
 1164:             $result = 1;
 1165:             last;
 1166:         }
 1167:     }
 1168:     # If it does not exist, make sure we do not have it listed in %Tables
 1169:     delete($Tables{$table_id}) if ((! $result) && exists($Tables{$table_id}));
 1170:     $debugstring = "check_table returned $result for $table_id";
 1171:     return $result;
 1172: }
 1173: 
 1174: ###########################################
 1175: 
 1176: =pod
 1177: 
 1178: =item &remove_from_table()
 1179: 
 1180: Input: $table_id, $column, $value
 1181: 
 1182: Returns: the number of rows deleted.  undef on error.
 1183: 
 1184: Executes a "delete from $tableid where $column like binary '$value'".
 1185: 
 1186: =cut
 1187: 
 1188: ###########################################
 1189: sub remove_from_table {
 1190:     my ($table_id,$column,$value) = @_;
 1191:     return undef if (!defined(&connect_to_db()));
 1192:     #
 1193:     $table_id = &translate_id($table_id);
 1194:     my $command = 'DELETE FROM '.$table_id.' WHERE '.$column.
 1195:         " LIKE BINARY ".$dbh->quote($value);
 1196:     my $sth = $dbh->prepare($command); 
 1197:     unless ($sth->execute()) {
 1198:         $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
 1199:         return undef;
 1200:     }
 1201:     $debugstring = $command;
 1202:     my $rows = $sth->rows;
 1203:     return $rows;
 1204: }
 1205: 
 1206: ###########################################
 1207: 
 1208: =pod
 1209: 
 1210: =item drop_table($table_id)
 1211: 
 1212: Issues a 'drop table if exists' command
 1213: 
 1214: =cut
 1215: 
 1216: ###########################################
 1217: 
 1218: sub drop_table {
 1219:     my ($table_id) = @_;
 1220:     return undef if (!defined(&connect_to_db()));
 1221:     #
 1222:     $table_id = &translate_id($table_id);
 1223:     my $command = 'DROP TABLE IF EXISTS '.$table_id;
 1224:     my $sth = $dbh->prepare($command); 
 1225:     $sth->execute();
 1226:     if ($sth->err) {
 1227:         $errorstring = "ERROR on execution of ".$command."\n".$sth->errstr;
 1228:         return undef;
 1229:     }
 1230:     $debugstring = $command;
 1231:     delete($Tables{$table_id}); # remove any knowledge of the table
 1232:     return 1; # if we got here there was no error, so return a 'true' value
 1233: }
 1234: 
 1235: ##########################################
 1236: 
 1237: =pod
 1238: 
 1239: =item fix_table_name 
 1240: 
 1241: Fixes a table name so that it will work with MySQL.
 1242: 
 1243: =cut
 1244: 
 1245: ##########################################
 1246: sub fix_table_name {
 1247:     my ($name) = @_;
 1248:     $name =~ s/^(\d+[eE]\d+)/_$1/;
 1249:     return $name;
 1250: }
 1251: 
 1252: 
 1253: # ---------------------------- convert 'time' format into a datetime sql format
 1254: sub sqltime {
 1255:     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
 1256: 	localtime(&unsqltime($_[0]));
 1257:     $mon++; $year+=1900;
 1258:     return "$year-$mon-$mday $hour:$min:$sec";
 1259: }
 1260: 
 1261: sub maketime {
 1262:     my %th=@_;
 1263:     return POSIX::mktime(($th{'seconds'},$th{'minutes'},$th{'hours'},
 1264:                           $th{'day'},$th{'month'}-1,
 1265:                           $th{'year'}-1900,0,0,$th{'dlsav'}));
 1266: }
 1267: 
 1268: 
 1269: #########################################
 1270: #
 1271: # Retro-fixing of un-backward-compatible time format
 1272: 
 1273: sub unsqltime {
 1274:     my $timestamp=shift;
 1275:     if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
 1276:         $timestamp=&maketime('year'=>$1,'month'=>$2,'day'=>$3,
 1277:                              'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
 1278:     }
 1279:     return $timestamp;
 1280: }
 1281: 
 1282: 
 1283: 1;
 1284: 
 1285: __END__;
 1286: 
 1287: =pod
 1288: 
 1289: =back
 1290: 
 1291: =cut

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