perl/Bands.pm

   1 #
   2 # module to manage the band list
   3 #
   4 # Copyright (c) 1998 - Dirk Koopman G1TLH
   5 #
   6 #
   7 #
   8
   9 package Bands;
  10
  11 use DXUtil;
  12 use DXDebug;
  13 use DXVars;
  14
  15 use strict;
  16 use vars qw(%bands %regions %aliases $bandsfn %valid);
  17
  18 %bands = ();                                    # the 'raw' band data
  19 %regions = ();                                  # list of regions for shortcuts eg vhf ssb
  20 %aliases = ();                                  # list of aliases
  21
  22 $bandsfn = localdata("bands.pl");
  23
  24 %valid = (
  25                   band => '0,BAND,parraypairs',
  26                   beacon => '0,BEACON,parraypairs',
  27                   cw => '0,CW,parraypairs',
  28                   data => '0,DATA,parraypairs',
  29                   fax => '0,FAX,parraypairs',
  30                   fstv => '0,FSTV,parraypairs',
  31                   packet => '0,PACKET,parraypairs',
  32                   pactor => '0,PACTOR,parraypairs',
  33                   repeater => '0,REPEATER,parraypairs',
  34                   rtty => '0,RTTY,parraypairs',
  35                   ssb => '0,SSB,parraypairs',
  36                   sstv => '0,SSTV,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         no strict;
 139         my $name = $AUTOLOAD;
 140         return if $name =~ /::DESTROY$/;
 141         $name =~ s/^.*:://o;
 142
 143         # this clever line of code creates a subroutine which takes over from autoload
 144         # from OO Perl - Conway
 145         *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
 146         goto &$AUTOLOAD;
 147 }
 148
 149 1;