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