# 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<p><small>Retitled by [$user] from " . "'<em>$original</em>'.</small></p>\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 = <STDIN>; chomp $continue; } else { $continue = 'y'; } die "Changes abandoned.\n" unless $continue =~ m/^y/i; print "\nCommitting changes (takes a few seconds per node).\n"; foreach my $janitor ( @janitors ) { print "\t.\n"; next if $DEBUG; $janitor->commit(); sleep 1; } print "\nChanges committed.\n"; if( $msg and $author ne "Anonymous Monk") { print "Sending /msg to $author.\n"; { last if $DEBUG; $monk->say( "/msg [$author] '$original' has been retitled " . "to [id://$id]." ); } } print "Done.\n"; sub my_carp { print $_[0], "\n\n"; pod2usage( -exitstatus => 0, -verbose => 2 ); exit; } __END__ =head1 NAME retitle.pl Janitors Thread Retitler =head1 SYNOPSIS retitle -id nnnnnn -from "Search from" -to "New title" [-[no]ascribe] [-[no]msg] [-[no]prompt] [-help] [-debug] [-unconsider] =head1 OPTIONS =over 8 =item B<-help> Print this help message and exit. (Alias: -?) =item B<-id nnnnn> Target node ID. (Required arg.) =item B<-from "Search text from original title"> This becomes the lefthand arg. for a s/// operator. (Required arg.) ( +Aliases: -from, -old) =item B<-to "New title"> Replace Text. This becomes the righthand arg. for a s/// operator. (Required arg.) =item B<-[no]msg> -msg on by default. Sends notification message to base node's author. -nomsg to suppress. (Aliases: -message, -notify) =item B<-[no]ascribe> -ascribe on by default. Appends Janitor edit attribution to doctext. -noascribe to suppress. (Alias: -attribute) =item B<-[no]unconsider> -unconsider on by default. Unconsiders base node. -nounconsider (or -nou) suppresses unconsidering of base node. =item B<-[no]prompt> -prompt on by default. -noprompt suppresses runtime "proceed?" prompt. =head1 DESCRIPTION B<Janitors Thread Retitler> will follow a target thread (or target subthread) retitling its nodes based on search/replace text. Janitor attribution will be appended on the base node by default. Base node author will be notified of the edit via /msg by default. Command line args may be abbreviated to single letters. PMUSER and PMPASS environment variables should be set prior to running script to facilitate Janitor login.
In reply to Janitors Thread Retitler v3.1 by davido
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |