perl/Prefix.pm

   1 #
   2 # prefix handling
   3 #
   4 # Copyright (c) - Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 package Prefix;
  10
  11 use Carp;
  12 use DXVars;
  13 use DB_File;
  14
  15 use strict;
  16
  17 my $db;     # the DB_File handle
  18 my %prefix_loc;   # the meat of the info
  19 my %prefix;       # the prefix list
  20
  21 sub load
  22 {
  23   if ($db) {
  24     untie %prefix;
  25         %prefix = ();
  26         %prefix_loc = ();
  27   }
  28   $db = tie(%prefix, "DB_File", undef, O_RDWR|O_CREAT, 0, $DB_BTREE) or confess "can't tie %prefix ($!)";
  29   do "$main::data/prefix_data.pl";
  30   confess $@ if $@;
  31 }
  32
  33 sub store
  34 {
  35   my ($k, $l);
  36   my $fh = new FileHandle;
  37   my $fn = "$main::data/prefix_data.pl";
  38
  39   confess "Prefix system not started" if !$db;
  40
  41   # save versions!
  42   rename "$fn.oooo", "$fn.ooooo" if -e "$fn.oooo";
  43   rename "$fn.ooo", "$fn.oooo" if -e "$fn.ooo";
  44   rename "$fn.oo", "$fn.ooo" if -e "$fn.oo";
  45   rename "$fn.o", "$fn.oo" if -e "$fn.o";
  46   rename "$fn", "$fn.o" if -e "$fn";
  47
  48   $fh->open(">$fn") or die "Can't open $fn ($!)";
  49
  50   # prefix location data
  51   $fh->print("%prefix_loc = (\n");
  52   foreach $l (sort {$a <=> $b} keys %prefix_loc) {
  53     my $r = $prefix_loc{$l};
  54         $fh->printf("   $l => { name => '%s', dxcc => %d, itu => %d, utcoff => %d, lat => %f, long => %f },\n",
  55                     $r->{name}, $r->{dxcc}, $r->{itu}, $r->{cq}, $r->{utcoff}, $r->{lat}, $r->{long});
  56   }
  57   $fh->print(");\n\n");
  58
  59   # prefix data
  60   $fh->print("%prefix = (\n");
  61   foreach $k (sort keys %prefix) {
  62     $fh->print("   '$k' => [");
  63         my @list = @{$prefix{$k}};
  64         my $l;
  65         my $str;
  66         foreach $l (@list) {
  67       $str .= " $l,";
  68     }
  69         chop $str;
  70         $fh->print("$str ],\n");
  71   }
  72   $fh->print(");\n");
  73   $fh->close;
  74 }
  75
  76 # this may return several entries, be warned!
  77 #
  78 # what you get is a list of pairs of:-
  79 #
  80 # prefix => \[ @list of references to prefix_locs ]
  81 #
  82 # This routine will only do what you ask for, if you wish to be intelligent
  83 # then that is YOUR problem!
  84 #
  85 sub get
  86 {
  87
  88 }
  89
  90 1;
  91
  92 __END__