]> scm.dxcluster.org Git - spider.git/blob - perl/Bands.pm
done more work on directory now really quite ak1a compatible
[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 use Carp;
15
16 use strict;
17 use vars qw(%bands %regions %aliases $bandsfn %valid);
18
19 %bands = ();   # the 'raw' band data
20 %regions = ();  # list of regions for shortcuts eg vhf ssb
21 %aliases = ();  # list of aliases
22 $bandsfn = "$main::data/bands.pl";
23
24 %valid = (
25   cw => '0,CW,parraypairs',
26   ssb => '0,SSB,parraypairs',
27   data => '0,DATA,parraypairs',
28   sstv => '0,SSTV,parraypairs',
29   fstv => '0,FSTV,parraypairs',
30   rtty => '0,RTTY,parraypairs',
31   pactor => '0,PACTOR,parraypairs',
32   packet => '0,PACKET,parraypairs',
33   repeater => '0,REPEATER,parraypairs',
34   fax => '0,FAX,parraypairs',
35   beacon => '0,BEACON,parraypairs',
36   band => '0,BAND,parraypairs',
37 );
38
39 # load the band data
40 sub load
41 {
42   %bands = ();
43   do $bandsfn;
44   confess $@ if $@;
45 }
46
47 # obtain a band object by callsign [$obj = Band::get($call)]
48 sub get
49 {
50   my $call = shift;
51   my $ncall = $aliases{$call};
52   $call = $ncall if $ncall;
53   return $bands{$call};
54 }
55
56 # obtain all the band objects
57 sub get_all
58 {
59   return values(%bands);
60 }
61
62 # get all the band keys
63 sub get_keys
64 {
65   return keys(%bands);
66 }
67
68 # get all the region keys
69 sub get_region_keys
70 {
71   return keys(%regions);
72 }
73
74 # get all the alias keys
75 sub get_alias_keys
76 {
77   return keys(%aliases);
78 }
79
80 # get a region 
81 sub get_region
82 {
83   my $reg = shift;
84   return $regions{$reg};
85 }
86
87 # get all the frequency pairs associated with the band and sub-band offered
88 # the band can be a region, sub-band can be missing
89
90 # called Bands::get_freq(band-label, subband-label)
91 sub get_freq
92 {
93   my ($band, $subband) = @_;
94   my @band;
95   my $b;
96   my @out;
97   return () if !$band;
98   $subband = 'band' if !$subband;
99   
100   # first look in the region
101   $b = $regions{$band};
102   @band = @$b if $b;
103   @band = ($band) if @band == 0;
104   
105   # we now have a list of bands to scan for sub bands
106   foreach $b (@band) {
107     my $wb = $bands{$b};
108         if ($wb) {
109           my $sb = $wb->{$subband};
110           push @out, @$sb if $sb;
111         }
112   }
113   return @out;
114 }
115
116 #
117 # return a list of valid elements 
118
119
120 sub fields
121 {
122   return keys(%valid);
123 }
124
125 #
126 # return a prompt for a field
127 #
128
129 sub field_prompt
130
131   my ($self, $ele) = @_;
132   return $valid{$ele};
133 }
134
135 no strict;
136 sub AUTOLOAD
137 {
138   my $self = shift;
139   my $name = $AUTOLOAD;
140   return if $name =~ /::DESTROY$/;
141   $name =~ s/.*:://o;
142   
143   @_ ? $self->{$name} = shift : $self->{$name} ;
144 }
145
146 1;