From 145f379500a27a90895aa3b0fbd8b63425e3c148 Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Fri, 13 May 2005 17:20:56 +0000
Subject: [PATCH] add the beginnings of an ARRL log query and updater

---
 perl/ARRL/DX.pm | 86 +++++++++++++++++++++++++++++++++++++++++++++++++
 perl/DXLog.pm   |  5 +--
 perl/DXUtil.pm  |  2 +-
 perl/Julian.pm  |  5 +--
 perl/dbtest.pl  | 23 +++++++++++++
 5 files changed, 112 insertions(+), 9 deletions(-)
 create mode 100644 perl/ARRL/DX.pm
 create mode 100755 perl/dbtest.pl

diff --git a/perl/ARRL/DX.pm b/perl/ARRL/DX.pm
new file mode 100644
index 00000000..7eaf3eb7
--- /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 f96ab44a..2a2e9078 100644
--- 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 8a5cffe4..db52ad81 100644
--- 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 5351aa27..85f47bdd 100644
--- 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
index 00000000..51a5c4d0
--- /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;
-- 
2.43.0