From 0e84728de35d2dadbb9d624614a471b68ae9eef6 Mon Sep 17 00:00:00 2001 From: djk Date: Fri, 12 Nov 1999 21:07:05 +0000 Subject: [PATCH] added show sun allow ^Z to terminate a line started remembering DX, WWV, ANN et al settings --- Changes | 3 ++ cmd/Aliases | 2 +- cmd/apropos.pl | 1 + cmd/help.pl | 2 +- cmd/show/sun.pl | 35 +++++++++++++ perl/DXCommandmode.pm | 10 +++- perl/DXMsg.pm | 2 +- perl/DXProt.pm | 4 +- perl/DXUser.pm | 43 +++++++++++++++- perl/Sun.pm | 115 ++++++++++++++++++++++++++++++++++++++++++ perl/cluster.pl | 2 +- 11 files changed, 210 insertions(+), 9 deletions(-) create mode 100644 cmd/show/sun.pl create mode 100644 perl/Sun.pm diff --git a/Changes b/Changes index 140f2bb4..19a866ec 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ +12Nov99======================================================================= +1. added sh/sun command kindly supplied by Steve K9AN. +2. allow ^Z on its own on a line to terminate a message 08Nov99======================================================================= 1. added spoofing (mk1 version) for sysops, useful for those little jobs like reseting a user's qra locator and such like "spoof g7brn set/qra jo02lq". diff --git a/cmd/Aliases b/cmd/Aliases index 6ef3b166..6f9d545d 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -23,7 +23,7 @@ package CmdAlias; %alias = ( '?' => [ - '^\?', 'apropos', 'apropos', + '^\?', 'apropos help', 'apropos', ], 'a' => [ '^ann.*/full', 'announce full', 'announce', diff --git a/cmd/apropos.pl b/cmd/apropos.pl index 26a60e7c..1226a0a7 100644 --- a/cmd/apropos.pl +++ b/cmd/apropos.pl @@ -24,6 +24,7 @@ if (!open($h, "$main::localcmd/Commands_$lang.hlp")) { } my $in; +$line = 'help' unless $line; $line =~ s/\W//og; # remove dubious characters my $include; diff --git a/cmd/help.pl b/cmd/help.pl index f0da2f82..d87de981 100644 --- a/cmd/help.pl +++ b/cmd/help.pl @@ -14,7 +14,7 @@ my ($self, $line) = @_; my @out; # this is naff but it will work for now -$line = "help" if !$line; +$line = "help" unless $line; my $lang = $self->lang; $lang = 'en' if !$lang; diff --git a/cmd/show/sun.pl b/cmd/show/sun.pl new file mode 100644 index 00000000..5104e227 --- /dev/null +++ b/cmd/show/sun.pl @@ -0,0 +1,35 @@ +#!/usr/bin/perl +# +# show sunrise and sunset times for each callsign or prefix entered +# +# 1999/11/9 Steve Franke K9AN +# + +my ($self, $line) = @_; +my @list = split /\s+/, $line; + +my $l; +my @out; +my ($lat, $lon); # lats and longs in radians +my ($sec, $min, $hr, $day, $month, $yr) = (gmtime($main::systime))[0,1,2,3,4,5]; +$month++; +$yr += 1900; + +foreach $l (@list) { + # prefixes ---> + my @ans = Prefix::extract($l); + next if !@ans; + my $pre = shift @ans; + my $a; + foreach $a (@ans) { + $lat = $a->{lat}; + $lon = $a->{long}; + $lat *= $d2r; + $lon *= -$d2r; + my $string=Sun::riseset($yr,$month,$day,$lat,$lon); + push @out,sprintf("%-2s %s %s",$pre,$a->name(),$string); + $l=""; + } +} + +return (1, @out); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index ca6c053e..d17f47e6 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -27,6 +27,7 @@ use Filter; use Carp; use Minimuf; use DXDb; +use Sun; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase); @@ -70,8 +71,13 @@ sub start $self->{consort} = $line; # save the connection type # set some necessary flags on the user if they are connecting - $self->{beep} = $self->{wwv} = $self->{wx} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1; - # $self->prompt() if $self->{state} =~ /^prompt/o; + $self->{beep} = $user->wantbeep; + $self->{ann} = $user->wantann; + $self->{wwv} = $user->wantwwv; + $self->{talk} = $user->wanttalk; + $self->{wx} = $user->wantwx; + $self->{dx} = $user->wantdx; + $self->{here} = 1; # add yourself to the database my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database"; diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 9f4a1d7b..98c41ef1 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -824,7 +824,7 @@ sub do_send_stuff } elsif ($self->state eq 'sendbody') { confess "local var gone missing" if !ref $self->{loc}; my $loc = $self->{loc}; - if ($line eq "\032" || uc $line eq "/EX") { + if ($line eq "\032" || $line eq '%1A' || uc $line eq "/EX") { my $to; if (@{$loc->{lines}} > 0) { diff --git a/perl/DXProt.pm b/perl/DXProt.pm index e433fdc4..d9b03a90 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -720,7 +720,7 @@ sub normal # REBROADCAST!!!! # - if (!$self->{isolate}) { + unless ($self->{isolate}) { broadcast_ak1a($line, $self); # send it to everyone but me } } @@ -743,7 +743,7 @@ sub process if ($t >= $dxchan->pc50_t + $DXProt::pc50_interval) { $dxchan->send(pc50()); $dxchan->pc50_t($t); - } + } } my $key; diff --git a/perl/DXUser.pm b/perl/DXUser.pm index a9c7ea03..a8fb7788 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -49,6 +49,12 @@ $filename = undef; hmsgno => '0,Highest Msgno', group => '0,Access Group,parray', # used to create a group of users/nodes for some purpose or other isolate => '9,Isolate network,yesno', + wantbeep => '0,Rec Beep,yesno', + wantann => '0,Rec Announce,yesno', + wantwwv => '0,Rec WWV,yesno', + wanttalk => '0,Rec Talk,yesno', + wantwx => '0,Rec WX,yesno', + wantdx => '0,Rec DX Spots,yesno', ); no strict; @@ -63,7 +69,6 @@ sub AUTOLOAD confess "Non-existant field '$AUTOLOAD'" if !$valid{$name}; if (@_) { $self->{$name} = shift; - # $self->put(); } return $self->{$name}; } @@ -324,5 +329,41 @@ sub sort my $self = shift; @_ ? $self->{'sort'} = shift : $self->{'sort'} ; } + +# some accessors +sub _want +{ + my $n = shift; + my $self = shift; + my $s = "want$n"; + return $self->{$n} = shift if @_; + return defined $self->{$n} ? $self->{$n} : 1; +} + +sub wantbeep +{ + return _want('beep', @_); +} + +sub wantann +{ + return _want('ann', @_); +} + +sub wantwwv +{ + return _want('wwv', @_); +} + +sub wantwx +{ + return _want('wx', @_); +} + +sub wantdx +{ + return _want('dx', @_); +} + 1; __END__ diff --git a/perl/Sun.pm b/perl/Sun.pm new file mode 100644 index 00000000..10a7f77c --- /dev/null +++ b/perl/Sun.pm @@ -0,0 +1,115 @@ +#!/usr/bin/perl -w +# +# The subroutines "julian_day" and "riseset" written by +# Steve Franke, November 1999. +# +# The formulas used to calculate sunrise and sunset times +# are described in Chapters 7, 12, 15, and 25 of +# Astronomical Algorithms, Second Edition +# by Jean Meeus, 1998 +# Published by Willmann-Bell, Inc. +# P.O. Box 35025, Richmond, Virginia 23235 +# +package Sun; + +use POSIX; + +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw($pi $d2r $r2d ); + +use strict; +use vars qw($pi $d2r $r2d ); + +$pi = 3.141592653589; +$d2r = ($pi/180); +$r2d = (180/$pi); + +sub julian_day +{ + my $year = shift; + my $month = shift; + my $day = shift; + my $julianday; + + $year=$year-1 if( $month <= 2 ); + $month=$month+12 if( $month <= 2); + + $julianday = int(365.25*($year+4716)+int(30.6001*($month+1)))+$day-13-1524.5; + return $julianday; +} + +sub riseset +{ + my $year = shift; + my $month = shift; + my $day = shift; + my $lat = shift; + my $lon = shift; + my $julianday; + + $julianday=julian_day($year,$month,$day); + + my $tt = ($julianday-2451545)/36525.; + + my $theta0=280.46061837+360.98564736629*($julianday-2451545.0)+ + 0.000387933*($tt^2)-($tt^3)/38710000; + $theta0=$theta0-int($theta0/360)*360; + $theta0=$theta0+360 if( $theta0 < 0 ); + + my $L0 = 280.46646+36000.76983*$tt+0.0003032*($tt^2); + $L0=$L0-int($L0/360)*360; + $L0=$L0+360 if( $L0 < 0 ); + + my $M = 357.52911 + 35999.05029*$tt-0.0001537*($tt^2); + $M=$M-int($M/360)*360; + $M=$M+360 if( $M < 0 ); + + my $C = (1.914602 - 0.004817*$tt-0.000014*($tt^2))*sin($M*$d2r) + + (0.019993 - 0.000101*$tt)*sin(2*$M*$d2r) + + 0.000289*sin(3*$M*$d2r); + + my $OMEGA = 125.04 - 1934.136*$tt; + + my $lambda=$L0+$C-0.00569-0.00478*sin($OMEGA*$d2r); + + my $epsilon = 23+26./60.+21.448/(60.*60.); + + my $alpha=atan2(cos($epsilon*$d2r)*sin($lambda*$d2r),cos($lambda*$d2r))*$r2d; + $alpha = $alpha-int($alpha/360)*360; + $alpha=$alpha+360 if ( $alpha < 0 ); + + my $delta=asin(sin($epsilon*$d2r)*sin($lambda*$d2r))*$r2d; + $delta = $delta-int($delta/360)*360; + $delta = $delta+360 if ( $delta < 0 ); + + my $arg = (sin(-.8333*$d2r)-sin($lat)*sin($delta*$d2r))/(cos($lat)*cos($delta*$d2r)); + my $argtest = tan($lat)*tan($delta*$d2r); + + if ( $argtest < -1. ) { + return sprintf("Sun doesn't rise."); + } + if ( $argtest > 1. ) { + return sprintf("Sun doesn't set."); + } + + my $H0 = acos($arg)*$r2d; + + my $transit = ($alpha + $lon*$r2d - $theta0)/360.; + $transit=$transit+1 if( $transit < 0 ); + $transit=$transit-1 if( $transit > 1 ); + + my $rise = $transit - $H0/360.; + $rise=$rise+1 if( $rise < 0 ); + $rise=$rise-1 if( $rise > 1 ); + + my $set = $transit + $H0/360.; + $set=$set+1 if( $set < 0 ); + $set=$set-1 if( $set > 1 ); + + return sprintf("Sunrise: %2.2d%2.2dZ Sunset: %2.2d%2.2dZ",int($rise*24), + ($rise*24-int($rise*24))*60., + int($set*24),($set*24-int($set*24))*60.); +} + +1; diff --git a/perl/cluster.pl b/perl/cluster.pl index 1f011c55..36c2f8bd 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -68,7 +68,7 @@ package main; @inqueue = (); # the main input queue, an array of hashes $systime = 0; # the time now (in seconds) -$version = "1.34"; # the version no of the software +$version = "1.35"; # the version no of the software $starttime = 0; # the starting time of the cluster $lockfn = "cluster.lock"; # lock file name -- 2.34.1