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