]> dxcluster.net Git - spider.git/blob - perl/process_ursa.pl
add CTY-2704 changes
[spider.git] / perl / process_ursa.pl
1 #!/usr/bin/perl
2 #
3 # Process and import for mail SIDC Ursagrams
4 #
5 # This program takes a mail message on its standard input
6 # and, if it is an URSIGRAM, imports it into the local
7 # spider msg queue.
8 #
9 # Copyright (c) 2004 Dirk Koopman G1TLH
10 #
11 #
12 #
13
14 use strict;
15 use Mail::Internet;
16 use Mail::Header;
17
18 our $root;
19
20 # search local then perl directories
21 BEGIN {
22         # root of directory tree for this system
23         $root = "/spider"; 
24         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
25         
26         unshift @INC, "$root/perl";     # this IS the right way round!
27         unshift @INC, "$root/local";
28 }
29
30 my $import = "$root/msg/import";
31 my $tmp = "$root/tmp";
32
33 my $msg = Mail::Internet->new(\*STDIN) or die "Mail::Internet $!";
34 my $head = $msg->head->header_hashref;
35 my $fromcall = shift || 'G1TLH';
36
37 if ($head && $head->{From}->[0] =~ /sidc/i && $head->{Subject}->[0] =~ /Ursigram/i) {
38         my $body = $msg->body;
39         my $title = 'SIDC Ursigram';
40         my $date = '';
41         foreach my $l (@$body) {
42                 if ($l =~ /SIDC\s+SOLAR\s+BULLETIN\s+(\d+)\s+(\w+)\s+20(\d\d)/) {
43                         $date = "$1$2$3";
44                         $title .= " $date";
45                         last;
46                 }
47         }
48         my $fn = "ursigram$date.txt.$$"; 
49         open OUT, ">$tmp/$fn" or die "import $tmp/$fn $!";
50         print OUT "SB ALL < $fromcall\n$title\n";
51         print OUT map {s/\r\n$/\n/; $_} @$body;
52         print OUT "/ex\n";
53         close OUT;
54         link "$tmp/$fn", "$import/$fn";
55         unlink "$tmp/$fn";
56 }
57
58 exit(0);