#!/usr/bin/perl

########################################################################
# metaf.pl -- CGI wrapper script to display METAR/TAF/SYNOP conversion results
#
# copyright (c) metaf2xml 2006-2007
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
########################################################################

########################################################################
# some things strictly perl
########################################################################
use strict;
use warnings;

=head1 NAME

metaf.pl -- CGI wrapper script to fetch, decode, and display METAR, TAF, and
SYNOP weather information

=head1 SYNOPSIS

as a standalone script:

  metaf.pl 'type_metaf=...&type_synop=...&lang=...&format=...&src_metaf=...&src_synop=...&mode=...&msg_metaf=...&msg_synop=...'

or with HTML:

  <form method="post" action="metaf.pl">
   <input name="type_metaf" ... >
   <input name="type_synop" ... >
   <input name="lang" ... >
   <input name="format" ... >
   <input name="src_metaf" ... >
   <input name="src_synop" ... >
   <input name="mode" ... >
   <input name="msg_metaf" ... >
   <input name="msg_synop" ... >
  </form>

=head1 DESCRIPTION

  Note: This manual is valid for version 1.29 of metaf2xml.

This CGI script provides a web interface to (optionally) fetch up-to-date
weather information (METAR, TAF, or SYNOP messages) from the Internet or a file,
decode it, store it as XML, and display it as HTML or text.
It can be used with GET or POST methods.

=head1 DEPENDENCIES

The module C<CGI> and the program C<metaf2xml.pl> are required.

To convert the XML to text or HTML, either the program C<xsltproc> (or
equivalent programs) or an XML capable HTTP client is required.

=head1 PARAMETERS

The following CGI parameters are recognised:

=over

=item B<type_metaf>

type of METAR/TAF message to be parsed: metar (default), taf, icao (to fetch)

=item B<type_synop>

type of SYNOP message to be parsed: synop (default), wmo (to fetch)

=item B<lang>

language for output of script and display of parsed message: de (default), en,
es, ru

=item B<format>

output format: html (default), text, or xml (with style sheet reference)

=item B<src_metaf>

source for METAR/TAR messages to be fetched: noaa (default), adds, addsds,
file (forced automatically if F</tmp/metar.txt> exists)

=item B<src_synop>

source for SYNOP messages to be fetched: nws_land (default), cod,
file (forced automatically if F</tmp/synop.txt> exists)

=item B<mode>

which messages to fetch and how to display: latest/detailed (default),
all/summary

=item B<msg_metaf>

METAR/TAF message to be processed

=item B<msg_synop>

SYNOP message to be processed

=back

=cut

use CGI qw/:standard -no_xhtml/;

#
# restrict use of CGI:
#

# uploads are not allowed
$CGI::DISABLE_UPLOADS = 1;

=pod

The length of the body of the POST request (not the length of query string of
the URL) is restricted to 600 bytes.

=cut

$CGI::POST_MAX = 600;

=pod

The following directories and files are used by the script and can be adapted to
local needs by modifying the script (e.g. during install):

=over

=item B<$METAF2XML_BIN>

directory where the C<metaf2xml.pl> is expected (default: C</opt/metaf2xml/bin>)

=item B<$METAF2XML_XSL>

directory where the XSL scripts are located (default: C</opt/metaf2xml/share>)

=item B<$CGI_DATA_DIR>

directory for the local copies of messages (default: C</tmp>)

=item B<$CGI_TMP_DIR>

directory for the temporary XML file (default: C</tmp>)

=item B<$CURL>

path and options for C<curl> (default: C<curl -sSf --stderr ->)

=item B<$CURL_PROXY_OPTS>

options for C<curl> if a HTTP proxy should be used (default: empty)

=back

=cut

########################################################################
# config section, possibly changed by install
########################################################################
my $METAF2XML_BIN = '/opt/metaf2xml/bin';
my $METAF2XML_XSL = '/opt/metaf2xml/share';
my $CGI_DATA_DIR = '/tmp';
my $CGI_LOG_FILE = '/tmp/metaf2xml.log';
my $CGI_TMP_DIR = '/tmp';
my $CURL = 'curl -sSf --stderr -';
my $CURL_PROXY_OPTS = '';

my $re_report_type_SYNOP = '(?:S[IMN])';

#
# filter line(s) for $wmoid from file of type SYNOP
#
sub process_synop_file {
    my ($wmoid, $mode) = @_;
    my ($filename, @arr);

    $filename = "$CGI_DATA_DIR/synop.txt";
    if (!open(FP, $filename)) {
        return ("$wmoid - ERROR - " . uc "$filename - $!");
    }

    $wmoid =~ s/ /|/g;
    $wmoid =~ s/$re_report_type_SYNOP-//g;

    while (<FP>) {
        if (/^(AAXX .{5}|(BB|OO)XX) $wmoid /) {
            my $id;
            $id = ($_ =~ /^(?:AAXX .{5}|(?:BB|OO)XX) ([A-Z0-9]{3,})/)[0];
            # remove existing entries with same $wmoid from @arr
            if ($mode eq 'summary') {
                @arr = grep { /^$_$/ } @arr;
            } else {
                @arr = grep { !/^(AAXX .{5}|(BB|OO)XX) $id / } @arr;
            }

            # add new entry
            unshift @arr, $_;
        }
    }
    close FP;
    return @arr;
}

#
# fetch line(s) for $wmoid from NOAA/NWS
#
sub process_noaa_nws {
    my ($wmoid, $type, $mode) = @_;
    my ($response, $url, %msg_found, @arr);
    my $re_day = '(?:[0-2][0-9]|3[01])';
    my $re_hour = '(?:[01][0-9]|2[0-3])';
    my $re_header = '^(?:AAXX '. $re_day . $re_hour . '[0134]|BBXX|OOXX)';

    # fetch directory listing
    $url = 'http://weather.noaa.gov/pub/SL.us008001/DF.an/'
           . ($type eq 'nws_land' ? 'DC.sflnd/DS.synop' : 'DC.sfmar/DS.ships');

    if (!open(FP, "$CURL $CURL_PROXY_OPTS $url/ls-lt || echo ERROR |")) {
        return ("$wmoid - ERROR - " . uc $!);
    }
    {
        local $/;
        $response = <FP>;
    }
    close FP;
    $wmoid =~ s/ /|/g;
    # one file every 5 min. => 37 files = at least 3h
    for my $file (($response =~ /(?: (sn.[0-9]{4}.txt))/g)[0..36]) {
        my ($state, $report_type, $header, $msg);

        last unless defined $file;
        if ($mode ne 'summary') {
            my $all_found;

            $all_found = 1;
            for (split /[|]/, $wmoid) {
                $all_found = 0 unless exists $msg_found{$_};
            }
            last if $all_found;
        }

        if (!open(FP, "$CURL $CURL_PROXY_OPTS $url/$file || echo ERROR |")) {
            return ("$wmoid - ERROR - " . uc $!);
        }
        $state = '';
        while (<FP>) {
            s/[\n\r]+//g;

            if (/NIL=$/) {
                next;
            } elsif (/####[0-9]{9}####$/) {
                $state = 'SOM';
            } elsif ($state eq 'SOM' && /^($re_report_type_SYNOP)[A-Z]{2}[0-9]{2} /o){
                $state = 'Sx';
                $report_type = $1;
            } elsif ($state =~ 'Sx' && /($re_header) *(?:(.+))?/o) {
                $state = 'STARTED';
                if (defined $2) {
                    $msg = "$1 $2 ";
                    $header = '';
                } else {
                    $msg = '';
                    $header = "$1 ";
                }
            } elsif ($state eq 'STARTED' && /^ *(.*)=$/) {
                my ($id, $report_type_id);

                $msg = "$header$msg$1";
                $msg =~ s/  */ /g;
                $msg =~ s/[ =]*$//;
                $id = ($msg =~ /^(?:AAXX .{5}|(?:BB|OO)XX) ([A-Z0-9]{3,})/)[0];
                $report_type_id = $report_type . '-' . $id if defined $id;
                if (   defined $id
                    && $id =~ /^($wmoid)$/
                    && (   $mode eq 'summary'
                        || !exists $msg_found{$id}
                        || $msg_found{$id} eq $file))
                {
                    if ($mode eq 'summary') {
                        @arr = grep { $_ ne $msg } @arr;
                    } else {
                        @arr = grep { !/^(AAXX .{5}|(BB|OO)XX) $id / } @arr;
                    }

                    # add new entry
                    push @arr, $msg;
                    $msg_found{$id} = $file;
                }
                if (   defined $id
                    && $report_type_id =~ /^($wmoid)$/
                    && (   $mode eq 'summary'
                        || !exists $msg_found{$report_type_id}
                        || $msg_found{$report_type_id} eq $file))
                {
                    $msg = $report_type . '-' . $msg;
                    if ($mode eq 'summary') {
                        @arr = grep { $_ ne $msg } @arr;
                    } else {
                        @arr = grep { !/^$report_type-(AAXX .{5}|(BB|OO)XX) $id / } @arr;
                    }

                    # add new entry
                    push @arr, $msg;
                    $msg_found{$report_type_id} = $file;
                }
                $msg = '';
            } elsif ($state eq 'STARTED' && /^ *(.+)/) {
                $msg .= $1 . ' ';
            }
        }
        close FP;
    }
    return @arr;
}

#
# fetch line(s) for $wmoid from College of DuPage
#
sub process_cod {
    my ($wmoid, $mode) = @_;
    my ($response, $url, $now, %msg_found, @arr);
    my $re_day = '(?:[0-2][0-9]|3[01])';
    my $re_hour = '(?:[01][0-9]|2[0-3])';
    my $re_header = '^(?:AAXX  ?'. $re_day . $re_hour . '[0134]|BBXX|OOXX)';

    $url = 'http://weather.cod.edu/digatmos/syn';
    $now = time();

    # one file every hour => 4 files = at least 3h
    $wmoid =~ s/ /|/g;
    for (0..3) {
        my ($file, @date_arr, $state, $report_type, $header, $msg);

        if ($mode ne 'summary') {
            my $all_found;

            $all_found = 1;
            for (split /[|]/, $wmoid) {
                $all_found = 0 unless exists $msg_found{$_};
            }
            last if $all_found;
        }

        @date_arr = (gmtime($now - $_ * 60 * 60))[5, 4, 3, 2];
        $date_arr[0] %= 100; # year is offset to 1900, need 2 digits, only
        $date_arr[1]++;      # month starts from 0
        $file = sprintf "%02d%02d%02d%02d.syn", @date_arr;
        if (!open(FP, "$CURL $CURL_PROXY_OPTS $url/$file || echo ERROR |")) {
            return ("$wmoid - ERROR - " . uc $!);
        }
        $state = '';
        while (<FP>) {
            s/[\n\r]+//g;

            if (/NIL=$/) {
                next;
            } elsif (/^[0-9]{3} $/) {
                $state = 'SOM';
            } elsif ($state eq 'SOM' && /^($re_report_type_SYNOP)[A-Z]{2}[0-9]{2} /o){
                $state = 'Sx';
                $report_type = $1;
            } elsif ($state eq 'Sx' && /($re_header) *(?:(.+))?/o) {
                $state = 'STARTED';
                if (defined $2) {
                    $msg = "$1 $2 ";
                    $header = '';
                } else {
                    $msg = '';
                    $header = "$1 ";
                }
            } elsif ($state eq 'STARTED' && /^ *(.*)=$/) {
                my ($id, $report_type_id);

                $msg = "$header$msg$1";
                $msg =~ s/  */ /g;
                $msg =~ s/[ =]*$//;
                $id = ($msg =~ /^(?:AAXX .{5}|(?:BB|OO)XX) ([A-Z0-9]{3,})/)[0];
                $report_type_id = $report_type . '-' . $id if defined $id;
                if (   defined $id
                    && $id =~ /^($wmoid)$/
                    && (   $mode eq 'summary'
                        || !exists $msg_found{$id}
                        || $msg_found{$id} eq $file))
                {
                    if ($mode eq 'summary') {
                        @arr = grep { $_ ne $msg } @arr;
                    } else {
                        @arr = grep { !/^(AAXX .{5}|(BB|OO)XX) $id / } @arr;
                    }

                    # add new entry
                    push @arr, $msg;
                    $msg_found{$id} = $file;
                }
                if (   defined $id
                    && $report_type_id =~ /^($wmoid)$/
                    && (   $mode eq 'summary'
                        || !exists $msg_found{$report_type_id}
                        || $msg_found{$report_type_id} eq $file))
                {
                    $msg = $report_type . '-' . $msg;
                    if ($mode eq 'summary') {
                        @arr = grep { $_ ne $msg } @arr;
                    } else {
                        @arr = grep { !/^$report_type-(AAXX .{5}|(BB|OO)XX) $id / } @arr;
                    }

                    # add new entry
                    push @arr, $msg;
                    $msg_found{$report_type_id} = $file;
                }
                $msg = '';
            } elsif ($state eq 'STARTED' && /^ *(.+)/) {
                $msg .= $1 . ' ';
            }
        }
        close FP;
    }
    return @arr;
}

#
# filter line(s) for $icao from file of type $type
#
sub process_metaf_file {
    my ($icao, $type, $mode) = @_;
    my ($filename, $after_eof, $msg, @arr);

    $filename = "$CGI_DATA_DIR/$type.txt";
    if (!open(FP, $filename)) {
        return ("$icao - ERROR - " . uc "$filename - $!");
    }

    $icao =~ s/ /|/g;

    $after_eof = 0;
    $msg = '';
    while (!$after_eof) {
        $_ = <FP> unless $after_eof;
        if (!defined $_) {
            $after_eof = 1;
            $_ = '';
        } else {
            s/[\n\r]+//g;
        }
        if (/^ *$/) { # end of message?
            $msg =~ s/ +/ /g;
            $msg =~ s/ $//g;
            if ($msg =~ /^(?:METAR |SPECI |TAF (?:AMD )?)?($icao) /) {
                my $id = $1;

                $msg =~ s/^(?:METAR |SPECI |TAF )//;
                # remove existing entries with same $id from @arr
                if ($mode eq 'summary') {
                    @arr = grep { $_ ne $msg } @arr;
                } else {
                    @arr = grep { !/^(?:AMD )?$id / } @arr;
                }

                # add new entry
                unshift @arr, $msg;
            }
            $msg = '';
        } elsif (/^[^0-9]/) { # start of message?
            $msg .= $_;
        }
    }
    close FP;
    return @arr;
}

#
# fetch line(s) for $icao from NOAA/IWS
#
sub process_noaa_iws {
    my ($icao, $type, $mode) = @_;
    my ($response, $url);

    return () if $mode eq 'summary' && $type ne 'metar';

    $icao =~ s/ /+/g;

    $url = 'http://weather.noaa.gov/cgi-bin/mget' . $type . '.pl?cccc=';

    if (!open(FP, "$CURL $CURL_PROXY_OPTS $url'$icao' || echo ERROR |")) {
        return ("$icao - ERROR - " . uc $!);
    }
    {
        local $/;
        $response = <FP>;
    }
    close FP;
    if ($response =~ /ERROR/) {
        $response =~ s/[\n\r]+/ /g;
        return ("$icao - ERROR - " . uc "$url - $response");
    }
    $response =~ s/[\n\r]+/ /g;
    $response =~ s/ +/ /g;
    return $response =~ /<font face=.couri[^>]*?> *(?:<pre>)? *(?:METAR|SPECI|TAF)? *([^<]+)/go;
}

#
# fetch line(s) for $icao from NOAA/ADDS
#
sub process_noaa_adds {
    my ($icao, $mode) = @_;
    my ($response, $url, $data);

    $icao =~ s/ /+/g;

    $url  = 'http://adds.aviationweather.gov/metars/';
    $data = 'std_trans=standard&chk_metars=on&hoursStr=' . ($mode eq 'summary' ? 'past 36 hours': 'most+recent+only') . '&chk_tafs=on&submitmet=Submit&station_ids=';

    if (!open(FP, "$CURL $CURL_PROXY_OPTS -d '$data$icao' $url || echo ERROR |"))
    {
        return ("$icao - ERROR - " . uc $!);
    }
    {
        local $/;
        $response = <FP>;
    }
    close FP;
    if ($response =~ /ERROR/) {
        $response =~ s/[\n\r]+/ /g;
        return ("$icao - ERROR - " . uc "$url - $response");
    }
    $response =~ s/[\n\r]+//g;
    $response =~ s/ +/ /g;
    $response =~ s/(<font face=.mono[^>]*?>)/$1METAR /igo;
    $response =~ s/(<pre>)/$1TAF /igo;
    return $response =~ /(?:<font face=.mono[^>]*?>|<pre>)([^<]+)/igo;
}

#
# fetch line(s) for $icao from NOAA/ADDS dataserver
#
sub process_noaa_addsds {
    my ($icao, $type, $mode) = @_;
    my ($response, $url);
    my (%issue_time, @raw_text, %metar, %taf);

    return () if $mode eq 'summary' && $type ne 'metar';

    $icao =~ s/ /,/g;

    $url = 'http://weather.aero/dataserver1_2/httpparam?requestType=retrieve&format=xml&dataSource=';
    if ($type eq 'metar') {
        $url .= 'metars&fields=raw_text,station_id,observation_time,metar_type&hoursBeforeNow=' . ($mode eq 'summary' ? '72' : '4');
    } else {
        $url .= 'tafs&fields=raw_text,station_id,issue_time,valid_time_from,valid_time_to&hoursBeforeNow=0&timeType=valid';
    }
    $url .= '&stationString=';

    if (!open(FP, "$CURL $CURL_PROXY_OPTS '$url$icao' || echo ERROR |")) {
        return ("$icao - ERROR - " . uc $!);
    }
    {
        local $/;
        $response = <FP>;
    }
    close FP;
    if ($response =~ /ERROR/) {
        $response =~ s/[\n\r]+/ /g;
        return ("$icao - ERROR - " . uc "$url - $response");
    }
    $response =~ s/[\n\r]+/ /g;
    $response =~ s/ +/ /g;
    if ($type eq 'metar') {
        # copy to hash, key is observation_time
        for ($response =~ /<((?:raw_text|station_id|observation_time|metar_type)>[^<]+)/igo)
        {
            /^([^>]+).(.*)/;
            if ($1 eq 'raw_text') {
                if (scalar keys %metar eq 4) {
                    my $key = $mode eq 'summary'
                              ? $metar{raw_text}
                              : "$metar{station_id},$metar{metar_type}";
                    if (   !exists $issue_time{$key}
                        || $issue_time{$key} lt $metar{observation_time})
                    {
                        $issue_time{$key} = $metar{observation_time};
                        $metar{raw_text} =~ s/^(?:METAR |SPECI )?/SPECI /
                            if $metar{metar_type} eq 'SPECI';

                        if ($metar{metar_type} eq 'METAR' || $mode eq 'summary')
                        {
                            push @raw_text, $metar{raw_text};
                        # not summary: add SPECI only if there is no METAR yet
                        } elsif (!exists $issue_time{"$metar{station_id},METAR"})
                        {
                            push @raw_text, $metar{raw_text};
                        }
                    }
                }
                %metar = ();
            }
            $metar{$1} = $2;
        }
        for ($response =~ /(<error>[^<]+)/igo) {
            /^([^>]+).(.*)/;
            push @raw_text, "$icao - ERROR - " . uc $2;
        }
        return @raw_text;
    }

    # copy to hash, key is issue_time
    for ($response =~ /<((?:raw_text|station_id|issue_time|valid_time_from|valid_time_to)>[^<]+)/igo)
    {
        /^([^>]+).(.*)/;
        if ($1 eq 'raw_text') {
            if (scalar keys %taf eq 5) {
                my $hours;
                $taf{valid_time_to} =~ s/.*T(..).*/$1/;
                $taf{valid_time_from} =~ s/.*T(..).*/$1/;
                $hours = $taf{valid_time_to} - $taf{valid_time_from};
                $hours += 24 if $hours < 0;
                my $key = "$taf{station_id},$hours";
                if (   !exists $issue_time{$key}
                    || $issue_time{$key} lt $taf{issue_time})
                {
                    $issue_time{$key} = $taf{issue_time};
                    push @raw_text, "$hours,$taf{raw_text}";
                }
            }
            %taf = ();
        }
        $taf{$1} = $2;
    }

    return @raw_text;
}

=pod

If there are any CGI errors the type of error is reported and the script
terminates.

=cut

if (cgi_error()) {
    print header({ status => cgi_error() }) .
        start_html({ title => cgi_error() }) . "\n" .
        b(cgi_error()) . "\n" .
        end_html();
    exit 0;
}

=pod

All parameters are checked to have one of the allowed values.

=cut

#
# determine type_metaf from request (default: metar)
#
my $type_metaf = param('type_metaf');
$type_metaf = 'metar'
    unless defined $type_metaf && ($type_metaf eq 'taf' || $type_metaf eq 'icao');

#
# determine type_synop from request (default: synop)
#
my $type_synop = param('type_synop');
$type_synop = 'synop' unless defined $type_synop && $type_synop eq 'wmo';

=pod

If the parameter C<lang> is not set the first allowed value of the HTTP header
C<Accept-Language> is used.

=cut

#
# determine language from request, browser header (default: de)
#
my $lang = param('lang');
if (!defined $lang) {
    my $accept_lang = http('Accept-Language');
    if (defined $accept_lang) {
        for (split(/,/, $accept_lang)) {
            last if $_ =~ /^de/i;
            if ($_ =~ /^en/i) {
                $lang = 'en';
                last;
            }
            if ($_ =~ /^es/i) {
                $lang = 'es';
                last;
            }
            if ($_ =~ /^ru/i) {
                $lang = 'ru';
                last;
            }
        }
    }
}
$lang = 'de'
    unless defined $lang && ($lang eq 'en' || $lang eq 'es' || $lang eq 'ru');

#
# determine format from request (default: html)
#
my $format = param('format');
$format = 'html'
    unless defined $format && ($format eq 'text' || $format eq 'xml');

#
# determine mode from request (default: latest)
#
my $mode = param('mode');
$mode = 'latest' unless defined $mode && $mode eq 'summary';

=pod

The parameters C<msg_metaf> and C<msg_synop> are truncated to 500 characters.
Letters are converted to upper case. Any characters that are not allowed in a
message are removed.

=cut

my $msg_metaf = param('msg_metaf') ? substr(param('msg_metaf'), 0, 500) : '';
$msg_metaf = uc $msg_metaf;
$msg_metaf =~ s/[^ -~]//gos; # avoid invalid XML and HTML

my $msg_synop = param('msg_synop') ? substr(param('msg_synop'), 0, 500) : '';
$msg_synop = uc $msg_synop;
$msg_synop =~ s/[^ -~]//gos; # avoid invalid XML and HTML

#
# determine sources from request
#
my ($src_metaf, $src_synop);
if (-f "$CGI_DATA_DIR/metar.txt") {
    $src_metaf = 'file';
} else {
    $src_metaf = param('src_metaf');
    $src_metaf = 'noaa'
       unless defined $src_metaf && ($src_metaf eq 'adds' || $src_metaf eq 'addsds');
}
if (-f "$CGI_DATA_DIR/synop.txt") {
    $src_synop = 'file';
} else {
    $src_synop = param('src_synop');
    $src_synop = 'nws_land'
       unless defined $src_synop && $src_synop eq 'cod';
}

#
# determine if XML file name provided (never if called as CGI!)
#
my $xml_out_provided = param('xml_out_provided');
my $xml_out;
if (   !defined request_method()
    && defined $xml_out_provided
    && ! -e "$CGI_TMP_DIR/metaf2xml-provided.xml")
{
    $xml_out = "$CGI_TMP_DIR/metaf2xml-provided.xml";
} else {
    $xml_out_provided = undef;
    $xml_out = "$CGI_TMP_DIR/metaf2xml-$$.xml";
}

#
# log data of CGI request
#
if (request_method() && open(LOG, '>>', $CGI_LOG_FILE)) {
    # anonymize IP address, we only want to group the requests
    my $addr = remote_addr();
    $addr =~ s/\.[0-9]+/.x/;
    $addr =~ s/[0-9]+$/x/;
    print LOG gmtime() . ' ' . $addr . ' ' . request_method()
              . " $type_metaf $type_synop $lang $format $src_metaf $src_synop $mode '$msg_metaf' '$msg_synop'\n";
    close LOG;
}

=pod

If the METAR/TAF message starts with C<METAR> or C<TAF>, the parameter
C<type_metaf> is ignored.

=cut

#
# overwrite type_metaf if specified in message
#
$type_metaf = 'metar' if $msg_metaf =~ /^(?:METAR|SPECI) /;
$type_metaf = 'taf' if $msg_metaf =~ /^TAF /;

=pod

If the SYNOP message starts with C<SYNOP>, the parameter C<type_synop> is
ignored.

=cut

#
# overwrite type_synop if specified in message
#
$type_synop = 'synop' if $msg_synop =~ /^SYNOP /;

#
# translated strings
#
my %trans = (
    title_en => 'METAR/TAF/SYNOP decoder',
    title_de => 'METAR/TAF/SYNOP-Übersetzer',
    title_es => 'METAR/TAF/SYNOP traductor',
    title_ru => 'МЕТАР/ТАФ/СИНОП декодер',
    header_en => 'METAR/TAF/SYNOP decoder',
    header_de => 'METAR/TAF/SYNOP-Übersetzer',
    header_es => 'METAR/TAF/SYNOP traductor',
    header_ru => 'МЕТАР/ТАФ/СИНОП декодер',
    infosrc_en => 'A good source for up-to-date METAR and TAF messages is',
    infosrc_de => 'Eine gute Quelle für aktuelle METAR- und TAF-Meldungen ist',
    infosrc_es => 'Una buena fuente por mensajes actuales de METAR y TAF es',
    infosrc_ru => 'Хороший источник для современных сообщений МЕТАР и ТАФ',
    infofetch_en => 'If the option "ICAO id(s)" or "WMO id(s)" is chosen and one or more Station-Ids are given, messages will be fetched from the selected source (or if this option is disabled from a file on the server where this web page comes from).',
    infofetch_de => 'Wird die Option "ICAO Id(s)" oder "WMO Id(s)" gewählt und ein oder mehrere Stations-Kürzel angegeben, werden Meldungen von der ausgewählten Quelle (oder, falls diese Option gesperrt ist, von einer Datei auf dem Server, von dem diese Web-Seite kommt) geholt.',
    infofetch_es => 'Si es elegido la opción "ICAO id(s)" o "WMO id(s)" y son dado uno o mas ids de la estación, los mensajes serán traído de la fuente elegida (o si esta opción es minusválida de un fichero del servidor de donde viene este página web).',
    infofetch_ru => 'Если выбор "ICAO ид" или "WMO ид" выбран, и одни или более ид станции даются, сообщения принесены из отобранного источника (или если этот выбор инвалиды от файла на сервере, откуда эта веб-страница прибывает).',
    example_en => 'example messages',
    example_de => 'Beispiele für Meldungen',
    example_es => 'ejemplos',
    example_ru => 'примеры',
    type1_en => 'METAR message or', type2_en => 'TAF message or',
     type3_en => 'SYNOP message or',
     type4_en => 'ICAO id(s)', type5_en => 'WMO id(s)',
    type1_de => 'METAR Meldung oder', type2_de => 'TAF Meldung oder',
     type3_de => 'SYNOP Meldung oder',
     type4_de => 'ICAO Id(s)', type5_de => 'WMO Id(s)',
    type1_es => 'METAR mensaje o', type2_es => 'TAF mensaje o',
     type3_es => 'SYNOP mensaje o',
     type4_es => 'ICAO id(s)', type5_es => 'WMO id(s)',
    type1_ru => 'МЕТАР сообщение или', type2_ru => 'ТАФ сообщение или',
     type3_ru => 'СИНОП сообщение или',
     type4_ru => 'ICAO ид', type5_ru => 'WMO ид',
    source_en   => 'fetch messages from',
    source1_en  => 'NOAA/IWS', source2_en => 'NOAA/ADDS',
     source3_en => 'NOAA/ADDS dataserver',
     source4_en => 'NOAA/NWS land', source5_en => 'College of DuPage',
    source_de   => 'hole Meldungen von',
    source1_de  => 'NOAA/IWS', source2_de => 'NOAA/ADDS',
     source3_de => 'NOAA/ADDS dataserver',
     source4_de => 'NOAA/NWS land', source5_de => 'College of DuPage',
    source_es   => 'trae mensajes de',
    source1_es  => 'NOAA/IWS', source2_es => 'NOAA/ADDS',
     source3_es => 'NOAA/ADDS dataserver',
     source4_es => 'NOAA/NWS land', source5_es => 'College of DuPage',
    source_ru   => 'усилия сообщения от',
    source1_ru  => 'NOAA/IWS', source2_ru => 'NOAA/ADDS',
     source3_ru => 'NOAA/ADDS dataserver',
     source4_ru => 'NOAA/NWS land', source5_ru => 'College of DuPage',
    language_en => 'language',
    language_de => 'Sprache',
    language_es => 'lengua',
    language_ru => 'язык',
    format_en   => 'output as',
    format1_en  => 'HTML', format2_en => 'text',
     format3_en => 'XML (+XSL -> HTML)',
    format_de   => 'gib aus als',
    format1_de  => 'HTML', format2_de => 'Text',
     format3_de => 'XML (+XSL -> HTML)',
    format_es   => 'presenta como',
    format1_es  => 'HTML', format2_es => 'texto',
     format3_es => 'XML (+XSL -> HTML)',
    format_ru   => 'показа в',
    format1_ru  => 'HTML', format2_ru => 'текст',
     format3_ru => 'XML (+XSL -> HTML)',
    mode_en     => 'fetch/display',
    mode1_en    => 'latest/detailed', mode2_en => 'all/summary',
    mode_de     => 'hole/zeige',
    mode1_de    => 'letzte/detailliert', mode2_de => 'alle/Übersicht',
    mode_es     => 'trae/presenta',
    mode1_es    => 'último/detallado', mode2_es => 'todos/resumen',
    mode_ru     => 'усилия/показа',
    mode1_ru    => 'послед./подробно', mode2_ru => 'все/обзор',
    decode_en   => 'decode',
    decode_de   => 'Übersetzen',
    decode_es   => 'traduce',
    decode_ru   => 'переводить',
    disclaimer_en => 'Warning: The information on this page may be out-dated, inaccurate, or both. It is not suited for use in aviation.',
    disclaimer_de => 'Warnung: Die Informationen auf dieser Seite könnten veraltet, falsch oder beides sein. Sie sind nicht für die Verwendung in der Luftfahrt geeignet.',
    disclaimer_es => 'Aviso: Las informaciones de esta página web puedan ser antiguas o falsas o los dos. No son apropiadas para el uso en la aviación.',
    disclaimer_ru => 'Предупреждение: Информация относительно этой страницы может быть устарелой, неточной, или оба. Этому не удовлетворяют для использования в авиации.',
);

#
# save message parameter
#
my $msg_metaf_orig = $msg_metaf;
my $msg_synop_orig = $msg_synop;
$msg_metaf_orig =~ s/=//gs; # '=' is used as message delimiter for -O

=pod

If C<type_metaf> is C<icao> and one or more airport ICAO codes are given,
messages for the specified airports are fetched from the local
files F<$CGI_DATA_DIR/{metar,staf,taf}.txt> (if C<src_metaf> is C<file>)
or the specified online source.

If C<type_synop> is C<wmo> and one or more WMO ids are given,
messages for the specified stations are fetched from the local file
F<$CGI_DATA_DIR/synop.txt> (if C<src_synop> is C<file>) or the specified online
source.

=cut

#
# process METAR/TAF messages if they need to be fetched
#
if (   $type_metaf eq 'icao'
    && $msg_metaf =~ /^([A-Z][A-Z0-9]{3}(?: [A-Z][A-Z0-9]{3})*)$/)
{
    my ($icao, @metar, @staf, @taf);

    $icao = $1;

    if ($src_metaf ne 'file') {
        if ($src_metaf eq 'noaa') {
            @metar = process_noaa_iws $icao, 'metar', $mode;
            @staf  = process_noaa_iws $icao, 'staf', $mode;
            @taf   = process_noaa_iws $icao, 'taf', $mode;
        } elsif ($src_metaf eq 'adds') {
            for (process_noaa_adds $icao, $mode) {
                if (s/^METAR //) {
                    push @metar, $_;
                } elsif (s/^TAF //) {
                    push @taf, $_;
                } else {
                    push @metar, $_;
                }
            }
        } else {
            @metar = process_noaa_addsds $icao, 'metar', $mode;
            for (process_noaa_addsds $icao, 'taf', $mode) {
                if (s/^[1-9],//) {
                    push @staf, $_;
                } else {
                    s/^[0-9]+,//;
                    push @taf, $_;
                }
            }
        }
    } else {
        @metar = process_metaf_file $icao, 'metar', $mode;
        @staf  = process_metaf_file $icao, 'staf', $mode
            unless $mode eq 'summary';
        @taf   = process_metaf_file $icao, 'taf', $mode
            unless $mode eq 'summary';
    }

    $msg_metaf = '';
    for my $id (split / /, $icao) {
        my $id_list;

        $id_list = join("\n", grep { /^(?:METAR |SPECI )?$id/ } @metar);
        $msg_metaf .= "\nMETAR\n" . $id_list if $id_list;
        $id_list = join("\n", grep { /^(?:AMD )?$id/ } @staf);
        $msg_metaf .= "\nTAF\n"   . $id_list if $id_list;
        $id_list = join("\n", grep { /^(?:AMD )?$id/ } @taf);
        $msg_metaf .= "\nTAF\n"   . $id_list if $id_list;
    }
} elsif ($msg_metaf ne '') {
    $msg_metaf = ($type_metaf eq 'taf' ? 'TAF' : 'METAR') . "\n$msg_metaf";
}

# process SYNOP messages if they need to be fetched
if (   $type_synop eq 'wmo'
    && $msg_synop =~ /^((?:$re_report_type_SYNOP-)?[A-Z0-9]{3,}(?: (?:$re_report_type_SYNOP-)?[A-Z0-9]{3,})*)$/)
{
    my ($wmoid, @synop);

    $wmoid = $1;

    if ($src_synop ne 'file') {
        if ($src_synop eq 'nws_land') {
            @synop = process_noaa_nws $wmoid, $src_synop, $mode;
        } else {
            @synop = process_cod $wmoid, $mode;
        }
    } else {
        @synop = process_synop_file $wmoid, $mode;
    }

    $msg_synop = '';
    for my $id (split / /, $wmoid) {
        my $id_list;

        if ($id =~ s/($re_report_type_SYNOP)-//) {
            $id_list = join("\n", grep { /^$1-(AAXX .{5}|(BB|OO)XX) $id / } @synop);
        } else {
            $id_list = join("\n", grep { /^(AAXX .{5}|(BB|OO)XX) $id / } @synop);
        }
        if ($id_list) {
            $id_list =~ s/^$re_report_type_SYNOP-//mog;
            $msg_synop .= "\nSYNOP\n" . $id_list;
        }
    }
} elsif ($msg_synop ne '') {
    $msg_synop = 'SYNOP' . "\n$msg_synop";
}

my $msg = $msg_metaf . "\n" . $msg_synop;
$msg =~ s/ +/ /g;
$msg =~ s/ $//g;
$msg =~ s/[^\n -~]/?/gos; # avoid invalid XML and HTML
$msg =~ s/[\n]+/\n/g;
$msg =~ s/^\n//;
$msg =~ s/\n$//;

if ($format eq 'xml') {
    my $xsl = $mode eq 'summary' ? 'sum-ui' : 'fullhtml';
    print "Content-Type: text/xml; charset=UTF-8\n\n"
        unless server_software() eq 'cmdline';
    open(METAF2XML, "|$METAF2XML_BIN/metaf2xml.pl -Xx - -S/metaf-$xsl.xsl -O'$type_metaf $type_synop $lang $format $src_metaf $src_synop $mode $msg_metaf_orig=$msg_synop_orig' 2>&1");
    print METAF2XML $msg;
    close METAF2XML;
    exit 0;
}

print header({charset => 'UTF-8'}) .
    start_html({ title => $trans{'title_'.$lang},
                 lang  => $lang,
                 dtd   => [ '-//W3C//DTD HTML 4.01 Transitional//EN',
                            'http://www.w3.org/TR/html4/loose.dtd' ],
                 meta  => { robots   => 'noindex,nofollow',
                            keywords =>
               'metaf2xml,METAR,TAF,SYNOP,XML,aviation,weather,report,forecast',
                          },
                 head  => meta({ http_equiv => 'Content-Type',
                                 content    => 'text/html; charset=UTF-8'})
               }
              ) . "\n" .
    h2($trans{'header_'.$lang}) . "\n" .
    $trans{'infosrc_'.$lang} . ":\n" .
    kbd('http://weather.noaa.gov/weather/coded.html') . p . "\n" .
    $trans{'infofetch_'.$lang} . p . "\n" .
    start_form({ action => 'metaf.pl' }) .
    table({ border => 0, cellspacing => 0 }, "\n" .
        Tr("\n" .
           td({ nowrap => undef }, $trans{'language_'.$lang} . ': ') . "\n" .
           td(input({ type => 'radio', name => 'lang', value => 'de',
                      ($lang eq 'de' ? 'checked' : '') => undef }
                   ) .
              'Deutsch ') . "\n" .
           td(input({ type => 'radio', name => 'lang', value => 'en',
                      ($lang eq 'en' ? 'checked' : '') => undef }
                   ) .
              'English ') . "\n" .
           td(input({ type => 'radio', name => 'lang', value => 'es',
                      ($lang eq 'es' ? 'checked' : '') => undef }
                   ) .
              'Español ') . "\n" .
           td(input({ type => 'radio', name => 'lang', value => 'ru',
                      ($lang eq 'ru' ? 'checked' : '') => undef }
                   ) .
              'Русский ') . "\n"
        ) . "\n" .
        Tr("\n" .
           td({ nowrap => undef }, $trans{'format_'.$lang} . ': ') . "\n" .
           td(input({ type => 'radio', name => 'format', value => 'html',
                      ($format eq 'html' ? 'checked' : '') => undef }
                   ) .
              $trans{'format1_'.$lang} . ' ') . "\n" .
           td(input({ type => 'radio', name => 'format', value => 'text',
                      ($format eq 'text' ? 'checked' : '') => undef }
                   ) .
              $trans{'format2_'.$lang} . ' ') . "\n" .
           td({ colspan => 2 },
              input({ type => 'radio', name => 'format', value => 'xml',
                      ($format eq 'xml' ? 'checked' : '') => undef }
                   ) .
              $trans{'format3_'.$lang} . ' ') . "\n"
        ) . "\n" .
        Tr("\n" .
           td({ nowrap => undef }, $trans{'mode_'.$lang} . ': ') . "\n" .
           td({ nowrap => undef },
              input({ type => 'radio', name => 'mode', value => 'latest',
                      ($mode eq 'latest' ? 'checked' : '') => undef }
                   ) .
              $trans{'mode1_'.$lang} . ' ') . "\n" .
           td({ colspan => 2, nowrap => undef },
              input({ type => 'radio', name => 'mode', value => 'summary',
                      ($mode eq 'summary' ? 'checked' : '') => undef }
                   ) .
              $trans{'mode2_'.$lang} . ' ') . "\n"
        ) . "\n"
    ) . "\n" .
    table({ border => 0, cellspacing => 0 }, "\n" .
       Tr(td({ colspan => 2 }, hr)) . "\n" .
       Tr("\n" .
          td({ valign => 'top' }, "\n" .
             $trans{'example_'.$lang} . ': ') . "\n" .
          td({ style => 'font-family: monospace;' }, "\n" .
             'METAR YUDO 090600Z 00000KT CAVOK 22/15 Q1021 NOSIG' . "\n") . "\n"
       ) . "\n" .
       Tr("\n" .
          td('') . "\n" .
          td({ style => 'font-family: monospace;' }, "\n" .
             'TAF YUDO 090600Z 090716 VRB03KT 8000 SKC PROB40 TEMPO 0708 0200 +TSRA FM0800 CAVOK' . "\n") . "\n"
       ) . "\n" .
       Tr("\n" .
        td({ nowrap => undef }, "\n" .
           input({ type => 'radio', name => 'type_metaf', value => 'metar',
                   ($type_metaf eq 'metar' ? 'checked' : '') => undef }
                ) .
           $trans{'type1_'.$lang} . " \n"
       ). "\n" .
        td({ rowspan => 3, valign => 'bottom' }, "\n" .
           textfield({ name      => 'msg_metaf',
                       size      => 80,
                       maxlength => 500,
                       style     => 'font-family: monospace;',
                       default   => $msg_metaf_orig,
                       override  => 1}) . "\n") . "\n"
       ) . "\n" .
       Tr("\n" .
        td({ nowrap => undef },
           input({ type => 'radio', name => 'type_metaf', value => 'taf',
                   ($type_metaf eq 'taf' ? 'checked' : '') => undef }
                ) .
           $trans{'type2_'.$lang} . " \n"
          ). "\n"
       ). "\n" .
       Tr("\n" .
        td({ nowrap => undef },
           input({ type => 'radio', name => 'type_metaf', value => 'icao',
                   ($type_metaf eq 'icao' ? 'checked' : '') => undef }
                ) .
           $trans{'type4_'.$lang} . ": \n"
          ). "\n"
       ). "\n" .
       Tr("\n" .
          td({ nowrap => undef, align => 'right' },
             $trans{'source_'.$lang} . ': ') . "\n" .
          td(input({ type => 'radio', name => 'src_metaf', value => 'noaa',
                     ($src_metaf eq 'noaa' ? 'checked' : '') => undef,
                     ($src_metaf eq 'file' ? 'readonly' : '') => undef,
                     ($src_metaf eq 'file' ? 'disabled' : '') => undef,
                   }
                  ) .
             $trans{'source1_'.$lang} . "\n" .
             input({ type => 'radio', name => 'src_metaf', value => 'adds',
                     ($src_metaf eq 'adds' ? 'checked' : '') => undef,
                     ($src_metaf eq 'file' ? 'readonly' : '') => undef,
                     ($src_metaf eq 'file' ? 'disabled' : '') => undef,
                   }
                  ) .
             $trans{'source2_'.$lang} . "\n" .
             input({ type => 'radio', name => 'src_metaf', value => 'addsds',
                     ($src_metaf eq 'addsds' ? 'checked' : '') => undef,
                     ($src_metaf eq 'file' ? 'readonly' : '') => undef,
                     ($src_metaf eq 'file' ? 'disabled' : '') => undef,
                   }
                  ) .
             $trans{'source3_'.$lang} . ' ') . "\n"
       ) . "\n" .
       Tr("\n" . td({ colspan => 2 }, hr)) . "\n" .
       Tr("\n" .
          td({ valign => 'top' }, "\n" .
             $trans{'example_'.$lang} . ': ') . "\n" .
          td({ style => 'font-family: monospace;' }, "\n" .
             'AAXX 09004 08495 11459 30714 10147 20136 30151 40159 58005 60001 70511 83500 92350' . "\n") . "\n"
       ) . "\n" .
       Tr("\n" .
          td('') . "\n" .
          td({ style => 'font-family: monospace;' }, "\n" .
             'BBXX UIDS 18061 99613 70284 41698 61806 10000 40107 57020 70121 86//8 22271 00064' . "\n") . "\n"
       ) . "\n" .
       Tr("\n" .
        td({ nowrap => undef }, "\n" .
           input({ type => 'radio', name => 'type_synop', value => 'synop',
                   ($type_synop eq 'synop' ? 'checked' : '') => undef }
                ) .
           $trans{'type3_'.$lang} . " \n"
       ). "\n" .
        td({ rowspan => 2, valign => 'bottom' }, "\n" .
           textfield({ name      => 'msg_synop',
                       size      => 80,
                       maxlength => 500,
                       style     => 'font-family: monospace;',
                       default   => $msg_synop_orig,
                       override  => 1}) . "\n") . "\n"
       ) . "\n" .
       Tr("\n" .
        td(input({ type => 'radio', name => 'type_synop', value => 'wmo',
                   ($type_synop eq 'wmo' ? 'checked' : '') => undef }
                ) .
           $trans{'type5_'.$lang} . ": \n"
          ). "\n"
       ). "\n" .
       Tr("\n" .
          td({ nowrap => undef, align => 'right' },
             $trans{'source_'.$lang} . ': ') . "\n" .
          td(input({ type => 'radio', name => 'src_synop', value => 'nws_land',
                     ($src_synop eq 'nws_land' ? 'checked' : '') => undef,
                     ($src_synop eq 'file' ? 'readonly' : '') => undef,
                     ($src_synop eq 'file' ? 'disabled' : '') => undef,
                   }
                  ) .
             $trans{'source4_'.$lang} . "\n" .
             input({ type => 'radio', name => 'src_synop', value => 'cod',
                     ($src_synop eq 'cod' ? 'checked' : '') => undef,
                     ($src_synop eq 'file' ? 'readonly' : '') => undef,
                     ($src_synop eq 'file' ? 'disabled' : '') => undef,
                   }
                  ) .
             $trans{'source5_'.$lang} . ' ') . "\n"
       ) . "\n" .
       Tr("\n" . td({ colspan => 2 }, hr)) . "\n" .
       Tr("\n" .
          td({ colspan => 2 },
           submit({name => 'do_msg', value => $trans{'decode_'.$lang}}))
          . "\n")
    ) . "\n" .
    end_form . p . "\n";

if ($msg_metaf or $msg_synop) {
    my $response;
    my $sum = $mode eq 'summary' ? 'sum-' : '';

    print b($trans{'disclaimer_'.$lang}), p, "\n";

    open(METAF2XML, "|$METAF2XML_BIN/metaf2xml.pl -Xx $xml_out 2>&1");
    print METAF2XML $msg;
    close METAF2XML;
    open(XSLTPROC, "xsltproc --nonet --nowrite --nomkdir --stringparam lang $lang $METAF2XML_XSL/metaf-$sum$format.xsl $xml_out 2>&1 |");
    {
        local $/;
        $response = <XSLTPROC>;
    }
    close XSLTPROC;
    unlink $xml_out unless defined $xml_out_provided;
    if ($format eq 'html') {
        print $response;
    } else {
        print table({ border => 1 }, "\n" .
              Tr("\n" .
                 td("\n" .
                    pre({ style => 'margin: 0;' }, $response)) . "\n") . "\n");
    }
}

print comment('metaf.pl: $Id: metaf.pl,v 1.47 2007/09/11 13:02:35 metaf2xml Exp $'), "\n", p,
      "copyright (c) 2006-2007 metaf2xml @\n",
      a({ href => 'http://metaf2xml.sourceforge.net/' }, "\n" .
      img({ src    =>
              'http://sflogo.sourceforge.net/sflogo.php?group_id=168043&type=1',
            border => 0,
            alt    => 'SourceForge.net Logo' }) . "\n") . "\n" .
      end_html();

=head1 EXAMPLES

Parse a METAR message and print the result as XML:

  metaf.pl 'format=xml&msg_metaf=YUDO 090600Z 00000KT CAVOK 22/15 Q1021 NOSIG'

Fetch up-to-date METAR and TAF messages (from NOAA) and SYNOP messages (from
NWS) for Rio (C<SBGL>, 83746), New York (C<KJFK>, 74486), and Tokyo (C<RJTT>,
47662) and print the result as HTML:

  metaf.pl 'type_metaf=icao&type_synop=wmo&msg_metaf=SBGL KJFK RJTT&msg_synop=83746 74486 47662'

=head1 SEE ALSO

=begin html

<a href=parser.pm.html>metaf2xml::parser(3pm)</a>,
<a href=XML.pm.html>metaf2xml::XML(3pm)</a>,
<a href=metaf2xml.pl.html>metaf2xml(1)</a>, <!--

=end html

B<metaf2xml::parser>(3pm),
B<metaf2xml::XML>(3pm),
B<metaf2xml>(1),

=for html -->

L<http://metaf2xml.sourceforge.net/>

=head1 COPYRIGHT, LICENSE, DISCLAIMER

copyright (c) 2006-2007 metaf2xml @ L<http://metaf2xml.sourceforge.net/>

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA

=cut