Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister

Janitors Thread Retitler v3.1

by davido (Archbishop)
on Dec 29, 2004 at 09:26 UTC ( #417955=sourcecode: print w/replies, xml ) Need Help??
Category: PerlMonks Related Scripts
Author/Contact Info davido

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: -id NNNNN -from "search text" -to "replace text"

Other improvements:

  • -from option now functions like a search string instead of a full-title match. -from is now mandatory.
  • -to is now a replace string, instead of a full new title.
  • -prompt (default) causes an "are you sure" prompt to occur prior to committing changes. -noprompt will suppress this failsafe measure.
  • -msg (default) causes a simple notification to be sent to the author of the base node via /msg. -nomsg will suppress notification.
  • -ascribe (default) causes simple Janitor attribution at the bottom of the base node. -noascribe (or -noattribute) will suppress Janitor attribution.
  • -unconsider (default) will cause the base node to be unconsidered. -nounconsider (or -nou for short) will suppress this feature.
  • $ENV{PMUSER} and $ENV{PMPASS} must be set in your environment for login to occur.
  • All commandline option names may be abbreviated as one letter (-to = -t, -from = -f, -ascribe = -a). For options such as -ascribe, -prompt, and -msg, their negative abbreviations are -noa, -nop, -nom
  • Edit attribution code now appends the following to the end of the base node being retitled: Retitled by [username] from 'old title'.
  • Wrapped author name in [ ... ] brackets to fix bug where automated /msg couldn't be sent to folks with whitespace in their username.
  • Added a sanity check to prevent automated /msg from being sent to our friend, Anonymous Monk.

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.


# 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      );

    'id=i'                => \$id, 
    'to=s'                => \$new_title,
    'from|old=s'          => \$from,
    'ascribe|attribute!'  => \$ascribe,
    'help|?'              => sub { pod2usage( 
                                    -exitstatus=> 0, 
                             ) },
    '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;
        ( $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->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;
    sleep 1;

print "\nChanges committed.\n";

if( $msg and $author ne "Anonymous Monk") {
    print "Sending /msg to $author.\n";
        last if $DEBUG;
              "/msg [$author] '$original' has been retitled " 
            . "to [id://$id]."

print "Done.\n";

sub my_carp {
    print $_[0], "\n\n";
    pod2usage( -exitstatus => 0, -verbose => 2 );


=head1 NAME
Janitors Thread Retitler

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.


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

    One thing I noticed is that if the node author is Anonymous Monk, it still sends a message. Is this something that we'd really want to do?

      I thought about checking author name, but it didn't really seem worthwhile bothering with it since there's no impact in sending AM a message; it doesn't hurt anything. You can specify -nomessage on the command line (or -nomess for short) to suppress author messaging if you wish though.

      Update 6/7/2005:
      The appearance of a small bug in the automated /msg code gave me a good reason to work on that portion of the code. Consequently, I've now fixed the issue discussed here, and /msg's will not be sent to Anonymous Monk.


Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://417955]
[Corion]: Hi James!
[james28909]: I looked through the docs, and see that PerlApp::exe() is suppose to return this information but whenever i try to use this, i get the error "Undefined subroutine &PerlApp::exe called"
[james28909]: i just want to verify the integrity of the executables name each time it is run.
[Corion]: Weird. this documentation says what you say.
[Corion]: I assume you are experiencing this with your packaged program. Maybe also include in the packaging list?
[james28909]: has anyone else run into this problem? i have tried searching but have not returned many results
[james28909]: ah, good idea.
[Corion]: What does print $PerlApp::VERSION output?

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (7)
As of 2017-07-28 13:55 GMT
Find Nodes?
    Voting Booth?
    I came, I saw, I ...

    Results (429 votes). Check out past polls.