#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;
##
##  WMb -- Website META Language Bug Reporting Tool
##
##  Copyright (c) 1996-2001 Ralf S. Engelschall.
##  Copyright (c) 1999-2001 Denis Barbier.
##
##  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
##
##      Free Software Foundation, Inc.
##      59 Temple Place - Suite 330
##      Boston, MA  02111-1307, USA
##
##  Notice, that ``free software'' addresses the fact that this program
##  is __distributed__ under the term of the GNU General Public License
##  and because of this, it can be redistributed and modified under the
##  conditions of this license, but the software remains __copyrighted__
##  by the author. Don't intermix this with the general meaning of
##  Public Domain software or such a derivated distribution label.
##
##  The author reserves the right to distribute following releases of
##  this program under different conditions or license agreements.
##

use strict;
use warnings;
use 5.014;
use Path::Tiny qw/ path /;

my $VERSION = "2.32.0";

use Getopt::Long 2.13 ();
use Term::ReadKey;

##
##  INIT
##

if ( $ENV{'PATH'} !~ m|/usr/bin| )
{
    $ENV{'PATH'} = '/usr/bin:' . $ENV{'PATH'};
}

##
##  PROCESS ARGUMENT LINE
##

sub usage
{
    my ($progname) = @_;
    my ($o);

    print STDERR "Usage: $progname [options] [path ...]\n";
    print STDERR "\n";
    print STDERR "Giving Feedback:\n";
    print STDERR
        "  -V, --version[=NUM]    display version and build information\n";
    print STDERR "  -h, --help             display this usage summary\n";
    print STDERR "\n";
    exit(1);
}

use vars qw/ $opt_V $opt_h /;

sub version
{
    system("wml -V$opt_V");
    exit(0);
}

#   options
$opt_V = -1;
$opt_h = 0;

sub _process_options
{
    $Getopt::Long::bundling      = 1;
    $Getopt::Long::getopt_compat = 0;
    $SIG{'__WARN__'}             = sub {
        print STDERR "WMd:Error: $_[0]";
    };
    if ( not Getopt::Long::GetOptions( "V|version:i", "h|help" ) )
    {
        print STDERR "Try `$0 --help' for more information.\n";
        exit(0);
    }
    usage($0) if ($opt_h);
    $SIG{'__WARN__'} = undef;
}
_process_options();

#   fix the version level
if ( $opt_V == 0 )
{
    $opt_V = 1;    # Getopt::Long sets 0 if -V only
}
if ( $opt_V == -1 )
{
    $opt_V = 0;    # we operate with 0 for not set
}
version() if ($opt_V);

##
##   Header
##
print STDERR "This is WML BUGREPORT (WMb), Version $VERSION\n";
print STDERR "Copyright (c) 1996-2001 Ralf S. Engelschall.\n";
print STDERR "\n";

##
##   Determining Information
##
print STDERR "Determining your information...";

my @pwinfo = getpwuid($<);

my $username = $pwinfo[0];
$username =~ s|[\'\$\`\"]||g;

my $realname = $pwinfo[6];
$realname =~ s|^([^\,]+)\,.*$|$1|;

my $hostname = `hostname`;
$hostname =~ s|\n$||;
if ( $hostname =~ m|^[a-zA-Z0-9_-]+$| and -f "/etc/resolv.conf" )
{
    my $domain = '';
    open( TMP, "</etc/resolv.conf" );
    while (<TMP>)
    {
        if (m|^domain\s+\.?(\S+)|)
        {
            $domain = $1;
            last;
        }
    }
    close(TMP);
    if ( $domain ne '' )
    {
        $hostname = "$hostname.$domain";
    }
}

my $version = `wml -V3 2>&1`;
$version =~ s|^.*?(Built)|Used WML System:\n$1|s;

my $maileropt;
my $editor    = $ENV{'EDITOR'} || 'vi';
my $editoropt = '';
if ( $editor =~ m#\Avi# )
{
    $editoropt = '+17';
}

my $mailer  = '';
my @MAILERS = (
    {
        PRG => 'elm',
        HDR => 0,
        OPT => '-s \'%s\' %t <%F',
        TST => '-d "$ENV{\'HOME\'}/.elm"'
    },
    {
        PRG => 'mutt',
        HDR => 0,
        OPT => '-s \'%s\' %t <%F',
        TST => '-f "$ENV{\'HOME\'}/.muttrc"'
    },
    {
        PRG => 'pine',
        HDR => 0,
        OPT => '-s \'%s\' %t <%F',
        TST => '-d "$ENV{\'HOME\'}/.pine"'
    },
    { PRG => 'mail',     HDR => 0, OPT => '-s \'%s\' %t <%F', TST => '1' },
    { PRG => 'sendmail', HDR => 1, OPT => '%t <%F',           TST => '1' },
);
my $mailerhdr;
LOOP: foreach my $m (@MAILERS)
{
    my $prg = $m->{PRG};
    my $hdr = $m->{HDR};
    my $opt = $m->{OPT};
    my $tst = $m->{TST};
    foreach my $p ( split( /:/, $ENV{'PATH'} ) )
    {
        if ( -x "$p/$prg" )
        {
            my $rc = 0;
            eval "\$rc = 1 if ($tst)";
            if ($rc)
            {
                $mailer    = "$p/$prg";
                $mailerhdr = "$hdr";
                $maileropt = "$opt";
                last LOOP;
            }
        }
    }
}

print STDERR "done.\n";

if ( $mailer eq '' )
{
    print STDERR "\n";
    print STDERR
        "** Sorry, cannot find a useable MTA on your system for E-Mail.\n";
    print STDERR
        "** Please send the bug report online via HTTP by opening the URL\n";
    my ($v) = $VERSION =~ m#\A([0-9\.]+)#;
    print STDERR "** https://github.com/thewml/website-meta-language/issues ";
    print STDERR "\n";
    exit(0);
}

#
#   Creating message
#
print STDERR "Creating bug report skeleton...";

my $tmpdir = $ENV{'TMPDIR'} || '/tmp';

my $tmpfile  = "$tmpdir/wmb.$$.1.tmp";
my $tmpfile2 = "$tmpdir/wmb.$$.2.tmp";
unlink($tmpfile);

open( MAIL, ">$tmpfile" );
print MAIL <<'EOT';
+------------------------------------------------------+
| Please complete this bug report message by at least  |
| specifing the correct reply-to e-mail address and    |
| the detailed problem description.                    |
+------------------------------------------------------+
__        ___  __ _
\ \      / / \/  | |      Website META Language
 \ \ /\ / / |\/| | |      Version 2.32.0
  \ V  V /| |  | | |___
   \_/\_/ |_|  |_|_____|  BUG REPORT
_________________________________________________________

EOT
print MAIL "From:     $realname\n";
print MAIL "Reply-To: $username\@$hostname\n";
print MAIL "\n";
print MAIL "PROBLEM DESCRIPTION:\n";
print MAIL "\n";
print MAIL "\n";
print MAIL "PLATFORM CHARACTERISTICS:\n";
print MAIL $version;
close(MAIL);
print STDERR "done.\n";

#
#   Editing the message
#
system("$editor $editoropt $tmpfile");

#
#   Send the message
#
print STDERR "Send report [Y/n]: ";
ReadMode 4;
my $rc = ReadKey(0);
ReadMode 0;
print STDERR "\n";
if ( $rc eq '' or $rc eq "\n" or $rc eq "\r" )
{
    $rc = 'y';
}
my $from;
my $replyto;
if ( $rc =~ m|[yY]| )
{
    print STDERR "Sending bug report...";

    open( FP, "<$tmpfile" );
    while (<FP>)
    {
        if (m|^From:\s+(.+)\s*$|)
        {
            $from = $1;
        }
        if (m|^Reply-To:\s+(.+)\s*$|)
        {
            $replyto = $1;
        }
    }
    close(FP);

    my $subject = "BUG REPORT: Website META Language $VERSION";
    my $to      = 'shlomif@cpan.org';
    $maileropt =~ s|%r|$replyto|g;
    $maileropt =~ s|%s|$subject|g;
    $maileropt =~ s|%t|$to|g;
    $maileropt =~ s|%F|$tmpfile2|g;

    my $msg = path($tmpfile)->slurp;
    $msg =~ s|^.+--.+?\-\+\n_|_|s;

    open( OUT, ">$tmpfile2" );
    if ($mailerhdr)
    {
        print OUT "From: $replyto ($from)\n";
        print OUT "Reply-To: $replyto\n";
        print OUT "Subject: $subject\n";
        print OUT "To: $to\n";
        print OUT "\n";
    }
    print OUT $msg;
    close(OUT);

    system("$mailer $maileropt >/dev/null");
    print STDERR "done.\n";
    print STDERR "\n";
    print STDERR "Thanks for using WML and giving feedback.\n";
    print STDERR "\n";
}
else
{
    print STDERR "\n";
    print STDERR "Stopped: No report send.\n";
    print STDERR "\n";
}

#
#   cleanup
#
unlink($tmpfile)  if ( -f $tmpfile );
unlink($tmpfile2) if ( -f $tmpfile2 );

#   exit gracefully
exit(0);

##EOF##
__END__

=head1 NAME

WMb - Website META Language Bug Reporting Tool

=head1 VERSION

2.32.0

=head1 SYNOPSIS

B<wmb>
[B<-V>]
[B<-h>]

=head1 DESCRIPTION

This is the bug reporting tool for the I<Website META Language> (WML), a free
HTML generation toolkit for Unix.  See wml(1) for more details on WML.  Use
this program for quickly sending a bug report to the WML author via EMail.  As
an alternative (when this program does not work from your platform) you can
send the bug report manually to shlomif@shlomifish.org .

=head1 OPTIONS

=over 4

=item B<-V>, B<--version>

Gives the version identification string of WMb. Use this to determine the
version of a installed WML toolkit.

=item B<-h>, B<--help>

Prints the usage summary page.

=back

=head1 AUTHOR

 Ralf S. Engelschall
 rse@engelschall.com
 www.engelschall.com

=head1 SEE ALSO

wml(1)

=cut
# vim: ft=perl
