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