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
i entry 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 ID\n";
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) = @_;
$in ||= parse_input(); # add_entry may have already read STDIN
unless ($in->{id}) {
# warn("No article ID\n");
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 ID\n";
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: $v\n";
}
} 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: $v\n";
}
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:
;;; use-perl --- interface to use.perl.org SOAP.
;;; Commentary:
;; Various functions for interacting with the SOAP interface on
;; use.perl.org. Additionally requires a perl script for actually
;; communicating with the server.
;;
;; Originally from
;; <http://use.perl.org/article.pl?sid=02/10/25/007222&tid=11>.
;;
;; To use, drop this file into your site-lisp directory (or somewhere
;; else on your load-path) and put (require 'use-perl) in your.emacs
;; file.
;;; History:
;; @(#) $Id: use-perl.el,v 1.17 2004/12/20 13:49:51 dom Exp $
(require 'goto-addr)
;;; Code:
(defgroup use-perl nil
"Talking to use.perl.org."
:group 'tools)
(defcustom use-perl-progpath (expand-file-name "~/bin")
"*Path to use.perl soap interface."
:type '(string)
:group 'use-perl)
(defcustom use-perl-default-uid nil
"What user id to use when talking to use.perl.org by default."
:type '(integer)
:group 'use-perl)
(defcustom use-perl-browse-entries 20
"*How many entries to request from use.perl.org for a browse list."
:type '(integer)
:group 'use-perl)
(defun use-perl-cmd (cmd &rest args)
"Return the path to a specific CMD. Optionally pass in ARGS to command."
(mapconcat 'identity
(cons (concat use-perl-progpath "/" cmd) args)
" "))
(defun use-perl-run-replace-buffer (cmd)
"Run the string CMD and replace the current buffer with the output."
(shell-command-on-region (point-min) (point-max) cmd nil 1))
(defun use-perl-get-entry (n)
"Get journal entry N from use.perl.org."
(interactive "sJournal ID: ")
(switch-to-buffer (generate-new-buffer (concat "*use-perl-journal-" n "*")))
(use-perl-run-replace-buffer (use-perl-cmd "get_entry" n)))
(defun use-perl-browse (uid limit)
"List use.perl journal entries for UID to a maximum of LIMIT."
;; If there is no prefix arg specified, then attempt to use the
;; values set by custom, otherwise prompt. Always use the custom
;; setting for the limit, as that's less likely to want to be
;; changed.
(interactive
(list (or (and (not current-prefix-arg)
(number-to-string use-perl-default-uid))
(read-string "User ID: "))
(number-to-string use-perl-browse-entries)))
(switch-to-buffer (generate-new-buffer "*use-perl-entry-list*"))
(use-perl-run-replace-buffer (use-perl-cmd "list_entries" uid limit))
(use-perl-browse-mode))
;; ---------------------------------------------------------------------
;; A major mode for browsing the list of use.perl journal entries.
;; ---------------------------------------------------------------------
(defvar use-perl-browse-mode-map nil
"Map to be used in `use-perl-browse-mode'.")
(if use-perl-browse-mode-map
nil
(setq use-perl-browse-mode-map (make-sparse-keymap))
(define-key use-perl-browse-mode-map "q" 'use-perl-browse-quit)
(define-key use-perl-browse-mode-map "n" 'use-perl-browse-next-entry)
(define-key use-perl-browse-mode-map "p" 'use-perl-browse-previous-entry)
(define-key use-perl-browse-mode-map "w" 'use-perl-whois)
(define-key use-perl-browse-mode-map "\C-m" 'use-perl-browse-view-entry))
(defun use-perl-browse-mode ()
"Major mode for browsing a list of use.perl.org journal entries."
(interactive)
(kill-all-local-variables)
(setq major-mode 'use-perl-browse-mode)
(setq mode-name "MyJournals")
(use-local-map use-perl-browse-mode-map)
(goto-address)
(goto-char (point-min)))
(defun use-perl-browse-quit ()
"Finish looking at the list of use.perl.org journal entries."
(interactive)
(bury-buffer))
(defun use-perl-browse-view-entry ()
"Bring up a buffer with the current entry in it."
(interactive)
(use-perl-get-entry (use-perl-browse-current-entry-id)))
(defun use-perl-browse-current-entry-id ()
"Return the id of the entry nearest the point."
(use-perl-browse-start-of-entry)
(save-excursion
(re-search-forward "^id: \\([0-9]+\\)$")
(match-string 1)))
(defun use-perl-browse-start-of-entry ()
"Move the point to the start of the current entry."
(if (re-search-backward "^$" nil t)
(forward-line)
(goto-char (point-min))))
(defun use-perl-browse-previous-entry ()
"Move to the previous entry in the list."
(interactive)
(use-perl-browse-start-of-entry)
(forward-line -1)
(backward-paragraph)
(unless (bobp)
(forward-line)))
(defun use-perl-browse-next-entry ()
"Move to the previous entry in the list."
(interactive)
(use-perl-browse-start-of-entry)
(let ((start (point)))
(forward-paragraph)
(forward-line)
(if (eobp)
(goto-char start))))
;; ---------------------------------------------------------------------
(defun use-perl-add-entry ()
"Add current buffer to use.perl.org as a new entry."
(interactive)
(widen)
(use-perl-run-replace-buffer (use-perl-cmd "add_entry")))
(defun use-perl-modify-entry ()
"Modify an entry."
(interactive)
(widen)
(use-perl-run-replace-buffer (use-perl-cmd "modify_entry")))
(defun use-perl-delete-entry (id)
"Delete use.perl journal entry ID."
(interactive "nEntry ID: ")
(use-perl-run-replace-buffer (use-perl-cmd "delete_entry" id)))
(defun use-perl-whois (nick)
"Lookup the uid of NICK."
(interactive "sNickname: ")
(message (shell-command-to-string (use-perl-cmd "whois_nick" nick))))
(provide 'use-perl)
;;; use-perl.el ends here
-Dom