Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

jjohn (22)

jjohn
  (email not shown publicly)
http://taskboy.com/
AOL IM: taskboy3000 (Add Buddy, Send Message)

Perl hack/Linux buff/OSS junkie.

Journal of jjohn (22)

Thursday February 24, 2005
11:09 AM

use.perl blogging with win32 emacs + perl

[ #23353 ]

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 <id>  entry ID
   l <int> limit the number of listed entries to this number
   u <id>  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 ($_ = <STDIN>)) {
    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
The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • I started working on the elisp for that a little while back. I was trying to get a major mode together for browsing the journal entries. This is what I have so far. Unfortunately, I haven't worked on it much since, because I'm not a terribly prolific poster, so I haven't had the impetus.

    ;;; 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