# retitle.pl v3.11 (The PM::Mech version) # Most recent update dated 6/7/2005. use strict; use warnings; use PerlMonks::Mechanized; use Getopt::Long; use Pod::Usage; our $DEBUG = 0; unless( defined $ENV{PMUSER} and defined $ENV{PMPASS} ) { die "PMUSER and PMPASS must be set as environment variables.\n"; } my $user = $ENV{PMUSER}; # Getopt options: my( $id , $new_title , $from, $ascribe , $msg , $unconsider, $help, $prompt ); GetOptions( 'id=i' => \$id, 'to=s' => \$new_title, 'from|old=s' => \$from, 'ascribe|attribute!' => \$ascribe, 'help|?' => sub { pod2usage( -exitstatus=> 0, -verbose=>2 ) }, 'prompt!' => \$prompt, 'message|msg|notify!' => \$msg, 'unconsider!' => \$unconsider, 'debug' => \$DEBUG ); # Check / Massage options, and set up defaults. # $DEBUG = 1; # Force debug mode. if( $DEBUG ) { print "Debug mode: Changes will not be committed!\n"; } my_carp( "-id NNNNN missing: A valid node ID number must " . "be specified on the command line." ) unless( defined $id and $id =~ m/^\d+$/ ); my_carp( "-from \"....\" missing: A search string must " . "be specified on the command line in the form of " . "a regular expression." ) unless( defined $from and length( $from ) > 0 ); my $regex = qr/(?!(?<=\w)\w)\Q$from\E(?!(?<=\w)\w)/; my_carp( "-to \"....\" missing: A replace string must " . "be specified on the command line." ) unless( defined $new_title ); $prompt = ( defined $prompt and !$prompt ) ? 0 : 1; $unconsider = ( defined $unconsider and !$unconsider ) ? 0 : 1; $msg = ( defined $msg and !$msg ) ? 0 : 1; my $monk = PerlMonks::Mechanized->new(); print "Retrieving thread for ID=$id\n"; my @nodes = @{ $monk->thread_list( $id ) }; print "\tFound ", scalar @nodes, " nodes.\n\n" . "Preparing changes.\n"; my @janitors; my $author; my $original; foreach my $id ( @nodes ) { my $janitor = $monk->janitor( $id ); sleep 2; $janitor->fetch( ( $unconsider and $id == $nodes[0] ) ? 'Unconsider' : '' ); my $title = $janitor->get_title(); my $old = $title; print "$id: $old\n => "; if( $title =~ s/$regex/$new_title/i ) { print "$title\n"; $janitor->set_title( $title ); push @janitors, $janitor; if( $id == $nodes[0] ) { $author = $janitor->get_author(); $author = ( $author eq 'you' ) ? $user : $author; $original = $old; $ascribe = ( defined $ascribe and !$ascribe ) ? '' : "\n\n
Retitled by [$user] from " . "'$original'.
\n\n"; if( $ascribe ) { $janitor->set_doctext( $janitor->get_doctext() . $ascribe ); } } } else { print " No match. Unchanged.\n"; } } print "\nRetitled ", scalar @janitors, " nodes out of ", scalar @nodes, " in the thread based on $id\n\n"; unless( @janitors ) { die "Exiting: Zero nodes were matched for retitling.\n"; } my $continue = ''; if( $prompt ) { print "Commit changes? (y/n)\n"; $continue =