2 # various utilities which are exported globally
4 # Copyright (c) 1998 - Dirk Koopman G1TLH
13 @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf
17 @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
19 # a full time for logging and other purposes
23 my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time);
25 my $buf = sprintf "%02d%s%04d\@%02d:%02d:%02d", $mday, $month[$mon], $year, $hour, $min, $sec;
29 # get a zulu time in cluster format (2300Z)
33 my ($sec,$min,$hour) = gmtime((defined $t) ? $t : time);
35 my $buf = sprintf "%02d%02dZ", $hour, $min;
40 # get a cluster format date (23-Jun-1998)
44 my ($sec,$min,$hour,$mday,$mon,$year) = gmtime((defined $t) ? $t : time);
46 my $buf = sprintf "%02d-%s-%04d", $mday, $month[$mon], $year;
50 # return a cluster style date time
54 my $date = cldate($t);
59 # turn a latitude in degrees into a string
63 my ($deg, $min, $let);
64 $let = $n >= 0 ? 'N' : 'S';
67 $min = int (($n - $deg) * 60);
68 return "$deg $min $let";
71 # turn a longitude in degrees into a string
75 my ($deg, $min, $let);
76 $let = $n >= 0 ? 'E' : 'W';
79 $min = int (($n - $deg) * 60);
80 return "$deg $min $let";
83 # turn a true into 'yes' and false into 'no'
87 return $n ? $main::yes : $main::no;
90 # format a prompt with its current value and return it with its privilege
93 my ($line, $value) = @_;
94 my ($priv, $prompt, $action) = split ',', $line;
96 # if there is an action treat it as a subroutine and replace $value
98 my $q = qq{\$value = $action(\$value)};
101 $prompt = sprintf "%15s: %s", $prompt, $value;
102 return ($priv, $prompt);
105 # print all the fields for a record according to privilege
107 # The prompt record is of the format '<priv>,<prompt>[,<action>'
108 # and is expanded by promptf above
112 my $self = shift; # is a dxchan
113 my $ref = shift; # is a thingy with field_prompt and fields methods defined
116 my @fields = $ref->fields;
120 foreach $field (sort @fields) {
121 my ($priv, $ans) = promptf($ref->field_prompt($field), $ref->{$field});
122 push @out, $ans if ($self->priv >= $priv);