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