#!/usr/bin/perl -w
#
# wikipage_injector v0.02       --crb3 24/27jan03
#
# inject a text page into a local or remote UseMod-type wiki
# without going through a standard browser.
#
# useful for initializing a wiki with useful topical information
# quickly, or working on a wikipage in an editor rather than in
# a browser's FORM textarea. initially developed in order to put
# webcal event details into an annotatable webside display,
# pursuant to propagating KDE's korganizer calendar events to
# webcal for intranet viewing.
#
# This program is licensed under the GNU GPL or the Perl Artistic
# License, your choice, but please send me any improvements... I
# make no claim of mastery of Perl beyond getting the job done.
# C. R. Bryan III (CrB3) crb3@stormbringer.org
#
# 27jan03 v0.02: added batch looping. minimally tested.
#
# /home/crb3/crb3/perl/s/skt/
#
use LWP;
use Getopt::Std;


$wikiline="\n-----\n";                  # how to make a wiki <hr>


#
# these params will be set by commandline and/or file args, but
# you'll want to tweak them for convenience.
#
$whost="bifrostr.pinehill.stormbringer.org";
$wiki="/cgi-bin/wiki.cgi";
$wikipage="WikiInjectorTestPage";
$wikiurl="http://$whost$wiki";

$append=1;
$gotbody=0;

unless(defined($ARGV[0])){

print <<EOT;
$0 comand args:
-h      specify host system
-w      specify path to wiki
-p      WikiPageName
-t      bodytext of page
-f      file containing page stuff
        use instead of -p-t: they'll overwrite
-a      toggle. 1: append 0: replace text if page exists. $append default.
...or set these parameters in the script itself and invoke with just
multiple filenames:
$0 file1 file2 file3
 or
$0 file*
EOT

exit(0);
}

getopt('hwptf');                        # these take args
$whost=     $opt_h if defined $opt_h;
$wiki=      $opt_w if defined $opt_w;
$wikipage = $opt_p if defined $opt_p;
if(defined($opt_t)){
  $bodytext = $opt_t;
  $gotbody=1;
}
$infile =   $opt_f if defined $opt_f;
$append =   $opt_a if defined $opt_a;
#
# adjust these params to the actual wiki. The localhost one fits
# a wiki I modified to be a little more enticing, the other is
# the standard one emitted by vanilla umwiki code. in either
# case, it's the placeholder page-text the wiki inserts when it
# finds itself at a loss for words. even when we're appending,
# we want to elide that.
#
if($whost eq "localhost"){
  $nothing="Nothing written yet...";
}else{
  $nothing="Describe the new page here.";
}
$f_infile=$infile if defined $opt_f;    # save for after the loop

$wikiedit = "action=edit&id=$wikipage";

# You are free to put whatever UserAgent the relevant server
# will accept into the agent field. Be advised that there really
# is a product out there called WebStar, and it had nothing to
# do with MicroPro International, the vendor of WordStar in the
# CP/M days. The LWP library will tack its own ID onto the end;
# keep that in mind when you're deciding what you're going to
# put in the server's access_log to confound the sysadmins.
#
  my $ua = LWP::UserAgent->new();
#$ua->agent("wikipage_injector/0.2 ");
  $ua->agent("Mozilla/9.1 (compatible; WebStar 3.3; CP/M 2.2) ");



#
# batch-looping using bash wildcarding. invoked if there are
# any leftover unflagged args on the command-line. if that's
# how you want to run it, don't use the -p-t flags on the
# command-line, and do edit the default parameters for the
# switched args up top to support the batch run.
#
while(defined($ARGV[0])){
  $infile=shift(@ARGV);
  &inject_wikipage;
}
if(defined($f_infile)){
  $infile = $f_infile;
  &inject_wikipage;
}
exit(0);

#-------------------------
# inject_wikipage.
# guts of the program, pushed down into a function for looping
# purposes. most of the vars are global.
#
# fetch in the args-specified text file. Its first line
# is treated as the WikiPage title IF there's no -t overriding
# it, otherwise it's treated as any other line.
# No special packing is done to generate a valid WikiName here;
# the calling program or human is responsible for that.
Note that, if -t provides a title, and there's a valid WikiName
# in the first line, that line will show as a NewPage? link.
#
sub inject_wikipage {

  if(defined($infile)){
    open(IFIL,"<$infile"or die "$0: can't find infile $infile\n";
    my $state=0;
    $bodytext="" unless $opt_t;
    while(defined($inline=<IFIL>)){
      if($state==0){
        unless(defined($opt_w)){                # -w overrides
          next if $inline =~ /^\s*$/;   # skip empty first line
          $wikipage=$inline;
          chomp $wikipage;
          $state++;
          next;
        }else{
          $state=1;                     # and fall through
        }
      }
      unless($gotbody){                 # -t overrides
        chomp $inline;                  # crudely convert from
        $bodytext.="$inline\r\n";               # unix to cp/m eol
      }
    }
    close(IFIL);
  }
#
# we've got the new contents. now to deal with the old stuff, if
# any. the wiki will send us a page no matter what; we'll have
# to screenscrape it to see if it's a Real Page or a Sears Page.
#
# Now a multi-stanza duet with the wiki.
#
#
# fetch in the edit-page; it's got hidden fields we need to send
# back, as well as any prior content other than the new-page
# place-holder.
# ** If you change $wikiedit, be sure to change these fields. **
#
  $resp=$ua->post$wikiurl,
                [ action => "edit", id => $wikipage ],
                referer => 'http://heimdall.asgard.stormbringer.org',
                content_type => 'application/x-www-form-urlencoded',
              );

  if($resp->is_error){
    printf "%s\n",$resp->status_line;
    die "$0: no dice fetching $wikiurl?action=edit&id=$wikipage\n";
  }

#
# the response comes back as one long string containing the entire
# edit-this webpage. that's easier to crack open than an array of
# lines, as long as we've got good page-scraping landmarks.
#
  $bod=$resp->content;
  my($bodhead,$oldbody,$bodtail)=split('TEXTAREA',$bod,3);
  $oldbody =~ s/^.+WRAP\=\"virtual\"\>//;       # whack off rest of TEXTAREA token
  $oldbody =~ s/\r?\n\<\/$//;           # regex it, we need that back edge
  $oldbody =~ s/$nothing//;     # get rid of new-page placeholder text

  if($append and $oldbody ne ""){
    $bodytext = $oldbody . $wikiline . $bodytext . "\n";
  }

  $content{"title"}=$wikipage;          # begin building the POST.
  undef($resp);                         # we keep recycling the name.
#
# now for those hidden fields... they're on either side of the
# TEXTAREA, so, cheezy or not, slap em together to make one
# looping run out of it all.
# we need someplace to put these key/value pairs as we find 'em, so
# it's time to build the new request to pass in the edited page with.
# the fields will go to the server in the hash's own order, but umwiki
# doesn't mind.
#
  $bod$bodhead . $bodtail;

  $inhid="<INPUT TYPE\=\"hidden\"";
  $inhidlen=length($inhid);
  $innam="NAME=\"";
  $innamlen=length($innam);
  $inval="VALUE=\"";
  $invallen=length($inval);
#
# perhaps the following handling could have been done way better
# by a true perlmonk, but my C-background approach got the job
# done.  yes, those indices are being used as good ol' pointers.
# yes, i've done such things this way since assembly. yes, it
# works.
#
  my $pt=-1;
  while( ($pt=index($bod,$inhid,$pt+$inhidlen)) > -1){

    my $pta = index($bod,$innam,$pt)+$innamlen;
    my $hidnamesubstr($bod,$pta);
    substr($hidname,index($hidname,'"'))="";

    my $ptb = index($bod,$inval,$pta+$innamlen)+$invallen;
    my $hidvalsubstr($bod,$ptb);
    substr($hidval,index($hidval,'"'))="";

# add hidnam => hidval to the developing request...

    $content{$hidname}=$hidval;

  }
  $content{"text"}=$bodytext;   # ...and the page text itself.

  $rsp0=
  $ua->post(    "$wikiurl?$wikiedit",
                \%content,
                referer => "$wikiurl?$wikipage",
        );


  if($rsp0->is_error){
    printf "%s\n",$rsp0->status_line;
    die "$0: couldn't write $wikiurl?$wikipage\n";
  }
  undef(%content);
  undef($rsp0);         # recycle the names
}

__END__

...ready-to-hand for debugging changes; just move
the END statement below this code. (I also used
netpeek to inspect the actual packets sent.)

use Data::Dumper;
sub dumpit {
  my $e=shift(@_);

  my $dump=Dumper($e);
  print $dump;
  print "\n";
  1;
}
Grab the
tarball
here
 
Syntax highlighting using Syntax::Highlight::Engine::Kate