Annotation of wpscripts/ztransfer/db.pm, Revision 1.1
1.1 ! yason 1: #!/usr/bin/perl
! 2: # $Id: db.pm,v 1.1.1.5 2006/05/16 09:41:52 init Exp $
! 3: package db;
! 4: use DBI;
! 5: use log;
! 6:
! 7: my $DB_SERVER = "MSSQL"; # from /usr/local/etc/freetds.conf
! 8: my $DB_USER = "it_men";
! 9: my $DB_PASS = "itmen712";
! 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
! 23: $dbh->do("use Manager");
! 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);
CVSweb