File Coverage

blib/lib/Finance/PaycheckRecords/Fetcher.pm

Criterion	Covered	Total	%
statement	27	56	48.2
branch	0	6	0.0
condition	0	2	0.0
subroutine	9	14	64.2
pod	3	4	75.0
total	39	82	47.5

#---------------------------------------------------------------------
package Finance::PaycheckRecords::Fetcher;
#
# Copyright 2013 Christopher J. Madsen
#
# Author: Christopher J. Madsen
# Created: 4 Feb 2013
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
# GNU General Public License or the Artistic License for more details.
#
# ABSTRACT: Fetch paystubs from PaycheckRecords.com
#---------------------------------------------------------------------

use 5.010;
use strict;
use warnings;

our $VERSION = '1.000';
# This file is part of Finance-PaycheckRecords-Fetcher 1.000 (July 12, 2014)

use Carp ();
use File::Slurp ();
use LWP::UserAgent 6 ();        # SSL certificate validation
use URI ();
use URI::QueryParam ();         # part of URI; has no version number
use WWW::Mechanize 1.50 ();     # autocheck on


#=====================================================================


sub new
{
  my ($class, $user, $password) = @_;

  bless {
    username => $user,
    password => $password,
    mech     => WWW::Mechanize->new,
  }, $class;
} # end new

#---------------------------------------------------------------------
# Get a URL, automatically supplying login credentials if needed:

sub _get
{
  my ($self, $url) = @_;

  my $mech = $self->{mech};

  $mech->get($url);

  if ($mech->form_name('Login_Form')) {
    $mech->set_fields(
      userStrId => $self->{username},
      password  => $self->{password},
    );
    $mech->click('Login', 5, 4);
    # If we still see the login form, we must have failed to login properly
    Carp::croak("PaycheckRecords: login failed")
          if $mech->form_name('Login_Form');
  }
} # end _get

#---------------------------------------------------------------------
sub listURL { 'https://www.paycheckrecords.com/in/paychecks.jsp' }


sub available_paystubs
{
  my ($self) = @_;

  $self->_get( $self->listURL );

  my @links = $self->{mech}->find_all_links(
    url_regex => qr!/in/paystub_printerFriendly\.jsp!
  );

  my %stub;

  for my $link (@links) {
    my $url = $link->url_abs;

    $stub{ $url->query_param('date') // die "Expected date= in $url" }
        = $url;
  }

  \%stub;
} # end available_paystubs
#---------------------------------------------------------------------


sub mirror
{
  my ($self) = @_;

  my $mech = $self->{mech};

  my $stubs = $self->available_paystubs;

  my @fetched;

  foreach my $date (sort keys %$stubs) {
    my $fn = "Paycheck-$date.html";
    next if -e $fn;
    $self->_get($stubs->{$date});
    File::Slurp::write_file( $fn, {binmode => ':utf8'}, $mech->content );
    push @fetched, $fn;
  }

  @fetched;
} # end mirror

#=====================================================================
# Package Return Value:

1;

__END__