add the beginnings of an ARRL log query and updater

diff --git a/perl/ARRL/DX.pm b/perl/ARRL/DX.pm
new file mode 100644 (file)
index 0000000..7eaf3eb
--- /dev/null
+++ b/perl/ARRL/DX.pm
@@ -0,0 +1,86 @@
+#
+# (optional) ARRL Dx Database handling
+#
+# $Id$
+#
+# Copyright (c) 2005 Dirk Koopman G1TLH
+#
+
+use strict;
+
+package ARRL::DX;
+
+use vars qw($VERSION $BRANCH $dbh $dbname %tabledefs $error);
+
+#main::mkver($VERSION = q$Revision$);
+
+use DXLog;
+use DXDebug;
+use DXUtil;
+use DBI;
+use IO::File;
+
+$dbname = "$main::root/data/arrldx.db";
+%tabledefs = (
+                         paragraph => 'CREATE TABLE paragraph(p text, t int)',
+                         paragraph_t_idx => 'CREATE INDEX paragraph_t_idx ON paragraph(t DESC)',
+                         refer => 'CREATE TABLE refer(r text, id int, t int, pos int)',
+                         refer_id_idx => 'CREATE INDEX refer_id_idx ON refer(id)',
+                         refer_t_idx => 'CREATE INDEX refer_t_idx ON refer(t DESC)',
+                        );
+
+sub new
+{
+       my $pkg = shift;
+       my $class = ref $pkg || $pkg;
+       my %args = $@;
+       
+       $error = undef;
+       
+       unless ($dbh) {
+               $dbh = DBI->connect("dbi:SQLite:dbname=$dbname", "", "");
+               unless ($dbh) {
+                       dbg($DBI::errstr);
+                       Log('err', $DBI::errstr);
+                       $error = $DBI::errstr;
+                       return;
+               }
+               
+               # check that all the tables are present and correct
+               my $sth = $dbh->prepare("select name,type from sqlite_master") or $error = $DBI::errstr, return;
+               $sth->execute or $error = $DBI::errstr, return;
+               my %f;
+               while (my @row = $sth->fetchrow_array) {
+                       $f{$row[0]} = $row[1];
+               }
+               foreach my $t (sort keys %tabledefs) {
+                       $dbh->do($tabledefs{$t}) unless exists $f{$t};
+               }
+               $sth->finish;
+       }
+
+       my $self = {};
+       
+       if ($args{file}) {
+               if (ref $args{file}) {
+                       $self->{f} = $args{file};
+               } else {
+                       $self->{f} = IO::File->new($args{file}) or $error = $!, return;
+               }
+       } 
+       
+       return bless $self, $class; 
+}
+
+sub process
+{
+       my $self = shift;
+       
+}
+
+sub insert
+{
+       my $self = shift;
+       
+}
+1;

diff --git a/perl/DXLog.pm b/perl/DXLog.pm
index f96ab44aa092863d036060b3462d1e4aecea3c2f..2a2e9078d7f9cf2a1883aee172f4b45c421b02ae 100644 (file)
--- a/perl/DXLog.pm
+++ b/perl/DXLog.pm
@@ -39,10 +39,7 @@ use Carp;
 use strict;
 
 use vars qw($VERSION $BRANCH);
-$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
-$main::build += $VERSION;
-$main::branch += $BRANCH;
+main::mkver($VERSION = q$Revision$) if main->can('mkver');
 
 use vars qw($log);
 

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 8a5cffe4334a2b4e7c7d3cccd4ace2975bddf784..db52ad81076fa91d67a165b60adc8e567c58d8d9 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -17,7 +17,7 @@ use strict;
 
 use vars qw($VERSION $BRANCH);
 
-main::mkver($VERSION = q$Revision$);
+main::mkver($VERSION = q$Revision$) if main->can('mkver');
 
 use vars qw(@month %patmap @ISA @EXPORT);
 

diff --git a/perl/Julian.pm b/perl/Julian.pm
index 5351aa278c98bec968dabe03e20339284c8321f8..85f47bdd37e3abea4f988186675b2106db73cf93 100644 (file)
--- a/perl/Julian.pm
+++ b/perl/Julian.pm
@@ -12,10 +12,7 @@ package Julian;
 
 
 use vars qw($VERSION $BRANCH @days @ldays @month);
-$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
-$main::build += $VERSION;
-$main::branch += $BRANCH;
+main::mkver($VERSION = q$Revision$) if main->can('mkver');
 
 @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
 @ldays = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

diff --git a/perl/dbtest.pl b/perl/dbtest.pl
new file mode 100755 (executable)
index 0000000..51a5c4d
--- /dev/null
+++ b/perl/dbtest.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+# test for independent sql servers
+# search local then perl directories
+
+use vars qw($root);
+
+BEGIN {
+       # root of directory tree for this system
+       $root = "/spider"; 
+       $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+       
+       unshift @INC, "$root/perl";     # this IS the right way round!
+       unshift @INC, "$root/local";
+}
+
+use DXUtil;
+use DXDebug;
+use ARRL::DX;
+
+
+my $dx = ARRL::DX->new;
+
+exit 0;