package WWW::TWikiClient;
use WWW::Mechanize;
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '0.11';
use base 'WWW::Mechanize';
use Class::MethodMaker
get_set => [
'bin_url',
'current_default_web',
'current_topic',
'auth_user',
'auth_passwd',
'override_locks',
'release_edit_lock',
'verbose',
'skin_hints',
],
new_hash_init => 'hash_init'
;
sub new {
my $class = shift;
my $self = WWW::Mechanize::new ($class);
$self->pre_init ();
$self->hash_init (@_);
$self->post_init ();
return $self;
}
sub pre_init {
my $self = shift;
$self->override_locks (0);
$self->release_edit_lock (1);
$self->verbose (0);
$self->skin_hints ({});
}
sub post_init {
my $self = shift;
}
# overloaded to provide username and password
# that we have in two own getters/setters
sub get_basic_credentials {
my $self = shift;
return ($self->auth_user, $self->auth_passwd);
}
# constructs URL
# if topic doesn't contain a Web prefix, "current_default_web" is prepended
sub _make_url {
my $self = shift;
my $cmd = shift;
my $topic = shift;
my $tail = shift;
my $url = $self->bin_url;
if ($topic =~ /\./) {
$topic =~ s!\.!/!;
} else {
$topic = $self->current_default_web."/$topic";
}
$url .= '/' if $url !~ m!/$!;
$url .= "$cmd/";
$url .= $topic;
$url .= $tail if $tail;
return $url;
}
sub _skin_regex_topic_locked {
my $self = shift;
return qr/\(oops\).*name="Topic_is_locked_by_another_user"/s;
}
sub _skin_regex_topic_locked_edit_anyway {
my $self = shift;
return qr/Edit anyway/;
}
sub _skin_regex_authentication_failed {
my $self = shift;
return qr/TWikiRegistration.*\(oops\).*name="Either_you_need_to_register_or_t"/s;
}
sub _skin_regex_save_or_preview_page {
my $self = shift;
my $topic = shift || ''; # needed for "where I am"-heuristic
return qr/form name=".*".*action=".*\/save\/.*$topic">/s;
}
# a little helper function
sub _htmlparse_get_text {
my $self = shift;
my($p, $stop) = @_;
my $text;
while (defined(my $t = $p->get_token)) {
if (ref $t) {
$p->unget_token($t) unless $t->[0] eq $stop;
last;
}
else {
$text .= $t;
}
}
return $text;
}
sub htmlparse_extract_single_textarea {
my $self = shift;
my $doc = shift || $self->doc || '';
my @FORM_TAGS = qw(form textarea);
my $p = HTML::PullParser->new (
doc => $doc,
start => 'tag, attr',
end => 'tag',
text => '@{text}',
report_tags => \@FORM_TAGS,
);
while (defined(my $t = $p->get_token)) {
next unless ref $t; # skip text
if ($t->[0] eq "form") {
shift @$t;
while (defined(my $t = $p->get_token)) {
next unless ref $t; # skip text
last if $t->[0] eq "/form";
if ($t->[0] eq "textarea") {
return $self->_htmlparse_get_text ($p, "/textarea");
}
}
} elsif ($t->[0] eq "textarea") {
return $self->_htmlparse_get_text ($p, "/textarea");
}
}
return undef;
}
sub edit_press_cancel {
my $self = shift;
my $url = $self->_make_url ('view', $self->current_topic, '?unlock=on');
#print STDERR "edit_press_cancel: $url\n" if $self->verbose;
$self->follow_link (url => $url);
}
sub read_topic {
my $self = shift;
my $topic = shift || $self->current_topic;
my $url = $self->_make_url ('view', $topic, '?raw=on');
#print STDERR "read_topic: $url\n" if $self->verbose;
$self->get ($url);
return $self->htmlparse_extract_single_textarea ($self->content);
}
sub _handle_release_edit_lock {
my $self = shift;
my $unlock_checkbox = $self->current_form->find_input ('unlock', 'checkbox');
# "release edit lock"
if ($unlock_checkbox) {
if ($self->release_edit_lock) {
$self->tick ('unlock', 'on');
} else {
$self->untick ('unlock', 'on');
}
}
}
sub save_topic {
my $self = shift;
my $content = shift;
my $topic = shift || $self->current_topic;
my $url = $self->_make_url ('edit', $topic);
#print STDERR "save_topic: $url\n" if $self->verbose;
# get page
$self->get ($url);
# locked?
$self->_save_topic_handle_locks ($url) or return undef;
# fill form
$self->form_number (1);
$self->current_form;
$self->set_fields ( text => $content );
$self->_save_topic_Save ($topic);
return 1;
}
sub attach_to_topic {
my $self = shift;
my $local_filename = shift;
my $comment = shift;
my $create_link = shift;
my $hide_file = shift;
my $topic = shift || $self->current_topic;
my $url = $self->_make_url ('attach', $topic);
print STDERR "attach_to_topic url: $url\n" if $self->verbose;
# get page
$self->get ($url);
# fill form
$self->form_number (1);
$self->current_form;
$self->set_fields
(
filepath => $local_filename,
filecomment => $comment,
);
$self->tick ('createlink', 'on') if $create_link;
$self->tick ('hidefile', 'on') if $hide_file;
$self->submit();
return;
}
sub _save_topic_handle_locks {
my $self = shift;
my $url = shift;
my $html_content = $self->content;
if ($html_content =~ $self->_skin_regex_topic_locked) {
if ($self->override_locks) {
# edit anyway
print STDERR "Override topic lock.\n" if $self->verbose;
$self->follow_link (text_regex => $self->_skin_regex_topic_locked_edit_anyway);
$self->get ($url);
} else {
print STDERR "Topic is locked.\n" if $self->verbose;
return undef;
}
} elsif ($html_content =~ $self->_skin_regex_authentication_failed) {
print STDERR "Access denied. Authentication failed.\n" if $self->verbose;
return undef;
}
return 1;
}
sub _save_topic_Save {
my $self = shift;
my $topic = shift || ''; # needed for "where I am"-heuristic
$self->_handle_release_edit_lock;
# simply submit (== either "Preview Changes" or "Save Changes")
$self->submit();
# did we arrive at a preview page?
my $content = $self->content;
if ($content =~ _skin_regex_save_or_preview_page ($topic)) {
# simply submit again (== "Save Changes")
$self->_handle_release_edit_lock;
$self->submit();
}
}
1;