perl/Bands.pm

   1 #
   2 # module to manage the band list
   3 #
   4 # Copyright (c) 1998 - Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 package Bands;
  10
  11 use DXUtil;
  12 use DXDebug;
  13 use DXVars;
  14 use Carp;
  15
  16 use strict;
  17 use vars qw(%bands %regions $bandsfn %valid);
  18
  19 %bands = ();   # the 'raw' band data
  20 %regions = ();  # list of regions for shortcuts eg vhf ssb
  21 $bandsfn = "$main::data/bands.pl";
  22
  23 %valid = (
  24   cw => '0,CW,parraypairs',
  25   ssb => '0,SSB,parraypairs',
  26   data => '0,DATA,parraypairs',
  27   sstv => '0,SSTV,parraypairs',
  28   fstv => '0,FSTV,parraypairs',
  29   rtty => '0,RTTY,parraypairs',
  30   pactor => '0,PACTOR,parraypairs',
  31   packet => '0,PACKET,parraypairs',
  32   repeater => '0,REPEATER,parraypairs',
  33   fax => '0,FAX,parraypairs',
  34   beacon => '0,BEACON,parraypairs',
  35   band => '0,BAND,parraypairs',
  36 );
  37
  38 # load the band data
  39 sub load
  40 {
  41   %bands = ();
  42   do $bandsfn;
  43   confess $@ if $@;
  44 }
  45
  46 # obtain a band object by callsign [$obj = Band::get($call)]
  47 sub get
  48 {
  49   my $call = shift;
  50   return $bands{$call};
  51 }
  52
  53 # obtain all the band objects
  54 sub get_all
  55 {
  56   return values(%bands);
  57 }
  58
  59 # get all the band keys
  60 sub get_keys
  61 {
  62   return keys(%bands);
  63 }
  64
  65 # get all the frequency pairs associated with the band and sub-band offered
  66 # the band can be a region, sub-band can be missing
  67 #
  68 # called Bands::get_freq(band-label, subband-label)
  69 sub get_freq
  70 {
  71   my ($band, $subband) = @_;
  72   my @band;
  73   my $b;
  74   my @out;
  75   return () if !$band;
  76   $subband = 'band' if !$subband;
  77
  78   # first look in the region
  79   $b = $regions{$band};
  80   @band = @$b if $b;
  81   @band = ($band) if @band == 0;
  82
  83   # we now have a list of bands to scan for sub bands
  84   foreach $b (@band) {
  85     my $wb = $bands{$b};
  86         if ($wb) {
  87           my $sb = $wb->{$subband};
  88           push @out, @$sb if $sb;
  89         }
  90   }
  91   return @out;
  92 }
  93
  94 #
  95 # return a list of valid elements
  96 #
  97
  98 sub fields
  99 {
 100   return keys(%valid);
 101 }
 102
 103 #
 104 # return a prompt for a field
 105 #
 106
 107 sub field_prompt
 108 {
 109   my ($self, $ele) = @_;
 110   return $valid{$ele};
 111 }
 112
 113 no strict;
 114 sub AUTOLOAD
 115 {
 116   my $self = shift;
 117   my $name = $AUTOLOAD;
 118   return if $name =~ /::DESTROY$/;
 119   $name =~ s/.*:://o;
 120
 121   @_ ? $self->{$name} = shift : $self->{$name} ;
 122 }
 123
 124 1;