Beefy Boxes and Bandwidth Generously Provided by pair Networks Russ
Welcome to the Monastery
 
PerlMonks  

Quickrep

by patgas (Friar)
on Sep 10, 2001 at 18:27 UTC ( #111464=sourcecode: print w/ replies, xml ) Need Help??

Category: PerlMonks.org Related Scripts
Author/Contact Info patgas
Description:

Quickly check changes in your Perl Monks nodes' reputations. It will list all of your nodes, sorted by reputation in descending order, with any changes since the last time you ran Quickrep.

#!/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.

Comment on Quickrep
Download Code
Re: Quickrep
by stefan k (Curate) on Sep 10, 2001 at 19:02 UTC
    First of all: as always your work is appreciated.
    Then some remarks... I installed XML::Simple from CPAN and can't connect to perlmonks.org because I'm living behind a very strict firewall. Then you'll find that the error message should be rearranged:
    from:
    die "Error logging in: $result->code() $result->message()"
    to
    die "Error logging in:\nCode:", $result->code(), "Reason: ", $result- +>message(), "\n"
    Now I'll give it -say- 5 minutes to find out how to get through the FW using a proxy... hang on :)

    Update1: Somehow the env_proxy() method (as described in man lwpcook doesn't work, so I use this (add after the cookie-jar line)

    if (defined $ENV{'http_proxy'}) { print "Using HTTP Proxy: $ENV{'http_proxy'}\n"; $agent->proxy(http => $ENV{'http_proxy'}); }
    Now I'll take a short look what goes wrong with nodes having a negative reputation (yes, I got one of those, you should have one, too: just for testing purposes *grin*)

    Update2 Just replace the %3u in the printf statements at the end of the script by %3d so we can display negative numbers...

    Update3: Sorry, a '\' has sneak into the first fix: right before the 'R' of 'Reason'. Removed it...

    Regards... Stefan
    you begin bashing the string with a +42 regexp of confusion

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (8)
As of 2014-04-23 21:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (555 votes), past polls