X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FBands.pm;h=ac3647ea47207b0743c5c5b4a9b7f3dc76aa95a2;hb=48f0cb90d0cfbe3037f353fc25adfc33561634fa;hp=55ac154c358022155833669327c301c18f77c830;hpb=6a0068ec3df1dca0c6ae2714af3c0a4a62998dcf;p=spider.git

diff --git a/perl/Bands.pm b/perl/Bands.pm
index 55ac154c..ac3647ea 100644
--- 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;