Return to db.pm CVS log

Up to [local] / wpscripts / ztransfer

Annotation of wpscripts/ztransfer/db.pm, Revision 1.2

1.1       yason       1: #!/usr/bin/perl
1.2     ! yason       2: # $Id: db.pm,v 1.1.1.1 2011/06/03 09:28:47 yason Exp $
1.1       yason       3: package db;
                      4: use DBI;
                      5: use log;
                      6:
1.2     ! yason       7: my $DB_SERVER = "pdc";  # from /usr/local/etc/freetds.conf
        !             8: my $DB_USER = "sa";
        !             9: my $DB_PASS = "aekghbynflvby";
1.1       yason      10: my $dsn = "DBI:Sybase:server=$DB_SERVER";
                     11:
                     12: # exported
                     13: our $dbh;
                     14:
                     15:
                     16:
                     17: # functions
                     18: sub connect()
                     19: {
                     20:     $dbh = DBI->connect($dsn, $DB_USER, $DB_PASS) or log::critical("Can not connect to database!");
                     21:        log::main("<<<***  Connected to database server  ***>>>");
                     22:     # select database
1.2     ! yason      23:     $dbh->do("use full_print");
1.1       yason      24: }
                     25:
                     26:
                     27: sub disconnect()
                     28: {
                     29:     $dbh->disconnect();
                     30:        log::main("<<<***  Disconnected from database  ***>>>");
                     31: }
                     32:
                     33:
                     34: sub change_status($$)
                     35: {
                     36:     my $ID = shift;
                     37:     my $value = shift;
                     38:     my $sth = $dbh->prepare("UPDATE upload_files SET Status=$value WHERE ID=$ID");
                     39:     $sth->execute() or log::error("SQL 'UPDATE upload_files SET Status=$value WHERE Status=0 AND ID=$ID' failed!");
                     40: }
                     41:
                     42:
                     43: sub write_size_orig($$)
                     44: {
                     45:     my $ID = shift;
                     46:     my $size = shift;
                     47:     my $sth = $dbh->prepare("UPDATE upload_files SET size_orig=$size WHERE ID=$ID");
                     48:     $sth->execute() or log::error("SQL 'UPDATE upload_files SET size_orig=$size WHERE ID=$ID' failed");
                     49: }
                     50:
                     51:
                     52: sub write_size_arc($$)
                     53: {
                     54:     my $ID = shift;
                     55:     my $size = shift;
                     56:     my $sth = $dbh->prepare("UPDATE upload_files SET size_arc=$size WHERE ID=$ID");
                     57:     $sth->execute() or log::error("SQL 'UPDATE upload_files SET size_arc=$size WHERE ID=$ID' failed");
                     58: }
                     59:
                     60:
                     61: sub write_ux_rpath($$)
                     62: {
                     63:     my $ID = shift;
                     64:     my $value = shift;
                     65:     my $sth = $dbh->prepare("UPDATE upload_files SET ux_rpath='$value' WHERE ID=$ID");
                     66:     $sth->execute() or log::error("SQL 'UPDATE upload_files SET ux_rpath='$value' WHERE ID=$ID' failed");
                     67: }
                     68:
                     69:
                     70: sub get_tx_count($)
                     71: {
                     72:     my $ID = shift;
                     73:     my $sth = $dbh->prepare("SELECT tx_count FROM upload_files WHERE ID=$ID");
                     74:     # considering okay to not to exit on sql failure
                     75:     $sth->execute() or log::error("SQL 'SELECT tx_count FROM upload_files WHERE ID=$ID' failed");
                     76:
                     77:     # non-scalar context
                     78:     (my $tx_count) = ( $sth->fetchrow_array() );
                     79:
                     80:     return($tx_count);
                     81: }
                     82:
                     83:
                     84: sub increment_tx_count($)
                     85: {
                     86:     my $ID = shift;
                     87:     my $sth = $dbh->prepare("SELECT tx_count FROM upload_files WHERE ID=$ID");
                     88:     $sth->execute() or log::error("SQL 'SELECT tx_count FROM upload_files WHERE ID=$ID' failed");
                     89:
                     90:     # non-scalar context
                     91:     (my $tx_count) = ( $sth->fetchrow_array() );
                     92:
                     93:     $tx_count++;
                     94:
                     95:     my $sth = $dbh->prepare("UPDATE upload_files SET tx_count=$tx_count WHERE ID=$ID");
                     96:     $sth->execute() or log::error("SQL 'UPDATE upload_files SET tx_count=$tx_count WHERE ID=$ID' failed");
                     97: }
                     98:
                     99:
                    100: return(1);