Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/bin/perl -w use strict; use Getopt::Long; use HTTP::Cookies; use LWP::UserAgent; use Term::ReadKey; use URI::URL; use XML::Simple; ###################################################################### +######## # Setup program options ###################################################################### +######## my %options = ( changes => 0, cookie => 1, data => 1, show => undef ); GetOptions( \%options, 'changes', 'cookie!', 'data!', 'show=i' ); $options{changes} = 0 unless $options{data}; my $path = $ENV{HOME} || $ENV{APPDATA} || '.'; ###################################################################### +######## # Setup user agent ###################################################################### +######## my $agent = LWP::UserAgent->new(); $agent->env_proxy(); my $cookie = HTTP::Cookies->new(); $agent->cookie_jar( $cookie ); ###################################################################### +######## # Load user info from cookie or prompt for it ###################################################################### +######## if ( -r "$path/.quickrep.cookie" && $options{cookie} ) { $cookie->load( "$path/.quickrep.cookie" ) or die "Error loading cookie data.\n\n"; } else { print "\nUsername: "; chomp( my $username = <STDIN> ); ReadMode( 'noecho' ); print 'Password: '; chomp( my $password = ReadLine( 0 ) ); ReadMode( 'normal' ); print "********\n"; my $url = URI::URL->new( 'http://www.perlmonks.org/index.pl' ); $url->query_form( op => 'login', user => $username, passwd => $password, expires => '+10y' ); my $request = HTTP::Request->new( GET => $url->as_string() ); my $response = $agent->request( $request ); die "Error logging in: ", $response->message(), "\n\n" unless $response->is_success; die "Error logging in: wrong login or password.\n\n" if $response->content =~ /Oops\. You must have the wrong login or password or some +thing:/; if ( $options{cookie} ) { $cookie->save( "$path/.quickrep.cookie" ) or die "Error saving cookie data.\n\n"; } } ###################################################################### +######## # Download node information XML from Perl Monks ###################################################################### +######## print "\nQuerying perlmonks.org for information:\n\n"; my $url = URI::URL->new( 'http://www.perlmonks.org/index.pl' ); $url->query_form( node => 'User Nodes Info XML Generator' ); my $request = HTTP::Request->new( GET => $url->as_string() ); my $response = $agent->request( $request ); die "Error receiving results: ", $response->message(), "\n\n" unless $response->is_success; die "Error receiving results: received invalid data.\n\n" if ( $response->content =~ /^\r\n$/ ); ###################################################################### +######## # Parse the XML content from Perl Monks ###################################################################### +######## my $xs = XML::Simple->new(); my $new_node_tree = $xs->XMLin( $response->content, keeproot => 1 ); my $new_node_ref = $new_node_tree->{USERNODES}->{NODE}; if ( $options{data} ) { my $old_node_tree = $xs->XMLin( "$path/.quickrep.xml", keeproot => + 1 ) if ( -r "$path/.quickrep.xml" ); open OLD_NODES, ">$path/.quickrep.xml" or die "Error opening XML data file $path/.quickrep.xml\n\n"; print OLD_NODES $xs->XMLout( $new_node_tree, keeproot => 1 ); close OLD_NODES or die "Error closing XML data file $path/.quickrep.xml\n\n"; my $old_node_ref = $old_node_tree->{USERNODES}->{NODE}; foreach my $node_id ( keys %$new_node_ref ) { if ( exists $old_node_ref->{$node_id} ) { $new_node_ref->{$node_id}->{change} = $new_node_ref->{$node_id}->{reputation} - $old_node_ref->{$node_id}->{reputation}; } else { $new_node_ref->{$node_id}->{change} = undef; } } } ###################################################################### +######## # Remove unchange nodes if the --changes options is used ###################################################################### +######## my @nodes = keys %$new_node_ref; if ( $options{changes} ) { @nodes = grep { !defined $new_node_ref->{$_}->{change} || $new_node_ref->{$_}->{change} != 0 } @nodes; die "No nodes have changed.\n\n" unless @nodes; } ###################################################################### +######## # Print the list ###################################################################### +######## my $counter; foreach my $node_id ( map { $_->[0] } sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] } map { [ $_, $new_node_ref->{$_}->{reputation} || 0, lc( $new_node_ref->{$_}->{content} || '' + ) ] } @nodes ) { last if defined $options{show} && ++$counter > $options{show}; my $reputation = $new_node_ref->{$node_id}->{reputation}; my $content = $new_node_ref->{$node_id}->{content}; if ( length $content > 60 ) { $content = substr( $content, 0, 55 ) . " (...)"; } if ( defined $new_node_ref->{$node_id}->{change} ) { my $change = $new_node_ref->{$node_id}->{change}; if ( $change ) { printf( "%+4d\t%3d\t%-s\n", $change, $reputation, $content +); } else { printf( " \t%3d\t%-s\n", $reputation, $content ); } } else { printf( " NEW\t%3d\t%-s\n", $reputation, $content ); } } print "\n"; __END__ =head1 NAME Quickrep, version 1.2.2 Created February 21, 2002 =head1 SYNOPSIS quickrep.pl C<--changes> C<--cookie|--nocookie> C<--data|--nodata> C<- +-show=I> =head1 DESCRIPTION Quickly check changes in your Perl Monks' nodes' reputations. =head1 OPTIONS --changes: Display only those nodes that are new or whose reputations +have changed. --cookie|--nocookie: Save your login information in a cookie file. Fut +ure uses will use the cookie instead of attempting to login again, making the program run faster. Use --nocookie if +you do not wish to save this cookie, for example, if you are logging in from a friend's machine. Cookies are used by d +efault. --data|--nodata: Save an XML file of your nodes' reputations. Quickrep + uses this to measure changes, so disabling this option will prevent you from seeing any changes. The data file is + used by default. --show=I: Show only the top I nodes. =head1 CHANGELOG 1.2.2 Added pod documentation. Changed copyright information. Now abbreviating long node titles. 1.2.1 Changed the way the 'changes' option is handled. Minor formatting edits. Added additional trailing newlines. 1.2.0 Changed some of the data structures used. Added 'show' and 'changes' command line options. Added changelog. 1.1.1 Cleaned up unnecessary code. 1.1.0 Added 'cookie' and 'data' command line options. Quickrep now saves the user's cookie. Added username/password prompts. 1.0.1 Small formatting error fixed. Added proxy support. 1.0.0 Quickrep released. =head1 AUTHOR patgas =head1 COPYRIGHT Copyright (c) 2002 patgas on http://www.perlmonks.org. All rights rese +rved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

In reply to Quickrep by patgas

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!
  • 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
  • Outside of code tags, you may need to use entities for some characters:
            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 scrutinizing the Monastery: (8)
    As of 2014-11-24 08:26 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My preferred Perl binaries come from:














      Results (137 votes), past polls