remove Prot.pm, sort %valid fields

[spider.git] / perl / Bands.pm

diff --git a/perl/Bands.pm b/perl/Bands.pm
index 55ac154c358022155833669327c301c18f77c830..ac3647ea47207b0743c5c5b4a9b7f3dc76aa95a2 100644 (file)
--- a/perl/Bands.pm
+++ b/perl/Bands.pm
@@ -3,7 +3,7 @@
 #
 # Copyright (c) 1998 - Dirk Koopman G1TLH
 #
-# $Id$
+#
 #
 
 package Bands;
@@ -11,77 +11,76 @@ package Bands;
 use DXUtil;
 use DXDebug;
 use DXVars;
-use Carp;
 
 use strict;
 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
+%aliases = ();                                 # list of aliases
 $bandsfn = "$main::data/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;
-  my $ncall = $aliases{$call};
-  $call = $ncall if $ncall;
-  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);
+       return keys(%regions);
 }
 
 # get all the alias keys
 sub get_alias_keys
 {
-  return keys(%aliases);
+       return keys(%aliases);
 }
 
 # get a region 
 sub get_region
 {
-  my $reg = shift;
-  return $regions{$reg};
+       my $reg = shift;
+       return $regions{$reg};
 }
 
 # get all the frequency pairs associated with the band and sub-band offered
@@ -90,27 +89,27 @@ sub get_region
 # 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;
 }
 
 #
@@ -119,7 +118,7 @@ sub get_freq
 
 sub fields
 {
-  return keys(%valid);
+       return keys(%valid);
 }
 
 #
@@ -128,19 +127,22 @@ sub fields
 
 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;