# 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.
[download]