From 145f379500a27a90895aa3b0fbd8b63425e3c148 Mon Sep 17 00:00:00 2001 From: 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