]> scm.dxcluster.org Git - spider.git/blob - perl/Bands.pm
typo
[spider.git] / perl / Bands.pm
1 #
2 # module to manage the band list
3 #
4 # Copyright (c) 1998 - Dirk Koopman G1TLH
5 #
6 # $Id$
7 #
8
9 package Bands;
10
11 use DXUtil;
12 use DXDebug;
13 use DXVars;
14
15 use strict;
16 use vars qw(%bands %regions %aliases $bandsfn %valid);
17
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";
22
23 %valid = (
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',
36                  );
37
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;
41 $main::build += $VERSION;
42 $main::branch += $BRANCH;
43
44 # load the band data
45 sub load
46 {
47         %bands = ();
48         do $bandsfn;
49         confess $@ if $@;
50 }
51
52 # obtain a band object by callsign [$obj = Band::get($call)]
53 sub get
54 {
55         my $call = shift;
56         my $ncall = $aliases{$call};
57         $call = $ncall if $ncall;
58         return $bands{$call};
59 }
60
61 # obtain all the band objects
62 sub get_all
63 {
64         return values(%bands);
65 }
66
67 # get all the band keys
68 sub get_keys
69 {
70         return keys(%bands);
71 }
72
73 # get all the region keys
74 sub get_region_keys
75 {
76         return keys(%regions);
77 }
78
79 # get all the alias keys
80 sub get_alias_keys
81 {
82         return keys(%aliases);
83 }
84
85 # get a region 
86 sub get_region
87 {
88         my $reg = shift;
89         return $regions{$reg};
90 }
91
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
94
95 # called Bands::get_freq(band-label, subband-label)
96 sub get_freq
97 {
98         my ($band, $subband) = @_;
99         my @band;
100         my $b;
101         my @out;
102         return () if !$band;
103         $subband = 'band' if !$subband;
104   
105         # first look in the region
106         $b = $regions{$band};
107         @band = @$b if $b;
108         @band = ($band) if @band == 0;
109   
110         # we now have a list of bands to scan for sub bands
111         foreach $b (@band) {
112                 my $wb = $bands{$b};
113                 if ($wb) {
114                         my $sb = $wb->{$subband};
115                         push @out, @$sb if $sb;
116                 }
117         }
118         return @out;
119 }
120
121 #
122 # return a list of valid elements 
123
124
125 sub fields
126 {
127         return keys(%valid);
128 }
129
130 #
131 # return a prompt for a field
132 #
133
134 sub field_prompt
135
136         my ($self, $ele) = @_;
137         return $valid{$ele};
138 }
139
140 no strict;
141 sub AUTOLOAD
142 {
143         my $self = shift;
144         my $name = $AUTOLOAD;
145         return if $name =~ /::DESTROY$/;
146         $name =~ s/.*:://o;
147   
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}} ;
151         @_ ? $self->{$name} = shift : $self->{$name} ;
152 }
153
154 1;