#
# Copyright (c) 1998 - Dirk Koopman G1TLH
#
-# $Id$
+#
#
package Bands;
use DXUtil;
use DXDebug;
use DXVars;
-use Carp;
use strict;
-use vars qw(%bands %regions $bandsfn %valid);
+use vars qw(%bands %regions %aliases $bandsfn %valid);
+
+%bands = (); # the 'raw' band data
+%regions = (); # list of regions for shortcuts eg vhf ssb
+%aliases = (); # list of aliases
-%bands = (); # the 'raw' band data
-%regions = (); # list of regions for shortcuts eg vhf ssb
-$bandsfn = "$main::data/bands.pl";
+$bandsfn = localdata("bands.pl");
%valid = (
- cw => '0,CW,parraypairs',
- ssb => '0,SSB,parraypairs',
- data => '0,DATA,parraypairs',
- sstv => '0,SSTV,parraypairs',
- fstv => '0,FSTV,parraypairs',
- rtty => '0,RTTY,parraypairs',
- pactor => '0,PACTOR,parraypairs',
- packet => '0,PACKET,parraypairs',
- repeater => '0,REPEATER,parraypairs',
- fax => '0,FAX,parraypairs',
- beacon => '0,BEACON,parraypairs',
- band => '0,BAND,parraypairs',
-);
+ band => '0,BAND,parraypairs',
+ beacon => '0,BEACON,parraypairs',
+ cw => '0,CW,parraypairs',
+ data => '0,DATA,parraypairs',
+ fax => '0,FAX,parraypairs',
+ fstv => '0,FSTV,parraypairs',
+ packet => '0,PACKET,parraypairs',
+ pactor => '0,PACTOR,parraypairs',
+ repeater => '0,REPEATER,parraypairs',
+ rtty => '0,RTTY,parraypairs',
+ ssb => '0,SSB,parraypairs',
+ sstv => '0,SSTV,parraypairs',
+ );
# load the band data
sub load
{
- %bands = ();
- do $bandsfn;
- confess $@ if $@;
+ %bands = ();
+ do $bandsfn;
+ confess $@ if $@;
}
# obtain a band object by callsign [$obj = Band::get($call)]
sub get
{
- my $call = shift;
- return $bands{$call};
+ my $call = shift;
+ my $ncall = $aliases{$call};
+ $call = $ncall if $ncall;
+ return $bands{$call};
}
# obtain all the band objects
sub get_all
{
- return values(%bands);
+ return values(%bands);
}
# get all the band keys
sub get_keys
{
- return keys(%bands);
+ return keys(%bands);
+}
+
+# get all the region keys
+sub get_region_keys
+{
+ return keys(%regions);
+}
+
+# get all the alias keys
+sub get_alias_keys
+{
+ return keys(%aliases);
+}
+
+# get a region
+sub get_region
+{
+ my $reg = shift;
+ return $regions{$reg};
}
# get all the frequency pairs associated with the band and sub-band offered
# called Bands::get_freq(band-label, subband-label)
sub get_freq
{
- my ($band, $subband) = @_;
- my @band;
- my $b;
- my @out;
- return () if !$band;
- $subband = 'band' if !$subband;
+ my ($band, $subband) = @_;
+ my @band;
+ my $b;
+ my @out;
+ return () if !$band;
+ $subband = 'band' if !$subband;
- # first look in the region
- $b = $regions{$band};
- @band = @$b if $b;
- @band = ($band) if @band == 0;
+ # first look in the region
+ $b = $regions{$band};
+ @band = @$b if $b;
+ @band = ($band) if @band == 0;
- # we now have a list of bands to scan for sub bands
- foreach $b (@band) {
- my $wb = $bands{$b};
- if ($wb) {
- my $sb = $wb->{$subband};
- push @out, @$sb if $sb;
+ # we now have a list of bands to scan for sub bands
+ foreach $b (@band) {
+ my $wb = $bands{$b};
+ if ($wb) {
+ my $sb = $wb->{$subband};
+ push @out, @$sb if $sb;
+ }
}
- }
- return @out;
+ return @out;
}
#
sub fields
{
- return keys(%valid);
+ return keys(%valid);
}
#
sub field_prompt
{
- my ($self, $ele) = @_;
- return $valid{$ele};
+ my ($self, $ele) = @_;
+ return $valid{$ele};
}
-no strict;
+#no strict;
sub AUTOLOAD
{
- my $self = shift;
- my $name = $AUTOLOAD;
- return if $name =~ /::DESTROY$/;
- $name =~ s/.*:://o;
+ no strict;
+ my $name = $AUTOLOAD;
+ return if $name =~ /::DESTROY$/;
+ $name =~ s/^.*:://o;
- @_ ? $self->{$name} = shift : $self->{$name} ;
+ # this clever line of code creates a subroutine which takes over from autoload
+ # from OO Perl - Conway
+ *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+ goto &$AUTOLOAD;
}
1;