2 # various utilities which are exported globally
4 # Copyright (c) 1998 - Dirk Koopman G1TLH
16 @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf parray parraypairs
17 print_all_fields cltounix
20 @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
22 # a full time for logging and other purposes
26 my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time);
28 my $buf = sprintf "%02d%s%04d\@%02d:%02d:%02d", $mday, $month[$mon], $year, $hour, $min, $sec;
32 # get a zulu time in cluster format (2300Z)
36 my ($sec,$min,$hour) = gmtime((defined $t) ? $t : time);
38 my $buf = sprintf "%02d%02dZ", $hour, $min;
43 # get a cluster format date (23-Jun-1998)
47 my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time);
49 my $buf = sprintf "%2d-%s-%04d", $mday, $month[$mon], $year;
53 # return a cluster style date time
57 my $date = cldate($t);
62 # return a unix date from a cluster date and time
68 return 0 unless $date =~ /^\s*(\d+)-(\w\w\w)-([12][90]\d\d)$/;
70 return 0 unless $time =~ /^([012]\d)([012345]\d)Z$/;
71 $time = "$1:$2 +0000";
72 return str2time("$date $time");
75 # turn a latitude in degrees into a string
79 my ($deg, $min, $let);
80 $let = $n >= 0 ? 'N' : 'S';
83 $min = int ((($n - $deg) * 60) + 0.5);
84 return "$deg $min $let";
87 # turn a longitude in degrees into a string
91 my ($deg, $min, $let);
92 $let = $n >= 0 ? 'E' : 'W';
95 $min = int ((($n - $deg) * 60) + 0.5);
96 return "$deg $min $let";
99 # turn a true into 'yes' and false into 'no'
103 return $n ? $main::yes : $main::no;
106 # format a prompt with its current value and return it with its privilege
109 my ($line, $value) = @_;
110 my ($priv, $prompt, $action) = split ',', $line;
112 # if there is an action treat it as a subroutine and replace $value
114 my $q = qq{\$value = $action(\$value)};
117 $prompt = sprintf "%15s: %s", $prompt, $value;
118 return ($priv, $prompt);
121 # take an arg as an array list and print it
125 return join(', ', @{$ref});
128 # take the arg as an array reference and print as a list of pairs
135 for ($i = 0; $i < @$ref; $i += 2) {
137 my $r2 = @$ref[$i+1];
140 chop $out; # remove last space
141 chop $out; # remove last comma
145 # print all the fields for a record according to privilege
147 # The prompt record is of the format '<priv>,<prompt>[,<action>'
148 # and is expanded by promptf above
152 my $self = shift; # is a dxchan
153 my $ref = shift; # is a thingy with field_prompt and fields methods defined
155 my @fields = $ref->fields;
158 foreach $field (sort @fields) {
159 if (defined $ref->{$field}) {
160 my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field});
161 push @out, $ans if ($self->priv >= $priv);