use LWP::UserAgent; use HTML::Entities qw( decode_entities ); use HTTP::Request::Common qw(POST); use Getopt::Long; use strict; use warnings; my $base_url = "http://perlmonks.org/"; my $edit_cmd = '"C:\\Program Files\\mozilla.org\\Mozilla\\mozilla.exe" -editor "file://%s"'; my $node_id; my $username; my $password; GetOptions( 'node_id|id=s' => \$node_id, 'username=s' => \$username, 'password|pw=s' => \$password, 'editor|edit_cmd=s' => \$edit_cmd, ); $edit_cmd =~ /%s/ or $edit_cmd .= ' "%s"'; sub prompt_for { my $p = shift; print "\n$p: "; local $_ = <>; chomp; $_ =~ /^$/ and die "aborted.\n"; $_ } $node_id ||= prompt_for('NodeID'); $username ||= prompt_for('UserName'); $password ||= prompt_for('Password'); my %params = ( op => 'login', user => $username, ticker => 'yes', displaytype => 'xml', xmlstyle => 'flat', node_id => $node_id, ); my $ua = LWP::UserAgent->new; $ua->agent("NodeEditor/0.1 "); my $params = join '&', map { $_ . '=' . $params{$_} } keys %params; my $req = HTTP::Request->new( GET => $base_url.'?'.$params ); my $res = $ua->request($req); $res->is_success or die "GET Error: " . $res->status_line . "\n"; $_ = $res->content; my( $title ) = /]*>(.*)<\/doctext>/s; $text = decode_entities( $text ); my $text_has_dos_eoln = $text =~ /\r\n/ && $text !~ /[^\r]\n/; $text =~ s/\r//g; my $filename = "node_$node_id.html"; my $perl_filename = "$ENV{TMP}/$filename"; open F, "> $perl_filename" or die "write $perl_filename - $!\n"; print F "$title\n$text\n\n"; close F; print "\n"; system sprintf $edit_cmd, $perl_filename; open F, "< $perl_filename" or die "read $perl_filename - $!\n"; $_ = do { local $/; }; close F; s/^]*>\s*//i; my( $new_title, $new_text ) = /^([^<]*)<\/title><\/head><body>(.*)<\/body><\/html>/s or die "you screwed up the format!"; #die "title='$new_title'\n\n'$new_text'\n\n"; $text_has_dos_eoln and $new_text =~ s/\n/\r\n/g; $req = POST $base_url, [ %params, sexisgood => "update", note_title => $new_title, note_doctext => $new_text, passwd => $password, ]; $res = $ua->request($req); $res->is_success or die "POST Error: " . $res->status_line . "\n"; print $res->status_line, "\n";