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                 dbg "DXSql $dsn " . $dbh? "connected" : "NOT connected" if isdbg('dxsql');
  65         };
  66         unless ($dbh) {
  67                 $active = 0;
  68                 return undef;
  69         }
  70         $self->{dbh} = $dbh;
  71         return $self;
  72 }
  73
  74 sub finish
  75 {
  76         my $self = shift;
  77         $self->{dbh}->disconnect;
  78 }
  79
  80 sub do
  81 {
  82         my $self = shift;
  83         my $s = shift;
  84
  85         eval { $self->{dbh}->do($s); };
  86 }
  87
  88 sub begin_work
  89 {
  90         $_[0]->{dbh}->begin_work;
  91 }
  92
  93 sub commit
  94 {
  95         $_[0]->{dbh}->commit;
  96 }
  97
  98 sub rollback
  99 {
 100         $_[0]->{dbh}->rollback;
 101 }
 102
 103 sub quote
 104 {
 105         return $_[0]->{dbh}->quote($_[1]);
 106 }
 107
 108 sub prepare
 109 {
 110         return $_[0]->{dbh}->prepare($_[1]);
 111 }
 112
 113 sub spot_insert_prepare
 114 {
 115         my $self = shift;
 116         return $self->prepare('insert into spot values(?' . ',?' x 15 . ')');
 117 }
 118
 119 sub spot_insert
 120 {
 121         my $self = shift;
 122         my $spot = shift;
 123         my $sth = shift;
 124
 125         if ($sth) {
 126                 push @$spot, undef while  @$spot < 15;
 127                 pop @$spot while @$spot > 15;
 128                 eval {$sth->execute(undef, @$spot)};
 129         } else {
 130                 my $s = "insert into spot values(NULL,";
 131                 $s .= sprintf("%.1f,", $spot->[0]);
 132                 $s .= $self->quote($spot->[1]) . "," ;
 133                 $s .= $spot->[2] . ',';
 134                 $s .= (length $spot->[3] ? $self->quote($spot->[3]) : 'NULL') . ',';
 135                 $s .= $self->quote($spot->[4]) . ',';
 136                 $s .= $spot->[5] . ',';
 137                 $s .= $spot->[6] . ',';
 138                 $s .= (length $spot->[7] ? $self->quote($spot->[7]) : 'NULL') . ',';
 139                 $s .= $spot->[8] . ',';
 140                 $s .= $spot->[9] . ',';
 141                 $s .= $spot->[10] . ',';
 142                 $s .= $spot->[11] . ',';
 143                 $s .= (length $spot->[12] ? $self->quote($spot->[12]) : 'NULL') . ',';
 144                 $s .= (length $spot->[13] ? $self->quote($spot->[13]) : 'NULL') . ',';
 145                 $s .= (length $spot->[14] ? $self->quote($spot->[14]) : 'NULL') . ')';
 146                 eval {$self->do($s)};
 147         }
 148 }
 149
 150 sub spot_search
 151 {
 152         my $self = shift;
 153         my ($expr, $dayfrom, $dayto, $from, $to, $hint, $dofilter, $dxchan) = @_;
 154         $dayfrom = 0 if !$dayfrom;
 155         $dayto = $Spot::maxdays unless $dayto;
 156         $dayto = $dayfrom + $Spot::maxdays if $dayto < $dayfrom;
 157         my $today = Julian::Day->new(time());
 158         my $fromdate = $today->sub($dayfrom);
 159         my $todate = $fromdate->sub($dayto);
 160         $from = 0 unless $from;
 161         $to = $Spot::defaultspots unless $to;
 162
 163         dbg("DXSql expr: $expr") if isdbg('search');
 164         if ($expr =~ /\$r->/) {
 165                 $expr =~ s/(?:==|eq)/ = /g;
 166                 $expr =~ s/\$r->\[10\]/spotteritu/g;
 167                 $expr =~ s/\$r->\[11\]/spottercq/g;
 168                 $expr =~ s/\$r->\[12\]/spotstate/g;
 169                 $expr =~ s/\$r->\[13\]/spotterstate/g;
 170                 $expr =~ s/\$r->\[14\]/ipaddr/g;
 171                 $expr =~ s/\$r->\[0\]/freq/g;
 172                 $expr =~ s/\$r->\[1\]/spotcall/g;
 173                 $expr =~ s/\$r->\[2\]/time/g;
 174                 $expr =~ s/\$r->\[3\]/comment/g;
 175                 $expr =~ s/\$r->\[4\]/spotter/g;
 176                 $expr =~ s/\$r->\[5\]/spotdxcc/g;
 177                 $expr =~ s/\$r->\[6\]/spotterdxcc/g;
 178                 $expr =~ s/\$r->\[7\]/origin/g;
 179                 $expr =~ s/\$r->\[8\]/spotitu/g;
 180                 $expr =~ s/\$r->\[9\]/spotcq/g;
 181                 $expr =~ s/\|\|/ or /g;
 182                 $expr =~ s/\&\&/ and /g;
 183                 $expr =~ s/=~\s*m\{\^([%\w]+)[^\}]*\}/ like '$1\%'/g;
 184         } else {
 185                 $expr = '';
 186         }
 187         my $fdays = $dayfrom ? "time <= " . ($main::systime - ($dayfrom * 86400)) : "";
 188         my $days = "time >= " . ($main::systime - ($dayto * 86400));
 189         my $trange = $fdays ? "($fdays and $days)" : $days;
 190         $expr .= $expr ? " and $trange" : $trange;
 191     my $s = qq{select freq,spotcall,time,comment,spotter,spotdxcc,spotterdxcc,
 192 origin,spotitu,spotcq,spotteritu,spottercq,spotstate,spotterstate,ipaddr from spot
 193 where $expr limit $to};
 194     dbg("DXSql expr: $s") if isdbg('search');
 195         my $ref = $self->{dbh}->selectall_arrayref($s);
 196         return @$ref;
 197 }
 198
 199 1;
 200