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 = ; 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"; } }