fixed seq qual length check

[biopieces.git] / code_perl / Maasha / SQL.pm

diff --git a/code_perl/Maasha/SQL.pm b/code_perl/Maasha/SQL.pm
index c7feeaac38a6541b9f498d551e1c069195f34728..9f273756ffc470c49f24e1f76287b4473dbe86dc 100644 (file)
--- a/code_perl/Maasha/SQL.pm
+++ b/code_perl/Maasha/SQL.pm
@@ -28,12 +28,13 @@ package Maasha::SQL;
 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 
 
+use warnings;
 use strict;
 use warnings;
 
 use DBI;
 use Data::Dumper;
-
+use Time::HiRes;
 use Maasha::Common;
 
 use vars qw( @ISA @EXPORT );
@@ -59,6 +60,21 @@ sub create_database
 }        
 
 
+sub delete_database
+{
+    my ( $database,
+         $user,
+         $password,
+       ) = @_;
+
+    die qq(ERROR: Protected database: "$database!\n" ) if $database =~/^(mysql|information_schema)$/i;
+    system( "mysqladmin drop $database --force --user=$user --password=$password > /dev/null 2>&1"  ) == 0 or
+    die qq(ERROR: Could not drop database "$database"!\n);
+
+    return;
+}        
+
+
 sub database_exists
 {
     # Martin A. Hansen, May 2008.
@@ -75,7 +91,7 @@ sub database_exists
 
     my ( @databases );
 
-    @databases = &list_databases( $user, $pass );
+    @databases = list_databases( $user, $pass );
 
     if ( grep /^$database$/i, @databases ) {
         return 1;
@@ -99,7 +115,7 @@ sub list_databases
 
     my ( @databases );
 
-    @databases = &Maasha::Common::run_and_return( "mysqlshow", "--user=$user --password=$pass" );
+    @databases = Maasha::Common::run_and_return( "mysqlshow", "--user=$user --password=$pass" );
 
     splice @databases, 0, 3;
 
@@ -123,7 +139,7 @@ sub request
     {
             $errstr = $DBI::errstr;
 
-            &disconnect( $dbh );
+            disconnect( $dbh );
             die qq(ERROR: $errstr, "SQL PREPARE ERROR" );
     }
     
@@ -131,7 +147,7 @@ sub request
     {
             $errstr = $DBI::errstr;
         
-            &disconnect( $dbh );
+            disconnect( $dbh );
             die qq(ERROR: $errstr, "SQL EXECUTE ERROR" );
     }
 
@@ -160,7 +176,7 @@ sub query_hash
     {
             $errstr = $DBI::errstr;
         
-            &disconnect( $dbh );
+            disconnect( $dbh );
             die qq(ERROR: $errstr, "SQL PREPARE ERROR" );
     }
     
@@ -168,7 +184,7 @@ sub query_hash
     {
             $errstr = $DBI::errstr;
         
-            &disconnect( $dbh );
+            disconnect( $dbh );
             die qq(ERROR: $errstr, "SQL EXECUTE ERROR" );
     }
     
@@ -180,7 +196,7 @@ sub query_hash
     {
             $errstr = $DBI::errstr;
         
-            &disconnect( $dbh );
+            disconnect( $dbh );
             die qq(ERROR: $errstr, "DATABASE RETRIEVE ERROR" );
     }
 
@@ -203,12 +219,11 @@ sub query_array
     # Returns a list.
 
     my ( $sth, $table, $errstr, @status );
-
     if ( not $sth = $dbh->prepare( $sql ) ) 
     {
             $errstr = $DBI::errstr;
 
-            &disconnect( $dbh );
+            disconnect( $dbh );
             die qq(ERROR: $errstr, "SQL PREPARE ERROR" );
     }
     
@@ -216,10 +231,10 @@ sub query_array
     {
             $errstr = $DBI::errstr;
         
-            &disconnect( $dbh );
+            disconnect( $dbh );
             die qq(ERROR: $errstr, "SQL EXECUTE ERROR" );
     }
-    
+
     if ( $table = $sth->fetchall_arrayref( $out ) )
     {
             return wantarray ? @{ $table } : $table;
@@ -228,7 +243,7 @@ sub query_array
     {
             $errstr = $DBI::errstr;
         
-            &disconnect( $dbh );
+            disconnect( $dbh );
             die qq(ERROR: $errstr, "DATABASE RETRIEVE ERROR" );
     }
 }
@@ -259,7 +274,7 @@ sub delete_table
          $table,
          ) = @_;
 
-    &request( $dbh, "drop table $table" );
+    request( $dbh, "drop table $table" );
 }
 
 
@@ -270,7 +285,7 @@ sub list_tables
 
     my ( @list );
 
-    @list = &query_array( $dbh, "show tables" );
+    @list = query_array( $dbh, "show tables" );
 
     if ( @list ) { 
         @list = map { $_->[0] } @list;
@@ -288,7 +303,7 @@ sub table_exists
          $name,
          ) = @_;
 
-    if ( grep /^$name$/, &list_tables( $dbh ) ) {
+    if ( grep /^$name$/, list_tables( $dbh ) ) {
         return 1;
     } else {
         return;
@@ -312,7 +327,7 @@ sub connect
 
     my ( $dbh );
 
-    &Maasha::Common::error( qq(Database "$database" does not exist) ) if not &database_exists( $database, $user, $pass );
+    Maasha::Common::error( qq(Database "$database" does not exist) ) if not database_exists( $database, $user, $pass );
 
     $dbh = DBI->connect(
         "dbi:mysql:$database", 
@@ -329,7 +344,7 @@ sub connect
     if ( $dbh ) {
         return $dbh;
     } else {
-        &Maasha::Common::error( qq($DBI::errstr) );
+        Maasha::Common::error( qq($DBI::errstr) );
     }
 }
 
@@ -363,7 +378,7 @@ sub update_field
 
     $count_sql = qq( SELECT $column FROM $table WHERE $column="$old_val"; );
 
-    $count = scalar &query_array( $dbh, $count_sql );
+    $count = scalar query_array( $dbh, $count_sql );
 
     if ( $count > 1 )
     {
@@ -371,13 +386,13 @@ sub update_field
     }
     elsif ( $count == 0 )
     {
-        &disconnect( $dbh );
+        disconnect( $dbh );
         die qq(ERROR: entry not found "$count_sql"\n);
     }
     else
     {
         $sql = qq( UPDATE $table SET $column="$new_val" WHERE $column="$old_val"; );
-        &request( $dbh, $sql );
+        request( $dbh, $sql );
     }
 
     return;
@@ -400,7 +415,7 @@ sub delete_row
 
     $sql = qq(DELETE FROM $table WHERE $field = "$pattern";);
 
-    &request( $dbh, $sql );
+    request( $dbh, $sql );
 
     return;
 }
@@ -430,7 +445,7 @@ sub add_row
 
     $sql = "INSERT INTO $table VALUES ( " . join( ", ", @fields ) . " );";
 
-    &request( $dbh, $sql );
+    request( $dbh, $sql );
 
     return;
 }
@@ -457,7 +472,7 @@ sub add_column
         $sql = "ALTER TABLE $table ADD COLUMN ( $column $type );";
     }
     
-    &request( $dbh, $sql );
+    request( $dbh, $sql );
     
     return;
 }
@@ -478,13 +493,13 @@ sub del_column
 
     $sql = "ALTER TABLE $table DROP COLUMN $column;";
 
-    &request( $dbh, $sql );
+    request( $dbh, $sql );
 
     return;
 }
 
 
-sub load_sql_file
+sub bulk_load_file
 {
     # Martin A. Hansen, January 2004.
 
@@ -504,7 +519,7 @@ sub load_sql_file
 
     $sql = qq( LOAD DATA LOCAL INFILE "$path" INTO TABLE $table FIELDS TERMINATED BY '$delimiter' );
 
-    &SQL::request( $dbh, $sql );
+    request( $dbh, $sql );
 }