sourcecode
davido
<code>
use strict;
use warnings;
use Getopt::Long;
use WWW::Mechanize 0.74;
use XML::Simple;
# Use your own username and password here.
my $site = "http://www.perlmonks.org/";
my $user = 'someuser';
my $passwd = 'somepassword';
# ----------------------------------------
our $DEBUG = 0;
my( $target, $new_title );
GetOptions( 'id=i' => \$target,
'title=s' => \$new_title,
'debug' => \$DEBUG );
unless( defined( $target )
and defined( $new_title )
and ( $target =~ m/\d+/ )
and ( length( $new_title ) > 3 )
) {
die "Usage: retitle -id nnnnnn -title \"New title...\""
. " [-debug].\n";
}
my $login = "op=login;user=$user;passwd=$passwd;expires=+10y;";
my $agent = WWW::Mechanize->new( 'autocheck' => 1 );
$agent->env_proxy();
my @node_ids = sort { $a <=> $b }
get_node_ids( $target, $login, $agent );
sleep 2;
my $old_title = get_root_title( $node_ids[0], $agent );
print "Original Title: '$old_title'. Continue? (y/n):\n";
my $ok = <STDIN>;
die "Stopped.\n" unless $ok =~ m/^y/i;
foreach my $id ( @node_ids ) {
sleep 2;
edit_title( $id, $agent, $old_title, $new_title );
}
sub get_node_ids {
my( $target, $login, $agent ) = @_;
print "Fetching thread node ID's for id = $target.\n";
$agent->get(
$site . '?'
. $login
. "node_id=180684;id=$target"
);
$agent->success()
or die "Unable to fetch thread for id = $target.\n";
my $xmlref = XMLin( $agent->content(),
ForceArray => 1,
KeepRoot => 1 );
my @node_ids = traverse( $xmlref );
print "\tFetched "
. scalar( @node_ids )
. " node IDs.\n\n";
return @node_ids;
}
sub traverse {
my @nodes;
foreach my $key ( keys %{$_[0]} ) {
if ( ref( $_[0]->{$key} ) ) {
push @nodes, traverse( $_[0]->{$key} );
}
if ( $key =~ m/^\d+$/ ) {
push @nodes, $key;
}
}
return @nodes;
}
sub get_root_title {
my( $target, $agent ) = @_;
print "Fetching title for id = $target.\n";
$agent->get(
"$site?displaytype=xml;node_id="
. $target
);
$agent->success()
or die "Unable to fetch title for id = $target.\n";
my $xmlref = XMLin( $agent->content(),
ForceArray => 1,
KeepRoot => 1 );
print "\tTitle: ",
$xmlref->{'node'}{$target}{'title'},
"\n\n";
return $xmlref->{'node'}{$target}{'title'};
}
sub edit_title {
my( $target, $agent, $from, $to ) = @_;
$agent->get(
"$site?displaytype=editors;node_id="
. $target
);
$agent->success()
or die "Unable to fetch editors form for id://$target.\n";
my $form = $agent->form_name('edit_node');
unless ( $form ) {
die "Couldn't find 'edit_node'.\n";
};
my $old_title = $form->value( 'update_title', 1 );
if ( $old_title !~ m/^(?:Re(?:\^\d+)?:\s*)*\Q$from\E$/i ) {
print "$old_title doesn't match $from. Skipping node.\n";
return;
}
my $new_title = $old_title;
$new_title =~
s/^(Re(?:\^\d+)?:\s*)*\Q$from\E$/(defined($1)?$1:'').$to/ie;
print "Retitling ($target):\n\t'$old_title' =>\n"
. "\t'$new_title'.\n\n";
$agent->field( 'update_title', $new_title );
unless( $DEBUG ) {
$agent->click_button( 'value' => 'update' );
$agent->success() or
die "Couldn't edit $old_title.\n";
}
}
</code>
<p><b>There is a newer version of this code posted at [id://414646]. Both of these have been replaced by [id://417955].</b></p>
<p>
This is a new retitler for the [Janitors] to use in retitling entire threads. It won't work if you're not a [Janitors|janitor], as it requires an edit page only available to the Monastery's cleanup crew. If you're a [Janitors|Janitor], and are tired of manually retitling nodes one by one, and would like an alternative to [id://274951], read on.
</p>
<p>Usage is:</p>
<code>retitle -id NNNNNN -title "New Title Here" [-debug]
</code>
<p>To configure for your system you just need to configure the script with your username and password, on or around line 13 and 14, $user and $passwd.</p>
<p>It works by fetching the [id://72241|XML Node Thread ticker] for the thread specified by the command-line arg "<code>-id NNNNNN</code>". It walks the thread's XML footprint picking each node ID along the way. It then grabs the original title of the root node, and asks for confirmation before proceeding.
</p>
<p>Finally, it uses the editor's view to update the titles for each node id. It leaves "Re:" and "Re^N:" alone, and skips any node whos title is different from the root node's title. That way if someone has intentionally used a different title in a followup it will leave that alone.
</p>
<p>In debug mode, this script simply skips the final step where it normally would submit the change.
</p>
<p>It requires [cpan://WWW::Mechanize] version 0.74 or newer. The version currently available on ActiveState PPM is 0.72, so if you're an ActiveState user you'll have to upgrade WWW::Mechanize through some other means. The most recent version is 1.05, but anything from 0.74 on is fine.
</p>
<p>This was my first dive into using [cpan://WWW::Mechanize] to fill in forms, and it was an educational experience. I'm aware that a similar tool already exists, but I wanted to work through it myself for the practice. My tool uses the XML ticker, which may be less fragile than [Corion]'s bulk-node retitler (no offense to Corion; it was he who pointed out this fact, and the XML ticker wasn't available when he wrote his retitler).
</p>
<p>Since it's a learning experience, I welcome any comments or suggestions for improvement.
</p>
<p>[Janitors], enjoy!</p>
<p><small><b>Updated</b> to expand usefulness to older style "Re: Re:" titles too.</small></p>
PerlMonks Related Scripts
[davido]