#!/usr/bin/perl

my $rcsid = '$Id: newpost,v 1.4 2006/04/26 20:16:12 vogelke Exp $';

=head1 NAME

 newpost

=head1 SYNOPSIS

 newpost [-v] [file]

=head1 DESCRIPTION

 newpost reads a file (or stdin), handles simple markup,
 and writes the results to a blog file.

=head1 OPTIONS

 -v    prints the version and exits.

=head1 AUTHOR

 Karl Vogel <vogelke@pobox.com>
 Sumaria Systems, Inc.

=cut

# To generate manpage:
#   pod2man -c 'User docs' -r "`date`" -d version newpost
#---------------------------------------------------------------------

use strict;
use warnings;
use subs qw(urlify usage version);
use Mail::Address;	# parse email addresses
use File::Basename;
use Date::Parse;
use Date::Format qw(time2str);

my $myname;      # script basename.
$myname = basename ($0, ".pl");

# Get args:
my $infile = '';

ARG: while (@ARGV) {
    $_ = shift @ARGV;

    /^-v/ and do {
        my $vers = version();
	warn "$vers\n";
        exit (0);
    };

    /^-.*/ and do {
        usage ("unrecognized option: $_");
    };

    $infile = $_;
}

# If anything is coming in via STDIN,
# use it.  If not, try the $infile.

if (-f STDIN || -p STDIN) {
    open (F, "<&STDIN");
} else {
    open (F, "$infile") || die "$infile: can't read: $!\n";
}

#
# We're reading an email message, so save
# the date and subject lines, and open the
# output file.
#

my $from = '';
my $date = time();
my $title = 'no title';

TOP: while (<F>) {
    $_ = urlify ($_);
    last if /^$/;

    /^From: *(.*)$/i and do {
        $from = $1;
	next TOP;
    };

    /^Date: *(.*)$/i and do {
        if (my $t = str2time ($1)) {
	    $date = $t;
	}
	next TOP;
    };

    /^Subject: *(.*)$/i and do {
        $title = $1;
	next TOP;
    };
}

my $outfile = sprintf ("/doc/html/htdocs/blog/posts/%d.txt", $date);
open (OUT, "> $outfile") || die "$outfile: can't write: $!\n";
print OUT "$title\n";

#
# Main loop.
#

TOP: while (<F>) {
    $_ = urlify ($_);

    /---------S$/ and do {
        print OUT "<pre>\n";

	while (<F>) {
            $_ = urlify ($_);
            s!me\%!<b>me%</b>!;
            s!root#!<b>root#</b>!;

            last if /---------E$/;
	    print OUT "$_\n";
	}

        print OUT "</pre>\n";
	next TOP;
    };

    # row of dashes.

    /^\s*\-\-\-\-+\s*$/ and do {
        print OUT "<hr>\n";
	next TOP;
    };

    /^$/ and do {
        print OUT "<p>\n";
	next TOP;
    };

    # let blockquote take care of indent, but keep
    # two spaces after periods.

    s!^\s*!!g;
    s!\.  !.\&nbsp;\&nbsp;!g;

    print OUT "$_\n";
}

close (OUT);

# Fix timestamp and mode.
utime ($date, $date, $outfile);
my $mode = 0664;
chmod $mode, $outfile; 

exit (0);

#---------------------------------------------------------------------
# Prepare string by expanding tabs, making links to URLs, etc.

sub urlify
{
    local($_) = shift;
    my $out = '';

    chomp;
    1 while s/\t+/' ' x (length($&) * 5 - length($`) % 5)/e;

    # Fix email addresses.
    # we need to keep angle brackets, so use (( for < and
    # )) for > until we're reday to return.

    if (/\@/)
    {
        my @addrs = Mail::Address->parse($_);

        foreach my $addr (@addrs) {
	    $_ = $addr->address;

	    if (/\@/) {
                s/$_/ ((a href=\"mailto:$_\"))$_((\/a)) /;
	    }
	    $out .= $addr->phrase;
            $out .= "$_ "
        }
        $_ = $out;
    }

    # Trim first 4 spaces.
    s/^    //;

    # Links enclosed by brackets?
    s/<(http:.+)>/$1/g;
    s/<(https:.+)>/$1/g;

    # Special characters?
    s!\&!\&amp;!g;
    s!<!\&lt;!g;
    s!>!\&gt;!g;

    # replace protected angle brackets.
    s/\(\(/</g;
    s/\)\)/>/g;

    # handle remaining URLs.  (taken from Perl Cookbook)
    my $urls = '(http|file|ftp)';
    my $ltrs = '\w';
    my $gunk = '/#~:.?+=&%@!\-';
    my $punc = '.:?\-';
    my $any  = "${ltrs}${gunk}${punc}";

    s{
      \b                    # start at word boundary
      (                     # begin $1  {
       $urls     :          # need resource and a colon
       [$any] +?            # followed by on or more
                            #  of any valid character, but
                            #  be conservative and take only
                            #  what you need to....
      )                     # end   $1  }
      (?=                   # look-ahead non-consumptive assertion
       [$punc]*             # either 0 or more punctuation
       [^$any]              #   followed by a non-url char
       |                    # or else
       $                    #   then end of the string
      )
     }{<A HREF="$1">$1</A>}igox;

    return $_;
}

#---------------------------------------------------------------------
# Print a usage message from the comment header and exit.

sub usage
{
    my ($emsg) = @_;
    warn "$emsg\n";
    warn "usage: newpost [-v] [file]\n";
    exit (1);
}

#---------------------------------------------------------------------
# Return the current version.

sub version
{
    $_ = $rcsid;
    s/,v / /;
    @_ = split;
    return "$_[1]  v$_[2]  $_[3] $_[4]";
}