intro and script to add links

[Uli Stern]

Hi,

A quick intro: my name is Uli Stern. For background on me, see

http://www.linkedin.com/in/ulrichstern

Below a Perl script I just wrote that retrieves a PBworks page,
modifies it, and writes it back. I did not find too much sample code,
so this may be useful for others. The modification is turning numbers
in a certain table column into links to "http://stockcenter.vdrc.at/
control/product/~product_id=<number>", which makes life a little
easier for PBworks users in my wife's neurobio lab.

Cheers,

U*

---

###############################################################################
#
# add links to PBworks page
#
# Jun 17th 2010 by Ulrich Stern
#
###############################################################################
#
# inputs:
# pass any argument for "execute mode" instead of "test mode"
#

use Data::Dumper;
use LWP::UserAgent;
use JSON::XS;

use strict;

my $wk = "<Writer Key>";
my $page = "API Test";
my $yl = "https://yanglab.pbworks.com/api_v2/op";
my $vdrc = "http://stockcenter.vdrc.at/control/product/~product_id=";

my $ua = new LWP::UserAgent;
my $pageTypeKey = "page/$page/_type/jsontext/write_key/$wk";

my $test = @ARGV == 0;
print "*** test mode ***\n\n" if ($test);

print "retrieving page \"$page\"...\n\n";
my $r = execute("$yl/GetPage/$pageTypeKey");
#print Dumper($r);

print "processing...\n";
my $html = $$r{html};
die "no html returned" unless ($html);
my $origHtml = $html;
my ($colIdx, $rowIdx, $numCols) = (0, 0, -1);
my @chs = ();
$html =~ s/(<tr>.*?<\/tr>)/processTr($1)/sge;
my $mod = $origHtml ne $html;
die "internal error" if ($mod && ! @chs || ! $mod && @chs);

print "table rows: $rowIdx\n";
print "changes: " . @chs . "\n";

print "\ndetails on changes:\n " . (@chs > 10 ?
join("\n ", @chs[0..9]) . "\n ..." : join("\n ", @chs)) . "\n"
if ($test && @chs);

if (! $test && $mod) {
print "\nwriting page...\n";
my $r = execute("$yl/PutPage/$pageTypeKey", $html);
print "status: " . ($$r{success} ? "success\n" : "error:\n" .
Dumper($r));
}

# - - -

# executes the given PBworks API operation and returns reference to
response
# hash
sub execute {
my ($url, $html) = @_;
my $rsp = ($html) ? $ua->post($url, [html=>$html]) : $ua->get($url);
my ($json) = $rsp->content =~ /^[^{]*(\{.*\})/;
return decode_json $json;
}

# process the HTML from <tr> to </tr>
sub processTr {
my ($row) = @_;
$colIdx = 0;
$row =~ s/(?<=<td>)(.*?)(?=<\/td>)/processTd($1)/sge;
if ($numCols < 0) {
$numCols = $colIdx;
}
else {
die "expected $numCols columns in row:\n $row"
unless ($numCols == $colIdx);
}
$rowIdx++;
return $row;
}

# process the HTML between <td> and </td>
# note: $colIdx gives column index (0, 1, ...)
sub processTd {
my ($cell) = @_;
my $orig = $cell;
if ($colIdx == 1) {
$cell =~ s/^\s*(\d+)/<a href="$vdrc$1">$1<\/a>/s;
}
push @chs, "$orig -> $cell" if ($orig ne $cell);
$colIdx++;
return $cell;
}