]> gb7djk.dxcluster.net Git - spider.git/blob - perl/DXSql.pm
pc92c I said, not pc92a
[spider.git] / perl / DXSql.pm
1 #
2 # The master SQL module
3 #
4 # $Id$
5 #
6 # Copyright (c) 2006 Dirk Koopman G1TLH
7 #
8
9 package DXSql;
10
11 use strict;
12
13 use DXSql::SQLite;
14 use DXSql::mysql;
15 use DXDebug;
16
17 use vars qw($VERSION $BRANCH $active);
18 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
19 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
20 $main::build += $VERSION;
21 $main::branch += $BRANCH;
22
23 $active = 0;
24
25 sub init
26 {
27         my $dsn = shift;
28         return unless $dsn;
29         return $active if $active;
30         
31         eval { 
32                 require DBI;
33         };
34         unless ($@) {
35                 import DBI;
36                 $active++;
37         }
38         undef $@;
39         return $active;
40
41
42 sub new
43 {
44         my $class = shift;
45         my $dsn = shift;
46         my $self;
47         
48         return undef unless $active;
49         my $dbh;
50         my ($style) = $dsn =~ /^dbi:(\w+):/;
51         my $newclass = "DXSql::$style";
52         eval "require $newclass";
53         if ($@) {
54                 $active = 0;
55                 return undef;
56         }
57         return bless {}, $newclass;
58 }
59
60 sub connect
61 {
62         my $self = shift; 
63         my $dsn = shift;
64         my $user = shift;
65         my $passwd = shift;
66         
67         my $dbh;
68         eval {
69                 no strict 'refs';
70                 $dbh = DBI->connect($dsn, $user, $passwd, {AutoCommit => 0}); 
71         };
72         unless ($dbh) {
73                 $active = 0;
74                 return undef;
75         }
76         $self->{dbh} = $dbh;
77         return $self;
78 }
79
80 sub finish
81 {
82         my $self = shift;
83         $self->{dbh}->disconnect;
84
85
86 sub do
87 {
88         my $self = shift;
89         my $s = shift;
90         
91         eval { $self->{dbh}->do($s); }; 
92 }
93
94 sub commit
95 {
96         $_[0]->{dbh}->commit;
97         $_[0]->{dbh}->{AutoCommit} = 0;
98 }
99
100 sub rollback
101 {
102         $_[0]->{dbh}->rollback;
103         $_[0]->{dbh}->{AutoCommit} = 0;
104 }
105
106 sub quote
107 {
108         return $_[0]->{dbh}->quote($_[1]);
109 }
110
111 sub prepare
112 {
113         return $_[0]->{dbh}->prepare($_[1]);
114 }
115
116 sub spot_insert_prepare
117 {
118         my $self = shift;
119         return $self->prepare('insert into spot values(?' . ',?' x 14 . ')');
120 }
121
122 sub spot_insert
123 {
124         my $self = shift;
125         my $spot = shift;
126         my $sth = shift;
127         
128         if ($sth) {
129                 eval {$sth->execute(undef, @$spot)};
130         } else {
131                 my $s = "insert into spot values(NULL,";
132                 $s .= sprintf("%.1f,", $spot->[0]);
133                 $s .= $self->quote($spot->[1]) . "," ;
134                 $s .= $spot->[2] . ',';
135                 $s .= (length $spot->[3] ? $self->quote($spot->[3]) : 'NULL') . ',';
136                 $s .= $self->quote($spot->[4]) . ',';
137                 $s .= $spot->[5] . ',';
138                 $s .= $spot->[6] . ',';
139                 $s .= (length $spot->[7] ? $self->quote($spot->[7]) : 'NULL') . ',';
140                 $s .= $spot->[8] . ',';
141                 $s .= $spot->[9] . ',';
142                 $s .= $spot->[10] . ',';
143                 $s .= $spot->[11] . ',';
144                 $s .= (length $spot->[12] ? $self->quote($spot->[12]) : 'NULL') . ',';
145                 $s .= (length $spot->[13] ? $self->quote($spot->[13]) : 'NULL') . ')';
146                 eval {$self->do($s)};
147         }
148 }
149
150 sub spot_search
151 {
152         my $self = shift;
153         my $expr = shift;
154         my $dayfrom = shift;
155         my $dayto = shift;
156         my $n = shift;
157         my $dxchan = shift;
158         
159         dbg("expr: $expr") if isdbg('search');
160         if ($expr =~ /\$f/) {
161                 $expr =~ s/(?:==|eq)/ = /g;
162                 $expr =~ s/\$f10/spotteritu/g;
163                 $expr =~ s/\$f11/spottercq/g;
164                 $expr =~ s/\$f12/spotstate/g;
165                 $expr =~ s/\$f13/spotterstate/g;
166                 $expr =~ s/\$f0/freq/g;
167                 $expr =~ s/\$f1/spotcall/g;
168                 $expr =~ s/\$f2/time/g;
169                 $expr =~ s/\$f3/comment/g;
170                 $expr =~ s/\$f4/spotter/g;
171                 $expr =~ s/\$f5/spotdxcc/g;
172                 $expr =~ s/\$f6/spotterdxcc/g;
173                 $expr =~ s/\$f7/origin/g;
174                 $expr =~ s/\$f8/spotitu/g;
175                 $expr =~ s/\$f9/spotcq/g;
176                 $expr =~ s/\|\|/ or /g;
177                 $expr =~ s/\&\&/ and /g;
178                 $expr =~ s/=~\s+m\{\^([%\w]+)[^\}]*\}/ like '$1'/g;
179         } else {
180                 $expr = '';
181         }  
182         my $fdays = $dayfrom ? "time <= " . ($main::systime - ($dayfrom * 86400)) : "";
183         my $days = "time >= " . ($main::systime - ($dayto * 86400));
184         my $trange = $fdays ? "($fdays and $days)" : $days;
185         $expr .= $expr ? " and $trange" : $trange;
186     my $s = qq{select freq,spotcall,time,comment,spotter,spotdxcc,spotterdxcc,
187 origin,spotitu,spotcq,spotteritu,spottercq,spotstate,spotterstate from spot
188 where $expr order by time desc limit $n};
189     dbg("sql expr: $s") if isdbg('search');
190         my $ref = $self->{dbh}->selectall_arrayref($s);
191         return @$ref;
192 }
193
194 1;
195