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 # $Id$
  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);