A
download Bands.pm
Language: Perl
Copyright: (c) 1998 - Dirk Koopman G1TLH
LOC: 102
Project Info
DXSpider DX Cluster System(dxspider)
Server: SourceForge
Type: cvs
...pider\dxspider\spider\perl\
   AGWConnect.pm
   AGWMsg.pm
   AnnTalk.pm
   BadWords.pm
   Bands.pm
   BBS.pm
   Buck.pm
   call.pl
   callbot.pl
   Chain.pm
   cluster.pl
   CmdAlias.pm
   connect.pl
   console.pl
   Console.pm
   convert_users.pl
   convkeps.pl
   create_prefix.pl
   create_qsl.pl
   create_sysop.pl
   create_usdb.pl
   DB0SDX.pm
   DXBearing.pm
   dxcc.pl
   DXChannel.pm
   DXCommandmode.pm
   DXConnect.pm
   DXCron.pm
   DXDb.pm
   DXDebug.pm
   DXDupe.pm
   DXHash.pm
   DXLog.pm
   DXLogPrint.pm
   DXM.pm
   DXMsg.pm
   dxoldtonew.pl
   DXProt.pm
   DXProtout.pm
   DXProtVars.pm
   DXSql.pm
   DXUser.pm
   DXUtil.pm
   DXVars.pm.issue
   DXXml.pm
   Editable.pm
   export_opernam.pl
   ExtMsg.pm
   Filter.pm
   ForkingServer.pm
   gen_usdb_data.pl
   Geomag.pm
   hlptohtml.pl
   importkeps.pl
   importwwv.pl
   Internet.pm
   IntMsg.pm
   Investigate.pm
   IsoTime.pm
   Julian.pm
   K4UTE.pm
   Keps.pm
   Listeners.pm
   Local.pm
   lock_nodes.pl
   log2csv.pl
   LRU.pm
   Minimuf.pm
   MiscLog.pm
   Mrtg.pm
   Msg.pm
   PC.pm
   Prefix.pm
   process_ursa.pl
   Prot.pm
   proto.html
   QRZ.pm
   QSL.pm
   RingBuf.pm
   Route.pm
   RouteDB.pm
   Script.pm
   Spot.pm
   spot2csv.pl
   Sun.pm
   talias.pl
   Thingy.pm
   Timer.pm
   UDPMsg.pm
   update_sysop.pl
   USDB.pm
   VE7CC.pm
   Verify.pm
   WCY.pm
   winclient.pl
   y2k.sh

#
# module to manage the band list
#
# Copyright (c) 1998 - Dirk Koopman G1TLH
#
# $Id: Bands.pm,v 1.10 2003/01/16 03:54:06 minima Exp $
#

package Bands;

use DXUtil;
use DXDebug;
use DXVars;

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
$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',
		 );

use vars qw($VERSION $BRANCH);
$VERSION = sprintf( "%d.%03d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/ );
$BRANCH = sprintf( "%d.%03d", q$Revision: 1.10 $ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
$main::build += $VERSION;
$main::branch += $BRANCH;

# load the band data
sub load
{
	%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};
}

# obtain all the band objects
sub get_all
{
	return values(%bands);
}

# get all the band keys
sub get_keys
{
	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
# the band can be a region, sub-band can be missing
# 
# 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;
  
	# 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;
		}
	}
	return @out;
}

#
# return a list of valid elements 
# 

sub fields
{
	return keys(%valid);
}

#
# return a prompt for a field
#

sub field_prompt
{ 
	my ($self, $ele) = @_;
	return $valid{$ele};
}

#no strict;
sub AUTOLOAD
{
	no strict;
	my $name = $AUTOLOAD;
	return if $name =~ /::DESTROY$/;
	$name =~ s/^.*:://o;
  
	# 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;

About Koders | Resources | Downloads | Support | Black Duck | Terms of Service | DMCA | Privacy Policy | Contact Us