Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

SlurpPal v1.0

by hacker (Priest)
on Apr 11, 2003 at 17:14 UTC ( [id://249931]=sourcecode: print w/replies, xml ) Need Help??
Category: HTML Utility
Author/Contact Info David A. Desrosiers, aka hacker
desrod at gnu-designs dot com
Description: I was discussing on ChatterBox several different approaches to creating a Donation Tracking "Thermometer" for tracking our community donations to some of our Free Software projects, with the intent of graphing a bandwidth-over-donations display for the users of the various projects. SlurpPal (name subject to change) is the result of some of that code to automate this process.

SlurpPal v1.0 will log into PayPal, "click" the History button, fill out a small form there to set the display History values to the past year of donations for a specified project (based on the email address registered in PayPal with that project), and then print the results. It uses WWW::Mechanize and HTML::TableExtractor to get the bits it needs.

I'm going to be integrating this with some actual graphs (or graphics) to draw the thermometer as discussed in the node above soon. Expect that in version 1.1 of SlurpPal.

Comments, optimizations, criticism, and discussion welcome. Thanks go to (no particular order) tye, bart, Corion, castaway, arturo, and others I may have forgotten.

#!/usr/bin/perl 

use strict;              # of course
use warnings;            # for sanity
use WWW::Mechanize;      # form automation
use HTML::TableExtract;  # fetch table column data

# Sneaky hack to allow 302's to be followed
{ no warnings;
  *WWW::Mechanize::redirect_ok; }

my $pp          = WWW::Mechanize->new();

# Broken into bits for reuse
my $site        = "https://www.paypal.com/cgi-bin";
my $login       = "$site/webscr?__track=_login-run:p";
my $submit      = "$site/$login/gen/login:_login-submit";

# Fetch the main page
$pp->get($submit);

# Enter your PayPal email address to log in here
$pp->field('login_email', 'foo@bar.org');

# PayPal password that matches the above email
$pp->field('login_password', '0bscur3d');

# Submit the above data to the form
$pp->click("submit.x");

# Fetch the history page
my $page_one = $pp->get("$site/webscr?cmd=_history");

# Select "Payments Sent to $project". This key below
# isn't real but in your normal PayPal HTML source, a key
# very similar to it will be real, so use that one instead.
#
# Look for a field that resembles something like the one
# below, if you have multiple email addresses registered
# with PayPal, that is, if not, use the regular item field.
$pp->field('item', '6:ige6R1ps_M9LEaOxaG7_p1tq_h8-9Li00');

# Checkmark (radio button) for "Within"
$pp->field('span', 'broad');

# Last "x" in dropdown. 1=Day, 2=Week, 3=Month, 4=Year
$pp->field('for', '4');

# Send it
my $results = $pp->click("submit.x");

# Fetch the columns out of the tables
get_donations($results);

###########################################
#
# Process the donations, print the results
#
###########################################
sub get_donations {
        my $results = shift;

        my $te = new HTML::TableExtract(headers=> [
                                'Date',
                                'To/From', 
                                'Name/Email', 
                                'Gross\(\$\)', 
                                'Fee\(\$\)', 
                                'Net Amount\(\$\)']);

        $te->parse($results->{_content});

        foreach my $ts ($te->table_states) {
                my ($gross_total, $net_total);

                # Limit to only payments Received, 
                # not payments made FROM PayPal
                for my $row (grep $_->[1] !~ /To/,
                       $ts->rows) {

                        # Remove leading and trailing
                        # spaces from array members. They
                        # show up as   in the HTML and
                        # HTML::TableExtract makes them
                        # spaces
                        tr/\240/ /, 
                                s/^\s+//, 
                                s/\s+$// foreach @$row;

                        # Map scalars to table header names
                        my ($date,         # Donation date
                            $to_from,      # Was it To/From
                            $name,         # Donator
                            $donation,     # Gross donation
                            $paypal_fee,   # PayPal's cut
                            $net_amount,   # Net after cut
                        ) = @$row[0 .. 6];

                        print "Date.......: $date\n";
                        print "Name.......: $name\n";
                        print "Donation...: $donation\n";
                        print "Net Amount.: 
                               $net_amount\n\n";

                        $gross_total += $donation;   
                        $net_total += $net_amount;   
                }
                $gross_total = sprintf("%.02f", $gross_total);
                print "Total donations...:
                       \$$gross_total\n";

                $net_total = sprintf("%.02f", $net_total);
                print "Net after Paypal..:
                       \$$net_total\n\n";
        }
}

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others chanting in the Monastery: (5)
As of 2024-03-28 09:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found