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 $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         my $ncall = $aliases{$call};
  51         $call = $ncall if $ncall;
  52         return $bands{$call};
  53 }
  54
  55 # obtain all the band objects
  56 sub get_all
  57 {
  58         return values(%bands);
  59 }
  60
  61 # get all the band keys
  62 sub get_keys
  63 {
  64         return keys(%bands);
  65 }
  66
  67 # get all the region keys
  68 sub get_region_keys
  69 {
  70         return keys(%regions);
  71 }
  72
  73 # get all the alias keys
  74 sub get_alias_keys
  75 {
  76         return keys(%aliases);
  77 }
  78
  79 # get a region
  80 sub get_region
  81 {
  82         my $reg = shift;
  83         return $regions{$reg};
  84 }
  85
  86 # get all the frequency pairs associated with the band and sub-band offered
  87 # the band can be a region, sub-band can be missing
  88 #
  89 # called Bands::get_freq(band-label, subband-label)
  90 sub get_freq
  91 {
  92         my ($band, $subband) = @_;
  93         my @band;
  94         my $b;
  95         my @out;
  96         return () if !$band;
  97         $subband = 'band' if !$subband;
  98
  99         # first look in the region
 100         $b = $regions{$band};
 101         @band = @$b if $b;
 102         @band = ($band) if @band == 0;
 103
 104         # we now have a list of bands to scan for sub bands
 105         foreach $b (@band) {
 106                 my $wb = $bands{$b};
 107                 if ($wb) {
 108                         my $sb = $wb->{$subband};
 109                         push @out, @$sb if $sb;
 110                 }
 111         }
 112         return @out;
 113 }
 114
 115 #
 116 # return a list of valid elements
 117 #
 118
 119 sub fields
 120 {
 121         return keys(%valid);
 122 }
 123
 124 #
 125 # return a prompt for a field
 126 #
 127
 128 sub field_prompt
 129 {
 130         my ($self, $ele) = @_;
 131         return $valid{$ele};
 132 }
 133
 134 #no strict;
 135 sub AUTOLOAD
 136 {
 137         no strict;
 138         my $name = $AUTOLOAD;
 139         return if $name =~ /::DESTROY$/;
 140         $name =~ s/^.*:://o;
 141
 142         # this clever line of code creates a subroutine which takes over from autoload
 143         # from OO Perl - Conway
 144         *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
 145         goto &$AUTOLOAD;
 146 }
 147
 148 1;