Return to db.pm CVS log

Up to [local] / wpscripts / ztransfer

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);