Since use.perl.org has become my de facto backup solution,
I now post the scripts I use to blog from winders. These are modified
versions of the scripts I mentioned in a use.perl.org article published a
while ago.
The emacs file:
(defvar prog "C:/perl/bin/perl.exe F:/blog/use_perl_blog.pl" "use_perl_journal: A SOAP client for use.perl journaling" ) (defun edit-entry () "Add an entry or edit an existing one" (interactive) (setq cmd (concat prog " edit")) (widen) (shell-command-on-region (point-min) (point-max) cmd) ) (defun get-entry (n) "Get journal entry from use.perl.org" (interactive "sJournal ID: ") (setq buffer (generate-new-buffer "*use_perl_journal*")) (switch-to-buffer buffer) (setq cmd (concat prog (concat " -i " (concat n " get")))) (shell-command-on-region (point-min) (point-max) cmd 1 nil nil) ) (defun list-entries (uid limit) "Get journal entries" (interactive "sUser ID: nsLimit: ") (setq buffer (generate-new-buffer "*use_perl:list_entries*")) (switch-to-buffer buffer) (setq cmd (concat prog (concat " -l " (concat limit " -i " (concat uid " list"))))) (shell-command-on-region (point-min) (point-max) cmd 1 nil nil) ) (defun delete-entry (jid) "Delete journal entry" (interactive "nEntry ID: ") (setq cmd (concat prog (concat " -i " (concat jid (concat " delete"))))) (shell-command-on-region (point-min) (point-max) cmd 1 nil nil) ) ;; don't use tabs (setq-default indent-tabs-mode nil) (global-set-key "C-xtl" `list-entries) (global-set-key "C-xtg" `get-entry) (global-set-key "C-xts" `edit-entry) (global-set-key "C-xtm" `edit-entry) (global-set-key "C-xtd" `delete-entry)
The perl script:
# -*-cperl-*- # A SOAP client to post USE.PERL.ORG journal entries use strict; use HTTP::Cookies; use SOAP::Lite; use File::Basename; use Digest::MD5 'md5_hex'; use Data::Dumper; use Getopt::Std; use constant DEBUG => 0; use constant UID => -1; # your UID here use constant PW => 's3cr3t'; # your pw here use constant URI => 'http://use.perl.org/Slash/Journal/SOAP'; use constant PROXY => 'http://use.perl.org/journal.pl'; my $Dispatch = { 'get' => &get_entry, 'list' => &list_entries, 'add' => &add_entry, 'edit' => &edit_entry, 'delete' => &delete_entry, }; my $opts = {}; getopts('h?vi:u:l:', $opts); my $action = pop @ARGV; unless ($action) { print usage(), "n"; exit; } my $soap_client = make_soap(); my $exit_value = 0; if (defined $Dispatch->{$action}) { $exit_value = !$Dispatch->{$action}->($opts, $soap_client); } else { warn("Unknown action '$action'"); print usage(); $exit_value = 1; } exit $exit_value; #------ # subs #------ sub usage { my $base = basename($0); return qq[ $base - manage use.perl.org blog USAGE: $base [options] [actions] OPTIONS: ? print this screen h print this screen v verbose mode ientry ID l limit the number of listed entries to this number u use.perl.org user ID ACTIONS: add delete edit get list Input files take the following form: id: subject: body: ]; } sub make_soap { my $cookie = HTTP::Cookies->new; $cookie->set_cookie( 0, user => bakeUserCookie(&UID, &PW), "/", "use.perl.org", ); return SOAP::Lite->uri(URI)->proxy(PROXY, cookie_jar => $cookie); } sub add_entry { my ($opts, $c, $in) = @_; $in ||= parse_input(); my $ret; if ($in->{subject} && $in->{body}) { if ($in->{id}) { return edit_entry(@_, $in); } else { $ret = $c->add_entry($in->{subject}, $in->{body}); } } else { $ret = $c->add_entry("Random thought #$$", $in->{all}); } return if had_transport_error($ret); print "add_entry got articleID: ", $ret->result, "n"; return 1; } sub delete_entry { my ($opts, $c) = @_; my ($id) = $opts->{i} || die "delete requires a journal IDn"; my $ret = $c->delete_entry($id); return if had_transport_error($ret); print "Deleted article ID '$id'n"; return 1; } sub edit_entry { my ($opts, $c, $in) = @_; # add_entry may have already read STDIN $in ||= parse_input(); unless ($in->{id}) { # warn("No article IDn"); return add_entry($opts, $c, $in); } my $ret = $c->modify_entry($in->{id}, subject => $in->{subject}, body => $in->{body}, ); return if had_transport_error($ret); print "Updated article $in->{id}n"; return 1; } sub get_entry { my ($opts, $c) = @_; my $id = $opts->{i} || die "get_entry requires a journal IDn"; my $ret = $c->get_entry($id); return if had_transport_error($ret); if (my $hr = $ret->result) { while (my ($k,$v) = each %{$hr}) { print "$k: $vn"; } } else { warn ("Couldn't fetch journal entry '$id'n"); return; } return 1; } sub list_entries { my ($opts, $c) = @_; my ($uid, $limit) = (($opts->{u} || &UID), $opts->{l}); my $ret = $c->get_entries($uid, $limit); return if had_transport_error($ret); my $ar = $ret->result; for my $row (@{$ar}) { while (my ($k,$v) = each %{$row}) { print "$k: $vn"; } print "n"; } return 1; } sub parse_input { my %rec; my $last_field = 'all'; while (defined ($_ = )) { chomp($_); if (/^(w+):s*(.*)/) { $last_field = $1; $rec{$last_field} = $2; } else { $rec{$last_field} .= "n$_"; } } return %rec; } sub bakeUserCookie { my ($uid, $pw) = @_; my $c = $uid . "::" . md5_hex($pw); $c =~ s/(.)/sprintf("%%%02x", ord($1))/ge; $c =~ s/%/%25/g; return $c; } sub had_transport_error { my ($ret) = @_; if ($ret->fault) { warn ("Oops: ", $ret->faultString, "n"); return 1; } return; }
To post:
- M-x load-file
- new buffer with “id:nsubject:nbody:”;
- add blog content to buffer
- M-x t s to publish blog to use.perl