Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

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.org 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:

  • -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.

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.

Comment on Janitors Thread Retitler v3.1
Download Code
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.


      Dave

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://417955]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (5)
As of 2014-11-29 01:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (203 votes), past polls