2 # module to manage the band list
4 # Copyright (c) 1998 - Dirk Koopman G1TLH
16 use vars qw(%bands %regions %aliases $bandsfn %valid);
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";
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',
38 use vars qw($VERSION $BRANCH);
39 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
40 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
41 $main::build += $VERSION;
42 $main::branch += $BRANCH;
52 # obtain a band object by callsign [$obj = Band::get($call)]
56 my $ncall = $aliases{$call};
57 $call = $ncall if $ncall;
61 # obtain all the band objects
64 return values(%bands);
67 # get all the band keys
73 # get all the region keys
76 return keys(%regions);
79 # get all the alias keys
82 return keys(%aliases);
89 return $regions{$reg};
92 # get all the frequency pairs associated with the band and sub-band offered
93 # the band can be a region, sub-band can be missing
95 # called Bands::get_freq(band-label, subband-label)
98 my ($band, $subband) = @_;
103 $subband = 'band' if !$subband;
105 # first look in the region
106 $b = $regions{$band};
108 @band = ($band) if @band == 0;
110 # we now have a list of bands to scan for sub bands
114 my $sb = $wb->{$subband};
115 push @out, @$sb if $sb;
122 # return a list of valid elements
131 # return a prompt for a field
136 my ($self, $ele) = @_;
144 my $name = $AUTOLOAD;
145 return if $name =~ /::DESTROY$/;
148 # this clever line of code creates a subroutine which takes over from autoload
149 # from OO Perl - Conway
150 *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};