Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
use strict; use warnings; use Getopt::Long; use WWW::Mechanize 0.74; use XML::Simple; # Use your own username and password here. my $site = "http://www.perlmonks.org/"; my $user = 'someuser'; my $passwd = 'somepassword'; # ---------------------------------------- our $DEBUG = 0; my( $target, $new_title ); GetOptions( 'id=i' => \$target, 'title=s' => \$new_title, 'debug' => \$DEBUG ); unless( defined( $target ) and defined( $new_title ) and ( $target =~ m/\d+/ ) and ( length( $new_title ) > 3 ) ) { die "Usage: retitle -id nnnnnn -title \"New title...\"" . " [-debug].\n"; } my $login = "op=login;user=$user;passwd=$passwd;expires=+10y;"; my $agent = WWW::Mechanize->new( 'autocheck' => 1 ); $agent->env_proxy(); my @node_ids = sort { $a <=> $b } get_node_ids( $target, $login, $agent ); sleep 2; my $old_title = get_root_title( $node_ids[0], $agent ); print "Original Title: '$old_title'. Continue? (y/n):\n"; my $ok = <STDIN>; die "Stopped.\n" unless $ok =~ m/^y/i; foreach my $id ( @node_ids ) { sleep 2; edit_title( $id, $agent, $old_title, $new_title ); } sub get_node_ids { my( $target, $login, $agent ) = @_; print "Fetching thread node ID's for id = $target.\n"; $agent->get( $site . '?' . $login . "node_id=180684;id=$target" ); $agent->success() or die "Unable to fetch thread for id = $target.\n"; my $xmlref = XMLin( $agent->content(), ForceArray => 1, KeepRoot => 1 ); my @node_ids = traverse( $xmlref ); print "\tFetched " . scalar( @node_ids ) . " node IDs.\n\n"; return @node_ids; } sub traverse { my @nodes; foreach my $key ( keys %{$_[0]} ) { if ( ref( $_[0]->{$key} ) ) { push @nodes, traverse( $_[0]->{$key} ); } if ( $key =~ m/^\d+$/ ) { push @nodes, $key; } } return @nodes; } sub get_root_title { my( $target, $agent ) = @_; print "Fetching title for id = $target.\n"; $agent->get( "$site?displaytype=xml;node_id=" . $target ); $agent->success() or die "Unable to fetch title for id = $target.\n"; my $xmlref = XMLin( $agent->content(), ForceArray => 1, KeepRoot => 1 ); print "\tTitle: ", $xmlref->{'node'}{$target}{'title'}, "\n\n"; return $xmlref->{'node'}{$target}{'title'}; } sub edit_title { my( $target, $agent, $from, $to ) = @_; $agent->get( "$site?displaytype=editors;node_id=" . $target ); $agent->success() or die "Unable to fetch editors form for id://$target.\n"; my $form = $agent->form_name('edit_node'); unless ( $form ) { die "Couldn't find 'edit_node'.\n"; }; my $old_title = $form->value( 'update_title', 1 ); if ( $old_title !~ m/^(?:Re(?:\^\d+)?:\s*)*\Q$from\E$/i ) { print "$old_title doesn't match $from. Skipping node.\n"; return; } my $new_title = $old_title; $new_title =~ s/^(Re(?:\^\d+)?:\s*)*\Q$from\E$/(defined($1)?$1:'').$to/ie; print "Retitling ($target):\n\t'$old_title' =>\n" . "\t'$new_title'.\n\n"; $agent->field( 'update_title', $new_title ); unless( $DEBUG ) { $agent->click_button( 'value' => 'update' ); $agent->success() or die "Couldn't edit $old_title.\n"; } }

In reply to Janitors Thread Retitler v1 by davido

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (7)
    As of 2021-01-26 12:35 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Notices?