Commit first working version of psk_download.pl.
[toast/webscraper/psk.git] / psk_download.pl
1 #!/usr/bin/perl
2
3 # mech-dump --all https://ebanking.bawagpsk.com/InternetBanking/InternetBanking?d=login&svc=BAWAG&ui=html&lang=de
4
5 use strict;
6 use warnings;
7 use Carp;
8 use 5.010;
9
10 use Config::Auto;
11 use WWW::Mechanize;
12
13 use Pod::Usage;
14 use Getopt::Long;
15 use File::Spec::Functions qw(catfile);
16 use File::Basename qw(dirname);
17
18 use constant DEBUG => 0;
19
20 # options
21 debug("Parse options ...");
22 my $opt_help = 0;
23 my $opt_man  = 0;
24 GetOptions( 'help|?' => \$opt_help, 'man' => \$opt_man ) or pod2usage(2);
25 pod2usage( -verbose => 1 ) if ($opt_help);
26 pod2usage( -verbose => 2 ) if ($opt_man);
27
28 # get config
29 # $ENV{HOME} . '/.psk_downloadrc': verfuegernummer, pin
30 debug("Read config ...");
31 my $config = Config::Auto::parse();
32 croak "We need verfuegernummer and pin in $ENV{HOME}/.psk_downloadrc"
33     unless ( $config->{verfuegernummer}
34     && $config->{pin} );
35
36 my $dir = $ARGV[0] || $config->{dir} || dirname($0);
37 $dir =~ s{^~/}{$ENV{HOME}/};
38 croak "Directory '$dir' doesn't exist." unless -d $dir;
39
40 # login
41 debug("Log in ...");
42 my $url
43     = 'https://ebanking.bawagpsk.com/InternetBanking/InternetBanking?d=login&svc=BAWAG&ui=html&lang=de';
44 my $mech = WWW::Mechanize->new( autocheck => 1, );
45 $mech->add_header( 'Accept-Encoding' => 'identity' );    # no gzip
46 $mech->get($url);
47
48 my $r = $mech->submit_form(
49     form_name => 'loginForm',
50     fields    => {
51         dn  => $config->{verfuegernummer},
52         pin => $config->{pin},
53     },
54 );
55 croak "Couldn't submit form 'loginForm'." unless $r->is_success;
56
57 # after logging in we use the navigationform to go the the accountstatementlist
58 # built after the javascript function navigateTo
59 debug("Account statement list ...");
60 $r = $mech->submit_form(
61     form_name => 'navigationform',
62     fields    => { d => 'accountstatementlist', },
63 );
64 croak "Couldn't submit form 'navigationform'." unless $r->is_success;
65
66 # links to PDFs
67 debug("PDF links ...");
68 my @pdflinks = $mech->find_all_links( text => 'anfordern' );
69 croak "Couldn't find any download links." unless scalar @pdflinks;
70
71 debug("Loop over links ...");
72 for my $link (@pdflinks) {
73
74     # built after the javascript function getPdfStatement
75     my $onclick = $link->attrs->{'onclick'};
76
77     # 'onclick' => 'getPdfStatement(\'30\',\'07.10.2013\');',
78     my ( $index, $cd ) = ( $onclick =~ m/.*'(\d+)','([\d.]+)'.*/ );
79     debug( "Check $index of " . scalar @pdflinks . " ..." );
80
81     # download only once
82     my @files = glob "*_${cd}.pdf";
83     next if scalar @files > 0;
84
85     debug("Click download link ...");
86     $r = $mech->submit_form(
87         form_name => 'pdfstatementForm',
88         fields    => {
89             cd      => $cd,
90             asindex => $index,
91         },
92     ) or return;
93     croak "Couldn't submit form 'pdfstatementForm'." unless $r->is_success;
94
95     debug("Check contents for PDF ...");
96     my $content_type = $mech->content_type;
97     croak "No PDF." unless $content_type eq 'application/pdf';
98
99     debug("Save PDF ...");
100     my $filename = $mech->res->filename;
101     $filename =~ s/\.pdf$/_$cd.pdf/;
102     $filename = catfile( $dir, $filename );
103     $mech->save_content( $filename, binary => 1 ) unless -e $filename;
104
105     # set $mech back to accountstatementlist
106     $mech->back;
107 }
108
109 exit 0;
110
111 sub debug {
112     say "D: ", @_ if DEBUG;
113 }
114
115 __END__
116
117 =head1 NAME
118
119 psk_download.pl - Download account statements from PSK online banking
120
121 =head1 SYNOPSIS
122
123 psk_download.pl [directory]
124
125 =head1 DESCRIPTION
126
127 B<psk_download.pl> logs into the PSK online banking website and downloads
128 the account statement PDFs.
129
130 =head1 PARAMETERS
131
132 =over
133
134 =item B<directory> (optional)
135
136 Overrides the I<dir> parameter in the config file.
137 One of them is required.
138
139 =back
140
141 =head1 OPTIONS
142
143 =over
144
145 =item B<--help|?>
146
147 Short help.
148
149 =item B<--man>
150
151 Complete man page.
152
153 =back
154
155 =head1 FILES
156
157 =over
158
159 =item F<~/.psk_downloadrc> (required)
160
161 Required parameters: I<verfuegernummer>, I<pin>.
162
163 Optional parameter: I<dir> (target directory for downloads).
164 Overriden if a directory is passed to the script.
165 If both are missing, the script's directory is used.
166
167 Format: Anything that L<Config::Auto> understands, e.g. key=value.
168
169 Filename: Anything that L<Config::Auto> finds.
170
171 =back
172
173 =head1 COPYRIGHT AND LICENSE
174
175 Copyright 2016, gregor herrmann E<lt>gregor@toastfreeware.priv.atE<gt>
176
177 Copyright 2016, Philipp Spitzer E<lt>philipp@toastfreeware.priv.atE<gt>
178
179 This is free software; you can redistribute it and/or modify it under the
180 same terms as the Perl 5 programming language system itself.