#!/usr/bin/perl -w

use strict;
use subs 'make_cookie';

use Getopt::Std;

use Digest::MD5 'md5_hex';
use HTTP::Cookies;
use SOAP::Lite;
use XML::RSS;

my (%opts, $title, $discuss, $readfh, $body, $host, $uri, $proxy,
    $cookie_file, $cookie_jar, $journal, $result);

getopts('c:m:f:C:', \%opts) or die <<"USAGE";
Usage: $0 [ -m title ] [ -f file ] [ -c yes|no ] [ -C user:pass ]
where:

-m title        Provide title for the journal entry
                (default is command name-based)
-f file         Read the journal entry from FILE instead of STDIN
-c yes|no       Allow or disallow comments
                (default is to let your use.perl.org default stand)
-C user:pass    Provide authentication credentials in place of (or in
                absence of) Netscape cookie authentication. User in
                this case is UID, not nickname.

USAGE

$title       = $opts{'m'} || "Generated by $0";
$discuss     = (exists $opts{c} && $opts{c} =~ /no/i) ? 0 : 1;
if ($opts{f}) {
    open(FILE, "< $opts{f}") or die "$0: Error opening $opts{f}: $!\n"
+;
    $readfh = \*FILE;
} else {
    $readfh = \*STDIN;
}
$body = join('', "<!-- posted by $0 -->\n", <$readfh>);

$host        = 'use.perl.org';
$uri         = "http://$host/Slash/Journal/SOAP";
$proxy       = "http://$host/journal.pl";
$cookie_file = "$ENV{HOME}/.netscape/cookies";

if ($opts{C}) {
    $cookie_jar = HTTP::Cookies->new;
    $cookie_jar->set_cookie(0,
                            user => make_cookie(split /:/, $opts{C}, 2
+),
                            '/', $host);
} elsif (-f $cookie_file) {
    $cookie_jar = HTTP::Cookies::Netscape->new(File => $cookie_file);
} else {
    die "$0: No authentication data found, cannot continue";
}

$journal = SOAP::Lite
               ->uri($uri)
               ->proxy($proxy, cookie_jar => $cookie_jar);
die "$0: Error creating SOAP::Lite client, cannot continue"
    unless $journal;
$result = $journal->add_entry(subject => $title,
                              body    => $body,
                              discuss => $discuss);

if ($result->fault) {
    die "$0: Operation failed: " . $result->faultstring . "\n";
} else {
    printf "New entry added as %s\n", $result->result;
}

exit;

# Taken from the Slash codebase
sub make_cookie {
    my ($uid, $passwd) = @_;
    my $cookie = $uid . '::' . md5_hex($passwd);
    $cookie =~ s/(.)/sprintf("%%%02x", ord($1))/ge;
    $cookie =~ s/%/%25/g;
    $cookie;
}

__END__
[download]