]> www.dxcluster.org Git - spider.git/blob - perl/Bands.pm
Merge branch 'master' of /scm/spider
[spider.git] / perl / Bands.pm
1 #
2 # module to manage the band list
3 #
4 # Copyright (c) 1998 - Dirk Koopman G1TLH
5 #
6 #
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 # load the band data
39 sub load
40 {
41         %bands = ();
42         do $bandsfn;
43         confess $@ if $@;
44 }
45
46 # obtain a band object by callsign [$obj = Band::get($call)]
47 sub get
48 {
49         my $call = shift;
50         my $ncall = $aliases{$call};
51         $call = $ncall if $ncall;
52         return $bands{$call};
53 }
54
55 # obtain all the band objects
56 sub get_all
57 {
58         return values(%bands);
59 }
60
61 # get all the band keys
62 sub get_keys
63 {
64         return keys(%bands);
65 }
66
67 # get all the region keys
68 sub get_region_keys
69 {
70         return keys(%regions);
71 }
72
73 # get all the alias keys
74 sub get_alias_keys
75 {
76         return keys(%aliases);
77 }
78
79 # get a region 
80 sub get_region
81 {
82         my $reg = shift;
83         return $regions{$reg};
84 }
85
86 # get all the frequency pairs associated with the band and sub-band offered
87 # the band can be a region, sub-band can be missing
88
89 # called Bands::get_freq(band-label, subband-label)
90 sub get_freq
91 {
92         my ($band, $subband) = @_;
93         my @band;
94         my $b;
95         my @out;
96         return () if !$band;
97         $subband = 'band' if !$subband;
98   
99         # first look in the region
100         $b = $regions{$band};
101         @band = @$b if $b;
102         @band = ($band) if @band == 0;
103   
104         # we now have a list of bands to scan for sub bands
105         foreach $b (@band) {
106                 my $wb = $bands{$b};
107                 if ($wb) {
108                         my $sb = $wb->{$subband};
109                         push @out, @$sb if $sb;
110                 }
111         }
112         return @out;
113 }
114
115 #
116 # return a list of valid elements 
117
118
119 sub fields
120 {
121         return keys(%valid);
122 }
123
124 #
125 # return a prompt for a field
126 #
127
128 sub field_prompt
129
130         my ($self, $ele) = @_;
131         return $valid{$ele};
132 }
133
134 #no strict;
135 sub AUTOLOAD
136 {
137         no strict;
138         my $name = $AUTOLOAD;
139         return if $name =~ /::DESTROY$/;
140         $name =~ s/^.*:://o;
141   
142         # this clever line of code creates a subroutine which takes over from autoload
143         # from OO Perl - Conway
144         *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
145         goto &$AUTOLOAD;
146 }
147
148 1;