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 %aliases $bandsfn %valid);
  18
  19 %bands = ();   # the 'raw' band data
  20 %regions = ();  # list of regions for shortcuts eg vhf ssb
  21 %aliases = ();  # list of aliases
  22 $bandsfn = "$main::data/bands.pl";
  23
  24 %valid = (
  25   cw => '0,CW,parraypairs',
  26   ssb => '0,SSB,parraypairs',
  27   data => '0,DATA,parraypairs',
  28   sstv => '0,SSTV,parraypairs',
  29   fstv => '0,FSTV,parraypairs',
  30   rtty => '0,RTTY,parraypairs',
  31   pactor => '0,PACTOR,parraypairs',
  32   packet => '0,PACKET,parraypairs',
  33   repeater => '0,REPEATER,parraypairs',
  34   fax => '0,FAX,parraypairs',
  35   beacon => '0,BEACON,parraypairs',
  36   band => '0,BAND,parraypairs',
  37 );
  38
  39 # load the band data
  40 sub load
  41 {
  42   %bands = ();
  43   do $bandsfn;
  44   confess $@ if $@;
  45 }
  46
  47 # obtain a band object by callsign [$obj = Band::get($call)]
  48 sub get
  49 {
  50   my $call = shift;
  51   my $ncall = $aliases{$call};
  52   $call = $ncall if $ncall;
  53   return $bands{$call};
  54 }
  55
  56 # obtain all the band objects
  57 sub get_all
  58 {
  59   return values(%bands);
  60 }
  61
  62 # get all the band keys
  63 sub get_keys
  64 {
  65   return keys(%bands);
  66 }
  67
  68 # get all the region keys
  69 sub get_region_keys
  70 {
  71   return keys(%regions);
  72 }
  73
  74 # get all the alias keys
  75 sub get_alias_keys
  76 {
  77   return keys(%aliases);
  78 }
  79
  80 # get a region
  81 sub get_region
  82 {
  83   my $reg = shift;
  84   return $regions{$reg};
  85 }
  86
  87 # get all the frequency pairs associated with the band and sub-band offered
  88 # the band can be a region, sub-band can be missing
  89 #
  90 # called Bands::get_freq(band-label, subband-label)
  91 sub get_freq
  92 {
  93   my ($band, $subband) = @_;
  94   my @band;
  95   my $b;
  96   my @out;
  97   return () if !$band;
  98   $subband = 'band' if !$subband;
  99
 100   # first look in the region
 101   $b = $regions{$band};
 102   @band = @$b if $b;
 103   @band = ($band) if @band == 0;
 104
 105   # we now have a list of bands to scan for sub bands
 106   foreach $b (@band) {
 107     my $wb = $bands{$b};
 108         if ($wb) {
 109           my $sb = $wb->{$subband};
 110           push @out, @$sb if $sb;
 111         }
 112   }
 113   return @out;
 114 }
 115
 116 #
 117 # return a list of valid elements
 118 #
 119
 120 sub fields
 121 {
 122   return keys(%valid);
 123 }
 124
 125 #
 126 # return a prompt for a field
 127 #
 128
 129 sub field_prompt
 130 {
 131   my ($self, $ele) = @_;
 132   return $valid{$ele};
 133 }
 134
 135 no strict;
 136 sub AUTOLOAD
 137 {
 138   my $self = shift;
 139   my $name = $AUTOLOAD;
 140   return if $name =~ /::DESTROY$/;
 141   $name =~ s/.*:://o;
 142
 143   @_ ? $self->{$name} = shift : $self->{$name} ;
 144 }
 145
 146 1;