Category: | PerlMonks Related Scripts |
Author/Contact Info | davido |
Description: | This is a Janitors tool script used to retitle threads. It doesn't work for non-Janitors. This script replaces Janitors Thread Retitler v1 and Janitors Thread Retitler v2. Unlike previous versions, it requires PerlMonks::Mechanized. This dependancy has facilitated simplifying the code and the adding of "prepare / commit" transactions, allowing Janitors to see all changes before deciding on whether or not to commit them to reality. Using the -help option on the commandline will give usage details. As before, the -debug option will cause the script to do everything except committing the changes, and /msg'ing the author. Basic usage is: retitle.pl -id NNNNN -from "search text" -to "replace text"Other improvements:
Please post questions, additional needs, comments, etc., in this thread so they're all in one place, and so I can respond here. I hope you find this helpful. Enjoy! |
# 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.
|
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Janitors Thread Retitler v3.1
by Steve_p (Priest) on Feb 09, 2005 at 17:31 UTC | |
by davido (Cardinal) on Feb 09, 2005 at 18:56 UTC |