]> gb7djk.dxcluster.net Git - spider.git/blob - perl/importwwv.pl
try to fix crashes on AGW with peerhost.
[spider.git] / perl / importwwv.pl
1 #!/usr/bin/perl
2 #
3 # Process and import for mail WWV and Solar Data
4 #
5 # This program takes a mail message on its standard input
6 # and, if it is WWV or Solar info, imports it into the local
7 # spider chat_import queue.
8 #
9 # Both the "tmp" and the "chat_import" directories should be
10 # chmod 1777 
11 #
12 # Copyright (c) 2004 Dirk Koopman G1TLH
13 #
14 #
15 #
16
17 use strict;
18 use Mail::Internet;
19 use Mail::Header;
20
21 our $root;
22
23 # search local then perl directories
24 BEGIN {
25         # root of directory tree for this system
26         $root = "/spider"; 
27         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
28         
29         unshift @INC, "$root/perl";     # this IS the right way round!
30         unshift @INC, "$root/local";
31 }
32
33 my $import = "$root/chat_import";
34 my $tmp = "$root/tmp";
35
36 my $msg = Mail::Internet->new(\*STDIN) or die "Mail::Internet $!";
37 my $head = $msg->head->header_hashref;
38
39 if ($head) {
40         if ($head->{Subject}->[0] =~ /wwv/i) {
41                 process_wwv($msg);
42         } elsif ($head->{From}->[0] =~ /rwc\.boulder/i || $head->{'From '}->[0] =~ /rwc\.boulder/i) {
43                 process_solar($msg);
44         }
45 }
46
47 exit(0);
48
49 sub process_wwv
50 {
51         my $msg = shift;
52         my @out;
53         my $state;
54         
55         foreach (@{$msg->body}) {
56                 next if /^\s*:/;
57                 next if /^\s#/;
58                 next if /^\s*\r?\n$/s;
59                 if (/follow/) {
60                         $state = 1;
61                         next;
62                 }
63                 if ($state) {
64                         my $l = $_;
65                         next if /\bSec\b/i;
66                         $l =~ s/\s*\.?\r?\n$//;
67                         push @out, $l;
68                 }
69         }
70         out(@out) if @out;
71 }
72
73 sub process_solar
74 {
75         my $msg = shift;
76         my @out;
77         my $state;
78         
79         foreach (@{$msg->body}) {
80                 if (!$state && /Space\s+Weather\s+Message\s+Code:/i) {
81                         $state = 1;
82                 }
83                 if ($state == 1 && /^[A-Z]+:/) {
84                         $state = 2;
85                 }
86                 if ($state == 2 && /^\s*\r?\n$/s) {
87                         last;
88                 }
89                 if ($state > 1) {
90                         my $l = $_;
91                         next if /\bSec\b/i;
92                         $l =~ s/\r?\n$//;
93                         push @out, $l;
94                 }
95         }
96         out(@out) if @out;
97 }
98
99 sub out
100 {
101         my $fn = "solar.txt.$$";
102    
103         open OUT, ">$tmp/$fn" or die "import $tmp/$fn $!";
104         chmod 0666, "$tmp/$fn";
105         print OUT map { "$_\n" } @_;
106         close OUT;
107
108         # Note we do this this way to make the appearance of
109         # the file in /spider/chat_import atomic. Otherwise there
110         # exists the possiblity of race conditions and other nasties
111         link "$tmp/$fn", "$import/$fn";
112         unlink "$tmp/$fn";
113 }
114