Category: | PerlMonks Related Scripts |
Author/Contact Info | davido |
Description: | This script has been replaced by Janitors Thread Retitler v3.1. This script is for use by Janitors. It won't work for you if you're not a Janitor (unless you're a janitor you don't need it). This is an improved version of Janitors Thread Retitler v1. I have made the following changes and improvements by popular request. I believe I've implemented just about all of the suggestions. Hopefully this will make the script more usable.
Please run the script with the -help option to learn about the improvements to its user interface. Also, please run it once in -debug mode to test it before firing it off live for the first time. Note that even though its flexibility has been greatly expanded, it may still be used exactly as the original version if you prefer to not learn its new features. I believe at this point I've addressed the bulk of the suggestions / needs discussed in the thread for the original Janitors Thread Retitler v1. But I'm still open for suggestions on how this might be made more useful. Update: Still working on...: |
use strict; use warnings; use Getopt::Long; use Pod::Usage; use WWW::Mechanize; use XML::Simple; my $site = "http://www.perlmonks.org/"; # env vars must contain username and password. my( $user, $passwd ) = ( $ENV{PMUSER}, $ENV{PMPASS} ); our $DEBUG = 0; my( $target, $new_title, $from, $attribution, $help, $man ); GetOptions( 'id|i=i' => \$target, 'to|title|t=s' => \$new_title, 'from|f=s' => \$from, 'attrib|attr|a:s' => \$attribution, 'help|h|man|m|?' => \$help, 'debug|d' => \$DEBUG ); # $DEBUG = 1; # Force debug mode. if( $help ) { pod2usage( -exitstatus => 0, -verbose => 2 ); exit; } unless( defined( $target ) and defined( $new_title ) and ( $target =~ m/\d+/ ) and ( length( $new_title ) > 3 ) ) { die "Usage: retitle -id nnnnnn -to \"New title...\"" . " [-from \"Old title...\"] [-debug].\n"; } if ( defined $attribution ) { if ( length( $attribution ) == 0 ) { # -attrib used on command line without text. # Do not attribute edit. $attribution = ''; } else { # -attrib used on command line with text. # Massage the supplied text. $attribution = "\n<p><small>Retitled by [$user]: " . "$attribution</small></p>\n"; } } else { # -attrib not used on the command line. # Use default attribution. $attribution = "\n<p><small>Retitled by [$user].</small></p>\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 ); die "Zero nodes found.\n" unless @node_ids; sleep 2; my $old_title = get_root_title( $node_ids[0], $agent ); if ( defined( $from ) ) { unless ( $from eq $old_title ) { die "Title mismatch:\n\tLooked for => '$from'.\n" . "\tFound => '$old_title'.\n"; } } else { print "Original Title: '$old_title'. Continue? (y/n):\n"; my $ok = <STDIN>; die "Stopped.\n" unless $ok =~ m/^y/i; } $old_title =~ s/^Re(?:\^\d+)?:\s*//; # Facilitate following # subthreads as base targets. foreach my $id ( @node_ids ) { sleep 2; edit_node( $id, $agent, $old_title, $new_title, $attribution ); $attribution = ''; # Only give attribution in root node. } 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_node { my( $target, $agent, $from, $to, $attrib ) = @_; $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 ); my $doctext = $form->value( 'update_doctext', 1 ); $doctext = $doctext . $attrib; $agent->field( 'update_doctext', $doctext ); unless( $DEBUG ) { # Stolen from Corion's version at castaway's suggestion: $agent->current_form->value( 'blah', 'update' ); $agent->click( 'blah' ); # davido's original: # $agent->click_button( 'value' => 'update' ); $agent->success() or die "Couldn't edit $old_title.\n"; } } __END__ =head1 NAME retitle.pl Bulk Thread Retitler =head1 SYNOPSIS retitle -id nnnnnn [-from "Orig title"] -to "New title" [-attrib "Attribution text"] [-help] [-debug] =head1 OPTIONS =over 8 =item B<-help> Print this help message and exit. =item B<-id nnnnn> Target node ID. (Required arg.) =item B<-from "Orig title"> Original title to match. If supplied, script runs without prompting. Without this arg, script runs in interactive (prompt) mode. =item B<-to "New title"> New title. (Required arg.) =item B<-attrib ["Attribution text"]> Supply -attrib without text to cancel editor attribution. Supply -attrib with text to specify additional info after editor attribution. If -attrib is not specified on the command line, a default attribution is used. =item B<-i -f -t -h -? -a -attr> All legal abbreviations of command line options. =head1 DESCRIPTION B<Bulk Thread Retitler> will follow a target thread (or target subthread) retitling its nodes. Janitor attribution will be appended on the base node (optionally this can be squelched). If a -from title isn't supplied, the script will fetch original title from the target ID and prompt for the go-ahead to continue. Otherwise, the script runs without further interaction. It is neccessary to set ENV variables PMUSER and PMPASS. |