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