in reply to Re: PerlMonks Editor
in thread PerlMonks Editor

My thanx for the console offline editor (and also to GrandFather for this thread).

I've slightly modified it for Unix, which will hopefully be forgiven by jdporter. It should still support Windows, just as before. And until I find a willing victim, I'll keep this version working

For my personally, the main advantage of this solution over PMEdit is that the script wraps around your standard editor, and I thus can avoid TK and WYSIAYCEHTG.

It's also quite useful to take a peek at the PM-html source of a node, e.g. how the heck did that fellow monk manage a blue background (A: class=settings_key; grey is class=readmore)? Especially nice with vim highlighting and the original whitespace (alternatively follow the xml link or add ;displaytype=xml to the URL).

Changes include:

Possible Todos:

Known Bugs:

A diff -u is a bit long compared to the script (given that I touched only 3 locations, excluding whitespace, comments and 2 variables...), so here's the script in full:

#!/usr/bin/perl # 20091019pj # by jdporter, errors by jakobi # ( initial version) # script for offline-editing the text of existing nodes # [in case you ask jakobi, remember to include the keyword pm_vi] my $myself=799017; # the script's perlmonks node # Usage: # pm_vi # pm_vi [node_id or node_title] # Tips # - the script asks interactively about the user, password, node, edit +or # to use unless the node is specified on the command line and other # informations are set via $EDITOR or your .netrc file: # ^machine # ^ username USER # ^ password PASSWORD # ^ macdef editor # ^ vi "%s" # note that the filename migh +t be # # numeric or a sanitized node + title # - the most recent copy of the edited node is retained in $ENV{TMP} o +r /tmp # both before (.org) and after editing # - you can define short cuts in $0.short in the format WORD REPLACEME +NTSTRING\n # default short cut are: self/myself for the script's home node # home your home node # scratch your public scratch pad # - after a recent hickup *, I added a timestamp to the file name and +moved things # into a subdirectory. Check timestr / dir / logmaxage below. Files +in $dir # older than logmaxage are deleted. (* 200 OK doesn't always mean th +at the # server side process actually successfully updates the database...) # NOTES # - might be currently restricted to less than 64K node content in htm +l entity # format due to --> paranoia warning (capture groups s +eem # to allow more than 64K nowadays; since at least 5.8 nowadays) # - cannot edit private scratchpad (displaytype clashes with readmode +in server impl) # ??change the substitution list to execute perl or maybe even vimscri +pt as # well, such as e.g. for 'self' remove the old pm_vi and read-in the # current copy for faster updating of nodes # - maybe reload the page from the server after 3sec and compare it to # protect against data loss *? # # BUGS (for small fry see NOTES and /BUG/ below) # - _updating_ home node and scratchpad seems broken # (server side issue with some superdoc-types??) # - no serious bugs known # # Related Examples (node updating/node creation) # - using wiki-style markup 2 perlmonks html in preparation # perl -MText::Textile=textile -lp000we 'INIT{$columns=78} s{\cM?\c +J} [ ]g; $_=wrap(q[],q[ ],textile($_)).$\;' DRAFT.TMP use LWP::UserAgent; use HTML::Entities qw( decode_entities ); use HTTP::Request::Common qw(POST); use Getopt::Long; use strict; use warnings; my $base_url = ""; my $edit_cmd = '"C:\\Program Files\\\\Mozilla\\mozilla.exe" + -editor "file://%s"'; my $verbose=0; my $logmaxage=24*3600*7; my $dir="pm_vi"; my $time=time; my @time=(localtime($time)); $time[4]++; $time[5]+=1900; my $timestr=sprintf("%04d%02d%02d%02d%02d",reverse(@time[1..5])); my $node_id; my $username; my $password; GetOptions( 'node_id|id=s' => \$node_id, 'username=s' => \$username, 'password|pw=s' => \$password, 'editor|edit_cmd=s' => \$edit_cmd, ); #PJ slight unixification # work dir $ENV{TMP}="/tmp" if not $ENV{TMP}; $dir="$ENV{TMP}/$dir"; mkdir $dir if not -d $dir; chmod 0700, $dir; # use .netrc to store auth my $netrc=""; $netrc=$ENV{NETRC} if $ENV{NETRC}; $netrc=$ENV{HOME} . "/.netrc" if not -r $netrc; #PJ please validate & fix these guesses to sane windows locations ZZZZ +ZZZ $netrc=$ENV{HOME} . "/_netrc" if not -r $netrc; $netrc=$ENV{USERPROFILE} . "/_netrc" if not -r $netrc; $netrc='%USERPROFILE%/_netrc' if not -r $netrc; $netrc='%USERPROFILE%/Application Data/_netrc' if not -r $netrc; $netrc="" if not -r $netrc; if ($netrc) { # BUG: this assumes just a single machine entry and doesn't allow # use of multiple IDs - workaround: change $ENV{NETRC} open(FH,"<",$netrc); local $/; $netrc=<FH>; close FH; if ($netrc=~/^machine$/gm) { $netrc=substr($netrc,pos $netrc); if ($netrc=~/^(machine |default)/gm) { $netrc=substr($netrc,0,pos $netrc); $netrc=~s/.*\Z//; } $netrc=~/^\s*login (\S+)/m and $username=$1; $netrc=~/^\s*password (\S+)/m and $password=$1; # just EDITOR instead of e.g. a netrc macro -- $netrc=~/^macdef + editor (\S+)/m and ... $edit_cmd=$ENV{EDITOR} if $ENV{EDITOR}; } } $edit_cmd =~ /%s/ or $edit_cmd .= ' "%s"'; sub prompt_for { my $p = shift; print "\n$p: "; local $_ = <STDIN>; chomp; $_ =~ /^$/ and die "aborted (did you forget the -id option?)\n"; $_ } # PJ allow ARGV[0] as node_id not $node_id and 0==$#ARGV and $node_id=shift; $node_id ||= prompt_for('NodeID'); $username ||= prompt_for('UserName'); $password ||= prompt_for('Password'); # PJ allow a shortcut file of 'string URL' substitution lines my @substitutions=( "self $myself", "myself $myself", "home $username", "scratch $username\'s scratchpad", # sorry, public only, server doe +sn't seem to allow # mode combination to access pri +vate part ); open(FH,"<", "$0.short") and push @substitutions,(<FH>); close FH; foreach(@substitutions){ chomp; my($lhs,$rhs)=($1,$2) if /^(\S+)\s+(.+)$/ or next; $node_id=$rhs if $node_id=~/^\Q$lhs\E$/; } # PJ allow both name or numerical id, by itself or as url my $node_field="node_id"; if ($node_id=~/^(http|perlmonks\.org\/)/i) { if ($node_id=~/node_id=(\d+)/) { $node_id=$1; } elsif ($node_id=~/node=([^;&]*?)(\&|;|\s*$)/) { $node_id=$1; $node_field="node"; } else { die "cannot handle: $node_id\n"; } } else { $node_id=~/\D/ and $node_field="node"; } ## READ my %params = ( op => 'login', user => $username, ticker => 'yes', displaytype => 'xml', xmlstyle => 'flat', $node_field => $node_id, ); # PJ BUG: on a title change, node=... might be troublesome # (at the latest when rerunning pm_vi with the same args) next # is the dir and filename handling hopefully also valid on older windo +ws? my $node_url = "$base_url?$node_field=$node_id"; my $filename=$node_id; $filename=~s![^a-z0-9_\-]!_!gi; $filename = "$dir/node_$node_id" . ( $timestr ? ".".$timestr : "" ) . +".html"; foreach (<$dir/node_*>) { # clean old logs unlink $_ if $time-(stat $_)[9]>$logmaxage; } warn "Node $node_url\nFile $filename\n\n"; # if $verbose; my $ua = LWP::UserAgent->new; $ua->agent("NodeEditor/0.1pj"); my $params = join '&', map { $_ . '=' . $params{$_} } keys %params; my $req = HTTP::Request->new( GET => $base_url.'?'.$params ); my $res = $ua->request($req); $res->is_success or die "GET Error: " . $res->status_line . "\n"; $_ = $res->content; # PJ BUG 64K regex capture limit (seems to be lifted since at least 5. +8. Great!) # (but AFAIR a similar one applies to PM nodes on server side (?)) my ( $text ) = /<doctext\b[^>]*>(.*)<\/doctext>/s; die "GET Error: not a valid node: $node_url\n" if not $text; $text = decode_entities( $text ); my( $title ) = /<node .*\btitle="([^"]*)"/; $title = decode_entities( $title ); my $text_has_dos_eoln = $text =~ /\r\n/ && $text !~ /[^\r]\n/; $text =~ s/\r//g; # PJ remember the original file, strip surrounding whitespace $text=~s/\A\s+//; $text=~s/\s+\z//; my $text_to_edit="<html><head><title>$title</title></head><body>\n$tex +t\n</body></html>\n"; ## EDIT open F, ">", $filename or die "write $filename - $!\n"; print +F $text_to_edit; close F; open F, ">", "$" or die "write $ - $!\n"; prin +t F $text_to_edit; close F; print "\n"; system sprintf $edit_cmd, $filename; open F, "<", $filename or die "read $filename - $!\n"; $_ = do { local $/; <F> }; close F; # PJ and compare, possibly skipping the update my $text_edited=$_; do{warn "unchanged - exiting.\n"; exit 0} if $text_to_edit eq $_; ## WRITE s/^<!DOCTYPE[^>]*>\s*//i; my( $new_title, $new_text ) = /^<html><head><title>([^<]*)<\/title><\/head><body>(.*)<\/body><\/html +>/s or die "you screwed up the format!"; #die "title='$new_title'\n\n'$new_text'\n\n"; $text_has_dos_eoln and $new_text =~ s/\n/\r\n/g; $req = POST $base_url, [ %params, sexisgood => "update", note_title => $new_title, note_doctext => $new_text, passwd => $password, ]; $res = $ua->request($req); $res->is_success or die "POST Error for $node_url: " . $res->status_li +ne . "\n"; print $res->status_line, "(which probably is a lie for scratchpad or h +ome node)\n"; ## SANITY TESTS if any # PJ if this is reached, we could delete the file (for now: keep them) +; # paranoid size warning: # 20K for node source may correspond to 60+K with entities and HTML if (length($text_edited) > length($text_to_edit) and length($text_edit +ed) > 20000) { # BUG or necessary paranoia? warn "Size > 20K - please check the rendering of updated node\n"; warn "URL: $node_url\n"; warn "FILE: $filename\n"; } __END__

Replies are listed 'Best First'.
Re^3: PerlMonks Editor, console version, unix strain
by planetscape (Chancellor) on Oct 03, 2009 at 20:57 UTC