| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # Filename: iTunesConnect.pm | 
| 2 |  |  |  |  |  |  | # | 
| 3 |  |  |  |  |  |  | # iTunes Connect client interface | 
| 4 |  |  |  |  |  |  | # | 
| 5 |  |  |  |  |  |  | # Copyright 2008-2009 Brandon Fosdick  (BSD License) | 
| 6 |  |  |  |  |  |  | # | 
| 7 |  |  |  |  |  |  | # $Id: iTunesConnect.pm,v 1.12 2009/01/22 05:23:57 bfoz Exp $ | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | package WWW::iTunesConnect; | 
| 10 |  |  |  |  |  |  |  | 
| 11 | 1 |  |  | 1 |  | 24194 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 45 |  | 
| 12 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 49 |  | 
| 13 | 1 |  |  | 1 |  | 6 | use vars qw($VERSION); | 
|  | 1 |  |  |  |  | 7 |  | 
|  | 1 |  |  |  |  | 75 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | $VERSION = "1.16"; | 
| 16 |  |  |  |  |  |  |  | 
| 17 | 1 |  |  | 1 |  | 213076 | use LWP; | 
|  | 1 |  |  |  |  | 212253 |  | 
|  | 1 |  |  |  |  | 36 |  | 
| 18 | 1 |  |  | 1 |  | 6706 | use HTML::Form; | 
|  | 1 |  |  |  |  | 20761 |  | 
|  | 1 |  |  |  |  | 49 |  | 
| 19 | 1 |  |  | 1 |  | 1371 | use HTML::TreeBuilder; | 
|  | 1 |  |  |  |  | 36051 |  | 
|  | 1 |  |  |  |  | 14 |  | 
| 20 | 1 |  |  | 1 |  | 17287 | use IO::Uncompress::Gunzip qw(gunzip $GunzipError); | 
|  | 1 |  |  |  |  | 123024 |  | 
|  | 1 |  |  |  |  | 311 |  | 
| 21 |  |  |  |  |  |  |  | 
| 22 | 1 |  |  | 1 |  | 14 | use constant URL_PHOBOS => 'https://phobos.apple.com'; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 310 |  | 
| 23 | 1 |  |  |  |  | 8270 | use constant MONTH_2_NUM => { 'Jan' => '01', 'Feb' => '02', 'Mar' => '03', 'Apr' => '04', | 
| 24 |  |  |  |  |  |  | 'May' => '05', 'Jun' => '06', 'Jul' => '07', 'Aug' => '08', | 
| 25 | 1 |  |  | 1 |  | 6 | 'Sep' => '09', 'Oct' => '10', 'Nov' => '11', 'Dec' => '12' }; | 
|  | 1 |  |  |  |  | 3 |  | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | # --- Constructor --- | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | sub new | 
| 30 |  |  |  |  |  |  | { | 
| 31 | 0 |  |  | 0 | 1 |  | my ($this, %options) = @_; | 
| 32 | 0 |  | 0 |  |  |  | my $class = ref($this) || $this; | 
| 33 | 0 |  |  |  |  |  | my $self = {}; | 
| 34 | 0 |  |  |  |  |  | bless $self, $class; | 
| 35 |  |  |  |  |  |  |  | 
| 36 | 0 | 0 |  |  |  |  | $self->{user} = $options{user} if $options{user}; | 
| 37 | 0 | 0 |  |  |  |  | $self->{password} = $options{password} if $options{password}; | 
| 38 |  |  |  |  |  |  |  | 
| 39 | 0 |  |  |  |  |  | $self->{ua} = LWP::UserAgent->new(%options); | 
| 40 | 0 |  |  |  |  |  | $self->{ua}->cookie_jar({}); | 
| 41 |  |  |  |  |  |  | # Allow POST requests to be redirected because some of the international | 
| 42 |  |  |  |  |  |  | #  iTC mirrors redirect various requests | 
| 43 | 0 |  |  |  |  |  | push @{ $self->{ua}->requests_redirectable}, 'POST'; | 
|  | 0 |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  |  | 
| 45 | 0 |  |  |  |  |  | return $self; | 
| 46 |  |  |  |  |  |  | } | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | # --- Class Methods --- | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | # Parse a TSV data table retrieved from iTunes Connect | 
| 51 |  |  |  |  |  |  | sub parse_table | 
| 52 |  |  |  |  |  |  | { | 
| 53 | 0 |  |  | 0 | 0 |  | my ($content) = @_; | 
| 54 |  |  |  |  |  |  |  | 
| 55 |  |  |  |  |  |  | # Parse the data into a hash of arrays | 
| 56 | 0 |  |  |  |  |  | my @content = split /\n/,$content; | 
| 57 | 0 |  |  |  |  |  | my @header = split /\t/, shift(@content); | 
| 58 | 0 |  |  |  |  |  | my @data; | 
| 59 | 0 |  |  |  |  |  | for( @content ) | 
| 60 |  |  |  |  |  |  | { | 
| 61 | 0 |  |  |  |  |  | my @a = split /\t/; | 
| 62 | 0 |  |  |  |  |  | push @data, \@a; | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  |  | 
| 65 | 0 |  |  |  |  |  | ('header', \@header, 'data', \@data); | 
| 66 |  |  |  |  |  |  | } | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | # Parse a raw financial report into a report hash | 
| 69 |  |  |  |  |  |  | sub parse_financial_report | 
| 70 |  |  |  |  |  |  | { | 
| 71 | 0 |  |  | 0 | 0 |  | my ($content) = @_; | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | # Parse the data | 
| 74 | 0 |  |  |  |  |  | my %table = parse_table($content); | 
| 75 | 0 |  |  |  |  |  | my ($header, $data) = @table{qw(header data)}; | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | # Strip blank lines | 
| 78 | 0 |  |  |  |  |  | @$data = grep { scalar @$_ } @$data; | 
|  | 0 |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | # Strip off the Total row and parse it | 
| 81 | 0 |  |  |  |  |  | my $last_row = pop @$data; | 
| 82 | 0 |  |  |  |  |  | my $currency; | 
| 83 |  |  |  |  |  |  | my $units; | 
| 84 | 0 |  |  |  |  |  | my $total; | 
| 85 |  |  |  |  |  |  | # Detect the report format | 
| 86 | 0 | 0 |  |  |  |  | if( 1 == scalar @$last_row )	# February 2009 - May 2010 format | 
|  |  | 0 |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | { | 
| 88 | 0 |  |  |  |  |  | $total = shift @$last_row; | 
| 89 | 0 |  |  |  |  |  | $total =~ s/[^\d.,]//g;	# Strip everything but the number | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  | elsif( 2 == scalar @$last_row )	# June 2010 format | 
| 92 |  |  |  |  |  |  | { | 
| 93 | 0 |  |  |  |  |  | $units = @$last_row[1]; | 
| 94 | 0 |  |  |  |  |  | $last_row = pop @$data; | 
| 95 | 0 |  |  |  |  |  | $total = @$last_row[1]; | 
| 96 | 0 |  |  |  |  |  | $last_row = pop @$data; | 
| 97 | 0 |  |  |  |  |  | my $num_rows = @$last_row[1]; | 
| 98 |  |  |  |  |  |  | # Consistency check: the number of rows in the table should match the Total_Rows line | 
| 99 | 0 | 0 |  |  |  |  | return undef if $num_rows != scalar @$data; | 
| 100 |  |  |  |  |  |  | } | 
| 101 |  |  |  |  |  |  | else				# Pre-February 2009 format | 
| 102 |  |  |  |  |  |  | { | 
| 103 | 0 |  |  |  |  |  | $currency = @$last_row[8]; | 
| 104 | 0 |  |  |  |  |  | $total = @$last_row[7]; | 
| 105 | 0 | 0 |  |  |  |  | $total =~ s/[^\d.,]//g if defined $total; | 
| 106 |  |  |  |  |  |  | } | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | # Convert the various region-specific date formats to YYYYMMDD | 
| 109 | 0 |  |  |  |  |  | my $startIndex = 0; | 
| 110 | 0 |  |  |  |  |  | my $endIndex = 0; | 
| 111 | 0 |  |  |  |  |  | ++$startIndex while $header->[$startIndex] ne 'Start Date'; | 
| 112 | 0 |  |  |  |  |  | ++$endIndex while $header->[$endIndex] ne 'End Date'; | 
| 113 | 0 |  |  |  |  |  | my $eu_reg = qr/(\d\d)\.(\d\d)\.(\d{4})/; | 
| 114 | 0 |  |  |  |  |  | my $us_reg = qr/(\d\d)\/(\d\d)\/(\d{4})/; | 
| 115 | 0 |  |  |  |  |  | for( @$data ) | 
| 116 |  |  |  |  |  |  | { | 
| 117 | 0 | 0 |  |  |  |  | if( @$_[$startIndex] =~ $eu_reg )       # EU format | 
|  |  | 0 |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | { | 
| 119 | 0 |  |  |  |  |  | @$_[$startIndex] = $3.$2.$1; | 
| 120 | 0 |  |  |  |  |  | @$_[$endIndex] =~ $eu_reg; | 
| 121 | 0 |  |  |  |  |  | @$_[$endIndex] = $3.$2.$1; | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  | elsif( @$_[$startIndex] =~ $us_reg )    # US format | 
| 124 |  |  |  |  |  |  | { | 
| 125 | 0 |  |  |  |  |  | @$_[$startIndex] = $3.$1.$2; | 
| 126 | 0 |  |  |  |  |  | @$_[$endIndex] =~ $us_reg; | 
| 127 | 0 |  |  |  |  |  | @$_[$endIndex] = $3.$1.$2; | 
| 128 |  |  |  |  |  |  | } | 
| 129 |  |  |  |  |  |  | } | 
| 130 |  |  |  |  |  |  |  | 
| 131 | 0 |  |  |  |  |  | ('header', $header, 'data', $data, 'total', $total, 'currency', $currency, 'units', $units); | 
| 132 |  |  |  |  |  |  | } | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | # Parse a gzip'd summary file fetched from the Sales/Trend page | 
| 135 |  |  |  |  |  |  | #  First argument is same as input argument to gunzip constructor | 
| 136 |  |  |  |  |  |  | #  Remaining arguments are passed as options to gunzip | 
| 137 |  |  |  |  |  |  | sub parse_sales_summary | 
| 138 |  |  |  |  |  |  | { | 
| 139 | 0 |  |  | 0 | 1 |  | my ($input, %options) = @_; | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | # gunzip the data into a scalar | 
| 142 | 0 |  |  |  |  |  | my $content; | 
| 143 | 0 |  |  |  |  |  | my $status = gunzip $input => \$content; | 
| 144 | 0 | 0 |  |  |  |  | return $status unless $status; | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | # Parse the data into a hash of array refs and return | 
| 147 | 0 |  |  |  |  |  | parse_table($content); | 
| 148 |  |  |  |  |  |  | } | 
| 149 |  |  |  |  |  |  |  | 
| 150 |  |  |  |  |  |  | # --- Instance Methods --- | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | sub login | 
| 153 |  |  |  |  |  |  | { | 
| 154 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | # Bail out if no username and password | 
| 157 | 0 | 0 | 0 |  |  |  | return undef unless $s->{user} and $s->{password}; | 
| 158 |  |  |  |  |  |  | # Prevent repeat logins | 
| 159 | 0 | 0 | 0 |  |  |  | return 1 if $s->{response}{login} and !($s->{response}{login}->is_error); | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | # Fetch the login page | 
| 162 | 0 |  |  |  |  |  | my $r = $s->request('/WebObjects/MZLabel.woa/wa/default'); | 
| 163 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 164 | 0 |  |  |  |  |  | $s->{login_page} = $r->content; | 
| 165 |  |  |  |  |  |  | # Find the login form | 
| 166 | 0 |  |  |  |  |  | my @forms = HTML::Form->parse($r); | 
| 167 | 0 |  |  |  |  |  | @forms = grep $_->attr('name') eq 'appleConnectForm', @forms; | 
| 168 | 0 | 0 |  |  |  |  | return undef unless @forms; | 
| 169 | 0 |  |  |  |  |  | $s->{form}{login} = shift @forms; | 
| 170 | 0 | 0 |  |  |  |  | return undef unless $s->{form}{login}; | 
| 171 |  |  |  |  |  |  |  | 
| 172 |  |  |  |  |  |  | # Submit the user's credentials | 
| 173 | 0 |  |  |  |  |  | $s->{form}{login}->value('#accountname', $s->{user}); | 
| 174 | 0 |  |  |  |  |  | $s->{form}{login}->value('#accountpassword', $s->{password}); | 
| 175 | 0 |  |  |  |  |  | $s->{response}{login} = $s->{ua}->request($s->{form}{login}->click('1.Continue')); | 
| 176 | 0 | 0 | 0 |  |  |  | return undef unless $s->{response}{login} and !($s->{response}{login}->is_error); | 
| 177 |  |  |  |  |  |  |  | 
| 178 |  |  |  |  |  |  | # Parse the page into a tree | 
| 179 | 0 |  |  |  |  |  | my $tree = HTML::TreeBuilder->new_from_content($s->{response}{login}->as_string); | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | # Look for a failed login notification. The login response doesn't set any | 
| 182 |  |  |  |  |  |  | #  error codes on failure; it merely displays a notice to the user. Try to | 
| 183 |  |  |  |  |  |  | #  detect the notice by looking for a span tag with class dserror. | 
| 184 | 0 |  |  |  |  |  | my @failure = $tree->look_down('_tag', 'span', 'class', 'dserror'); | 
| 185 | 0 | 0 |  |  |  |  | return undef if @failure;	# Bail out | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | # Look for any notifications that Apple may be trying to send to the developer | 
| 188 | 0 |  |  |  |  |  | my @notifications = $tree->look_down('_tag', 'div', 'class', 'simple-notification'); | 
| 189 | 0 | 0 |  |  |  |  | if( @notifications ) | 
| 190 |  |  |  |  |  |  | { | 
| 191 | 0 |  |  |  |  |  | push @{$s->{login_notifications}}, $_->as_HTML for @notifications; | 
|  | 0 |  |  |  |  |  |  | 
| 192 | 0 |  |  |  |  |  | return undef;	# Bail out until the developer handles the message | 
| 193 |  |  |  |  |  |  | } | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  | # Save the parsed main menu tree for later | 
| 196 | 0 |  |  |  |  |  | $s->{main_menu_tree} = $tree; | 
| 197 |  |  |  |  |  |  |  | 
| 198 | 0 |  |  |  |  |  | 1; | 
| 199 |  |  |  |  |  |  | } | 
| 200 |  |  |  |  |  |  |  | 
| 201 |  |  |  |  |  |  | # Fetch the list of available dates for Sales/Trend Daily Summary Reports. This | 
| 202 |  |  |  |  |  |  | #  caches the returned results so it can be safely called multiple times. Note, | 
| 203 |  |  |  |  |  |  | #  however, that if the parent script runs for longer than 24 hours the cached | 
| 204 |  |  |  |  |  |  | #  results will be invalid. The cached results may become invalid sooner. | 
| 205 |  |  |  |  |  |  | sub daily_sales_summary_dates | 
| 206 |  |  |  |  |  |  | { | 
| 207 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 208 |  |  |  |  |  |  |  | 
| 209 |  |  |  |  |  |  | # Get an HTML::Form object for the Sales/Trends Reports Daily Summary page | 
| 210 | 0 |  |  |  |  |  | my $form = $s->daily_sales_summary_form(); | 
| 211 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 212 |  |  |  |  |  |  | # Pull the available dates out of the form's select input | 
| 213 | 0 |  |  |  |  |  | my $input = $form->find_input('#dayorweekdropdown', 'option'); | 
| 214 | 0 | 0 |  |  |  |  | return undef unless $input; | 
| 215 |  |  |  |  |  |  | # Sort and return the dates | 
| 216 | 0 |  |  |  |  |  | sort { $b cmp $a } $input->possible_values; | 
|  | 0 |  |  |  |  |  |  | 
| 217 |  |  |  |  |  |  | } | 
| 218 |  |  |  |  |  |  |  | 
| 219 |  |  |  |  |  |  | sub daily_sales_summary | 
| 220 |  |  |  |  |  |  | { | 
| 221 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 222 | 0 | 0 |  |  |  |  | my $date = shift if scalar @_; | 
| 223 |  |  |  |  |  |  |  | 
| 224 | 0 | 0 | 0 |  |  |  | return undef if $date and ($date !~ /\d{2}\/\d{2}\/\d{4}/); | 
| 225 | 0 | 0 |  |  |  |  | unless( $date ) | 
| 226 |  |  |  |  |  |  | { | 
| 227 |  |  |  |  |  |  | # Get the list of available dates | 
| 228 | 0 |  |  |  |  |  | my @dates = $s->daily_sales_summary_dates(); | 
| 229 |  |  |  |  |  |  | # The list is sorted in descending order, so most recent is first | 
| 230 | 0 |  |  |  |  |  | $date = shift @dates; | 
| 231 | 0 | 0 |  |  |  |  | return undef unless $date; | 
| 232 |  |  |  |  |  |  | } | 
| 233 |  |  |  |  |  |  |  | 
| 234 |  |  |  |  |  |  | # Get an HTML::Form object for the Sales/Trends Reports Daily Summary page | 
| 235 | 0 |  |  |  |  |  | my $form = $s->daily_sales_summary_form(); | 
| 236 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 237 |  |  |  |  |  |  | # Submit the form to get the latest daily summary | 
| 238 | 0 |  |  |  |  |  | $form->value('#selReportType', 'Summary'); | 
| 239 | 0 |  |  |  |  |  | $form->value('#selDateType', 'Daily'); | 
| 240 | 0 |  |  |  |  |  | $form->value('#dayorweekdropdown', $date); | 
| 241 | 0 |  |  |  |  |  | $form->value('hiddenDayOrWeekSelection', $date); | 
| 242 | 0 |  |  |  |  |  | $form->value('hiddenSubmitTypeName', 'Download'); | 
| 243 | 0 |  |  |  |  |  | $form->value('download', 'Download'); | 
| 244 |  |  |  |  |  |  | # Fetch the summary | 
| 245 | 0 |  |  |  |  |  | my $r = $s->{ua}->request($form->click('download')); | 
| 246 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 247 | 0 |  |  |  |  |  | my $filename =  $r->header('Content-Disposition'); | 
| 248 | 0 | 0 |  |  |  |  | $filename = (split(/=/, $filename))[1] if $filename; | 
| 249 |  |  |  |  |  |  |  | 
| 250 | 0 |  |  |  |  |  | (parse_sales_summary(\$r->content), 'file', $r->content, 'filename', $filename); | 
| 251 |  |  |  |  |  |  | } | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | # Fetch a financial report for a given date and region | 
| 254 |  |  |  |  |  |  | sub fetch_financial_report | 
| 255 |  |  |  |  |  |  | { | 
| 256 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 257 | 0 | 0 |  |  |  |  | my $month = shift if scalar @_; | 
| 258 | 0 | 0 | 0 |  |  |  | return undef unless $month and ($month =~ /\d{4}\d{2}/); | 
| 259 | 0 | 0 |  |  |  |  | my $region = shift if scalar @_; | 
| 260 | 0 | 0 |  |  |  |  | return undef unless $region; | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  | # Get the list of available reports | 
| 263 | 0 |  |  |  |  |  | my $list = $s->financial_report_list(); | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | # Check that the requested report is available | 
| 266 | 0 | 0 | 0 |  |  |  | return undef unless $list and $list->{$month} and $list->{$month}->{$region}; | 
|  |  |  | 0 |  |  |  |  | 
| 267 |  |  |  |  |  |  |  | 
| 268 |  |  |  |  |  |  | # Fetch the report | 
| 269 | 0 |  |  |  |  |  | my $r = $s->request($list->{$month}->{$region}{path}); | 
| 270 | 0 | 0 | 0 |  |  |  | return undef unless $r and $r->is_success and $r->content; | 
|  |  |  | 0 |  |  |  |  | 
| 271 |  |  |  |  |  |  |  | 
| 272 | 0 |  |  |  |  |  | ('filename', $list->{$month}->{$region}{filename}, 'content', $r->content); | 
| 273 |  |  |  |  |  |  | } | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | # Fetch the list of available financial reports | 
| 276 |  |  |  |  |  |  | sub financial_report_list | 
| 277 |  |  |  |  |  |  | { | 
| 278 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 279 |  |  |  |  |  |  |  | 
| 280 |  |  |  |  |  |  | # Return cached list to avoid another trip on the net | 
| 281 | 0 | 0 |  |  |  |  | return $s->{financial_reports} if $s->{financial_reports}; | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | # Fetch the Financial Reports page | 
| 284 | 0 |  |  |  |  |  | my $r = $s->financial_response(); | 
| 285 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | # Get the Items/Page form and set to display the max number of reports | 
| 288 | 0 |  |  |  |  |  | my @forms = HTML::Form->parse($r); | 
| 289 | 0 |  |  |  |  |  | @forms = grep $_->find_input('itemsPerPage', 'text'), @forms; | 
| 290 | 0 |  |  |  |  |  | my $form = shift @forms; | 
| 291 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 292 | 0 |  |  |  |  |  | $form->value('itemsPerPage', $s->{max_financial_reports_per_page}); | 
| 293 | 0 |  |  |  |  |  | $r = $s->{ua}->request($form->click); | 
| 294 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 295 | 0 |  |  |  |  |  | $s->{response}{financial_list} = $r; | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  | # Parse the page into a tree | 
| 298 | 0 |  |  |  |  |  | my $tree = HTML::TreeBuilder->new_from_content($r->as_string); | 
| 299 |  |  |  |  |  |  |  | 
| 300 |  |  |  |  |  |  | # Find the table of financial reports by finding the 'itemsPerPage' input | 
| 301 |  |  |  |  |  |  | #  element and then looking upwards to find the enclosing table. Then find | 
| 302 |  |  |  |  |  |  | #  the table that encloses that one. | 
| 303 | 0 |  |  |  |  |  | my $input = $tree->look_down('_tag', 'input', 'name', 'itemsPerPage'); | 
| 304 | 0 | 0 |  |  |  |  | return undef unless $input; | 
| 305 | 0 |  |  |  |  |  | my $table = $input->look_up('_tag', 'table'); | 
| 306 | 0 | 0 |  |  |  |  | return undef unless $table; | 
| 307 | 0 |  |  |  |  |  | $table = $table->parent->look_up('_tag', 'table'); | 
| 308 | 0 | 0 |  |  |  |  | return undef unless $table; | 
| 309 |  |  |  |  |  |  |  | 
| 310 |  |  |  |  |  |  | # Now find the rows for the list of financial reports | 
| 311 | 0 |  |  |  |  |  | my @rows = $table->look_down('_tag','tr'); | 
| 312 |  |  |  |  |  |  | # The first 3 rows are headers, etc so get rid of them | 
| 313 | 0 |  |  |  |  |  | @rows = @rows[3..$#rows]; | 
| 314 |  |  |  |  |  |  |  | 
| 315 |  |  |  |  |  |  | # Parse the list of reports | 
| 316 | 0 |  |  |  |  |  | my %reports; | 
| 317 | 0 |  |  |  |  |  | for( @rows ) | 
| 318 |  |  |  |  |  |  | { | 
| 319 | 0 |  |  |  |  |  | my @cols = $_->look_down('_tag','td'); | 
| 320 | 0 |  |  |  |  |  | $cols[0]->as_trimmed_text =~ /([A-Z][a-z]{2})\s+(\d{4})/; | 
| 321 | 0 |  |  |  |  |  | my $date = $2.MONTH_2_NUM->{$1}; | 
| 322 | 0 |  |  |  |  |  | my $region = $cols[1]->as_trimmed_text; | 
| 323 | 0 |  |  |  |  |  | my $a = scalar $cols[2]->look_down('_tag','a'); | 
| 324 | 0 |  |  |  |  |  | @{$reports{$date}{$region}}{qw(path filename)} = ($a->attr('href'), $a->as_trimmed_text); | 
|  | 0 |  |  |  |  |  |  | 
| 325 |  |  |  |  |  |  | } | 
| 326 |  |  |  |  |  |  |  | 
| 327 |  |  |  |  |  |  | # Save the list for later and return | 
| 328 | 0 |  |  |  |  |  | $s->{financial_reports} = \%reports; | 
| 329 |  |  |  |  |  |  | } | 
| 330 |  |  |  |  |  |  |  | 
| 331 |  |  |  |  |  |  | sub financial_report | 
| 332 |  |  |  |  |  |  | { | 
| 333 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 334 | 0 | 0 |  |  |  |  | my $date = shift if scalar @_; | 
| 335 | 0 | 0 | 0 |  |  |  | return undef if $date and ($date !~ /\d{4}\d{2}/); | 
| 336 |  |  |  |  |  |  |  | 
| 337 |  |  |  |  |  |  | # Get the list of available reports | 
| 338 | 0 |  |  |  |  |  | my %reports = %{$s->financial_report_list()}; | 
|  | 0 |  |  |  |  |  |  | 
| 339 |  |  |  |  |  |  |  | 
| 340 |  |  |  |  |  |  | # Get the most recent month's reports if no month was given | 
| 341 | 0 | 0 |  |  |  |  | unless( $date ) | 
| 342 |  |  |  |  |  |  | { | 
| 343 | 0 |  |  |  |  |  | my @dates = sort { $b <=> $a } keys %reports; | 
|  | 0 |  |  |  |  |  |  | 
| 344 | 0 |  |  |  |  |  | $date = shift @dates; | 
| 345 | 0 | 0 |  |  |  |  | return undef unless $date; | 
| 346 |  |  |  |  |  |  | } | 
| 347 |  |  |  |  |  |  |  | 
| 348 |  |  |  |  |  |  | # Fetch the reports for either the given month or the most recent month available | 
| 349 | 0 |  |  |  |  |  | my $regions = $reports{$date}; | 
| 350 | 0 |  |  |  |  |  | my %out; | 
| 351 | 0 |  |  |  |  |  | for( keys %{$regions} ) | 
|  | 0 |  |  |  |  |  |  | 
| 352 |  |  |  |  |  |  | { | 
| 353 | 0 |  |  |  |  |  | my %report = $s->fetch_financial_report($date, $_); | 
| 354 | 0 | 0 |  |  |  |  | next unless %report; | 
| 355 |  |  |  |  |  |  |  | 
| 356 |  |  |  |  |  |  | # Parse the data | 
| 357 | 0 |  |  |  |  |  | my %parsed = parse_financial_report($report{'content'}); | 
| 358 | 0 | 0 |  |  |  |  | next unless %parsed; | 
| 359 |  |  |  |  |  |  |  | 
| 360 | 0 |  |  |  |  |  | $out{$date}{$_} = \%parsed; | 
| 361 | 0 |  |  |  |  |  | $out{$date}{$_}{'file'} = $report{'content'}; | 
| 362 | 0 |  |  |  |  |  | $out{$date}{$_}{'filename'} = $report{'filename'}; | 
| 363 |  |  |  |  |  |  | } | 
| 364 | 0 |  |  |  |  |  | %out;   # Return | 
| 365 |  |  |  |  |  |  | } | 
| 366 |  |  |  |  |  |  |  | 
| 367 |  |  |  |  |  |  | # Fetch the list of available dates for Sales/Trend Monthly Summary Reports. This | 
| 368 |  |  |  |  |  |  | #  caches the returned results so it can be safely called multiple times. | 
| 369 |  |  |  |  |  |  | sub monthly_free_summary_dates | 
| 370 |  |  |  |  |  |  | { | 
| 371 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 372 |  |  |  |  |  |  |  | 
| 373 |  |  |  |  |  |  | # Get an HTML::Form object for the Sales/Trends Reports Monthly Summary page | 
| 374 | 0 |  |  |  |  |  | my $form = $s->monthly_free_summary_form(); | 
| 375 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 376 |  |  |  |  |  |  | # Pull the available date ranges out of the form's select input | 
| 377 | 0 |  |  |  |  |  | my $input = $form->find_input('9.14.1', 'option'); | 
| 378 | 0 | 0 |  |  |  |  | return undef unless $input; | 
| 379 |  |  |  |  |  |  | # Parse the strings into an array of hash references | 
| 380 | 0 |  |  |  |  |  | my @dates; | 
| 381 | 0 |  |  |  |  |  | push @dates, {'From', split(/ /, $_)} for $input->value_names; | 
| 382 |  |  |  |  |  |  | # Sort and return the date ranges | 
| 383 | 0 |  |  |  |  |  | sort { $b->{To} cmp $a->{To} } @dates; | 
|  | 0 |  |  |  |  |  |  | 
| 384 |  |  |  |  |  |  | } | 
| 385 |  |  |  |  |  |  |  | 
| 386 |  |  |  |  |  |  | sub monthly_free_summary | 
| 387 |  |  |  |  |  |  | { | 
| 388 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 389 | 0 | 0 |  |  |  |  | my (%options) = @_ if scalar @_; | 
| 390 |  |  |  |  |  |  |  | 
| 391 | 0 | 0 | 0 |  |  |  | return undef if %options and $options{To} and $options{From} and | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
| 392 |  |  |  |  |  |  | (($options{To} !~ /\d{2}\/\d{2}\/\d{4}/) or | 
| 393 |  |  |  |  |  |  | ($options{From} !~ /\d{2}\/\d{2}\/\d{4}/)); | 
| 394 | 0 | 0 |  |  |  |  | unless( %options ) | 
| 395 |  |  |  |  |  |  | { | 
| 396 |  |  |  |  |  |  | # Get the list of available dates | 
| 397 | 0 |  |  |  |  |  | my @months = $s->monthly_free_summary_dates(); | 
| 398 | 0 | 0 |  |  |  |  | return undef unless @months; | 
| 399 |  |  |  |  |  |  | # The list is sorted in descending order, so most recent is first | 
| 400 | 0 |  |  |  |  |  | %options = %{shift @months}; | 
|  | 0 |  |  |  |  |  |  | 
| 401 |  |  |  |  |  |  | } | 
| 402 |  |  |  |  |  |  |  | 
| 403 |  |  |  |  |  |  | # Munge the date range into the format used by the form | 
| 404 | 0 |  |  |  |  |  | $options{To} =~ /(\d{2})\/(\d{2})\/(\d{4})/; | 
| 405 | 0 |  |  |  |  |  | my $to = $3.$1.$2; | 
| 406 | 0 |  |  |  |  |  | $options{From} =~ /(\d{2})\/(\d{2})\/(\d{4})/; | 
| 407 | 0 |  |  |  |  |  | my $month = $3.$1.$2.'#'.$to; | 
| 408 |  |  |  |  |  |  |  | 
| 409 |  |  |  |  |  |  | # Get an HTML::Form object for the Sales/Trends Reports Daily Summary page | 
| 410 | 0 |  |  |  |  |  | my $form = $s->monthly_free_summary_form(); | 
| 411 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 412 |  |  |  |  |  |  | # Submit the form to get the latest weekly summary | 
| 413 | 0 |  |  |  |  |  | $form->value('#selReportType', 'Summary'); | 
| 414 | 0 |  |  |  |  |  | $form->value('#selDateType', 'Monthly Free'); | 
| 415 | 0 |  |  |  |  |  | $form->value('#dayorweekdropdown', $month); | 
| 416 | 0 |  |  |  |  |  | $form->value('hiddenDayOrWeekSelection', $month); | 
| 417 | 0 |  |  |  |  |  | $form->value('hiddenSubmitTypeName', 'Download'); | 
| 418 | 0 |  |  |  |  |  | $form->value('download', 'Download'); | 
| 419 |  |  |  |  |  |  | # Fetch the summary | 
| 420 | 0 |  |  |  |  |  | my $r = $s->{ua}->request($form->click('download')); | 
| 421 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 422 |  |  |  |  |  |  | # If a given month is actually empty, the download will return the same page | 
| 423 |  |  |  |  |  |  | #  with a notice to the user. Check for the notice and bail out if found. | 
| 424 | 0 | 0 |  |  |  |  | return undef unless index($r->as_string, 'There are no free transactions to report') == -1; | 
| 425 |  |  |  |  |  |  |  | 
| 426 | 0 |  |  |  |  |  | my $filename =  $r->header('Content-Disposition'); | 
| 427 | 0 | 0 |  |  |  |  | $filename = (split(/=/, $filename))[1] if $filename; | 
| 428 |  |  |  |  |  |  |  | 
| 429 | 0 |  |  |  |  |  | (parse_sales_summary(\$r->content), 'file', $r->content, 'filename', $filename); | 
| 430 |  |  |  |  |  |  | } | 
| 431 |  |  |  |  |  |  |  | 
| 432 |  |  |  |  |  |  | # Fetch the list of available dates for Sales/Trend Weekly Summary Reports. This | 
| 433 |  |  |  |  |  |  | #  caches the returned results so it can be safely called multiple times. | 
| 434 |  |  |  |  |  |  | sub weekly_sales_summary_dates | 
| 435 |  |  |  |  |  |  | { | 
| 436 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 437 |  |  |  |  |  |  |  | 
| 438 |  |  |  |  |  |  | # Get an HTML::Form object for the Sales/Trends Reports Weekly Summary page | 
| 439 | 0 |  |  |  |  |  | my $form = $s->weekly_sales_summary_form(); | 
| 440 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 441 |  |  |  |  |  |  | # Pull the available date ranges out of the form's select input | 
| 442 | 0 |  |  |  |  |  | my $input = $form->find_input('#dayorweekdropdown', 'option'); | 
| 443 | 0 | 0 |  |  |  |  | return undef unless $input; | 
| 444 |  |  |  |  |  |  | # Parse the strings into an array of hash references | 
| 445 | 0 |  |  |  |  |  | my @dates; | 
| 446 | 0 |  |  |  |  |  | push @dates, {'From', split(/ /, $_)} for $input->value_names; | 
| 447 |  |  |  |  |  |  | # Sort and return the date ranges | 
| 448 | 0 |  |  |  |  |  | sort { $b->{To} cmp $a->{To} } @dates; | 
|  | 0 |  |  |  |  |  |  | 
| 449 |  |  |  |  |  |  | } | 
| 450 |  |  |  |  |  |  |  | 
| 451 |  |  |  |  |  |  | sub weekly_sales_summary | 
| 452 |  |  |  |  |  |  | { | 
| 453 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 454 | 0 | 0 |  |  |  |  | my $week = shift if scalar @_; | 
| 455 |  |  |  |  |  |  |  | 
| 456 | 0 | 0 | 0 |  |  |  | return undef if $week and ($week !~ /\d{2}\/\d{2}\/\d{4}/); | 
| 457 | 0 | 0 |  |  |  |  | unless( $week ) | 
| 458 |  |  |  |  |  |  | { | 
| 459 |  |  |  |  |  |  | # Get the list of available dates | 
| 460 | 0 |  |  |  |  |  | my @weeks = $s->weekly_sales_summary_dates(); | 
| 461 | 0 | 0 |  |  |  |  | return undef unless @weeks; | 
| 462 |  |  |  |  |  |  | # The list is sorted in descending order, so most recent is first | 
| 463 | 0 |  |  |  |  |  | $week = shift @weeks; | 
| 464 | 0 |  |  |  |  |  | $week = $week->{To}; | 
| 465 |  |  |  |  |  |  | } | 
| 466 |  |  |  |  |  |  |  | 
| 467 |  |  |  |  |  |  | # Get an HTML::Form object for the Sales/Trends Reports Daily Summary page | 
| 468 | 0 |  |  |  |  |  | my $form = $s->weekly_sales_summary_form(); | 
| 469 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 470 |  |  |  |  |  |  | # Submit the form to get the latest weekly summary | 
| 471 | 0 |  |  |  |  |  | $form->value('#selReportType', 'Summary'); | 
| 472 | 0 |  |  |  |  |  | $form->value('#selDateType', 'Weekly'); | 
| 473 | 0 |  |  |  |  |  | $form->value('#dayorweekdropdown', $week); | 
| 474 | 0 |  |  |  |  |  | $form->value('hiddenDayOrWeekSelection', $week); | 
| 475 | 0 |  |  |  |  |  | $form->value('hiddenSubmitTypeName', 'Download'); | 
| 476 | 0 |  |  |  |  |  | $form->value('download', 'Download'); | 
| 477 |  |  |  |  |  |  | # Fetch the summary | 
| 478 | 0 |  |  |  |  |  | my $r = $s->{ua}->request($form->click('download')); | 
| 479 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 480 | 0 |  |  |  |  |  | my $filename =  $r->header('Content-Disposition'); | 
| 481 | 0 | 0 |  |  |  |  | $filename = (split(/=/, $filename))[1] if $filename; | 
| 482 |  |  |  |  |  |  |  | 
| 483 | 0 |  |  |  |  |  | (parse_sales_summary(\$r->content), 'file', $r->content, 'filename', $filename); | 
| 484 |  |  |  |  |  |  | } | 
| 485 |  |  |  |  |  |  |  | 
| 486 |  |  |  |  |  |  | # --- Getters and Setters --- | 
| 487 |  |  |  |  |  |  |  | 
| 488 |  |  |  |  |  |  | sub user | 
| 489 |  |  |  |  |  |  | { | 
| 490 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 491 | 0 | 0 |  |  |  |  | $s->{user} = shift if scalar @_; | 
| 492 | 0 |  |  |  |  |  | $s->{user}; | 
| 493 |  |  |  |  |  |  | } | 
| 494 |  |  |  |  |  |  |  | 
| 495 |  |  |  |  |  |  | sub password | 
| 496 |  |  |  |  |  |  | { | 
| 497 | 0 |  |  | 0 | 1 |  | my $s = shift; | 
| 498 | 0 | 0 |  |  |  |  | $s->{password} = shift if scalar @_; | 
| 499 | 0 |  |  |  |  |  | $s->{password}; | 
| 500 |  |  |  |  |  |  | } | 
| 501 |  |  |  |  |  |  |  | 
| 502 |  |  |  |  |  |  | # Use the Sales/Trend Reports form to get a form for fetching daily summaries | 
| 503 |  |  |  |  |  |  | sub daily_sales_summary_form | 
| 504 |  |  |  |  |  |  | { | 
| 505 | 0 |  |  | 0 | 0 |  | my ($s) = @_; | 
| 506 |  |  |  |  |  |  |  | 
| 507 |  |  |  |  |  |  | # Use cached response to avoid another trip on the net | 
| 508 | 0 | 0 |  |  |  |  | unless( $s->{response}{daily_summary_sales} ) | 
| 509 |  |  |  |  |  |  | { | 
| 510 |  |  |  |  |  |  | # Get an HTML::Form object for the Sales/Trends Reports page. Then fill it out | 
| 511 |  |  |  |  |  |  | #  and submit it to get a list of available Daily Summary dates. | 
| 512 | 0 |  |  |  |  |  | my $form = $s->sales_form(); | 
| 513 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 514 | 0 |  |  |  |  |  | $form->value('#selReportType', 'Summary'); | 
| 515 | 0 |  |  |  |  |  | $form->value('#selDateType', 'Daily'); | 
| 516 | 0 |  |  |  |  |  | $form->value('hiddenSubmitTypeName', 'ShowDropDown'); | 
| 517 | 0 |  |  |  |  |  | my $r = $s->{ua}->request($form->click('download')); | 
| 518 | 0 |  |  |  |  |  | $s->{response}{daily_summary_sales} = $r; | 
| 519 |  |  |  |  |  |  | } | 
| 520 |  |  |  |  |  |  |  | 
| 521 |  |  |  |  |  |  | # The response includes a form containing a select input element with the list | 
| 522 |  |  |  |  |  |  | #  of available dates. Create and return a form object for it. | 
| 523 | 0 |  |  |  |  |  | my @forms = HTML::Form->parse($s->{response}{daily_summary_sales}); | 
| 524 | 0 |  |  |  |  |  | @forms = grep $_->attr('name') eq 'frmVendorPage', @forms; | 
| 525 | 0 | 0 |  |  |  |  | return undef unless @forms; | 
| 526 | 0 |  |  |  |  |  | shift @forms; | 
| 527 |  |  |  |  |  |  | } | 
| 528 |  |  |  |  |  |  |  | 
| 529 |  |  |  |  |  |  | # Use the Sales/Trend Reports form to get a form for fetching monthly summaries | 
| 530 |  |  |  |  |  |  | sub monthly_free_summary_form | 
| 531 |  |  |  |  |  |  | { | 
| 532 | 0 |  |  | 0 | 0 |  | my ($s) = @_; | 
| 533 |  |  |  |  |  |  |  | 
| 534 |  |  |  |  |  |  | # Use cached response to avoid another trip on the net | 
| 535 | 0 | 0 |  |  |  |  | unless( $s->{response}{monthly_summary_free} ) | 
| 536 |  |  |  |  |  |  | { | 
| 537 |  |  |  |  |  |  | # Get an HTML::Form object for the Sales/Trends Reports page. Then fill it out | 
| 538 |  |  |  |  |  |  | #  and submit it to get a list of available Monthly Summary dates. | 
| 539 | 0 |  |  |  |  |  | my $form = $s->sales_form(); | 
| 540 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 541 | 0 |  |  |  |  |  | $form->value('#selReportType', 'Summary'); | 
| 542 | 0 |  |  |  |  |  | $form->value('#selDateType', 'Monthly Free'); | 
| 543 | 0 |  |  |  |  |  | $form->value('hiddenSubmitTypeName', 'ShowDropDown'); | 
| 544 | 0 |  |  |  |  |  | my $r = $s->{ua}->request($form->click('download')); | 
| 545 | 0 |  |  |  |  |  | $s->{response}{monthly_summary_free} = $r; | 
| 546 |  |  |  |  |  |  | } | 
| 547 |  |  |  |  |  |  |  | 
| 548 |  |  |  |  |  |  | # The response includes a form containing a select input element with the list | 
| 549 |  |  |  |  |  |  | #  of available dates. Create and return a form object for it. | 
| 550 | 0 |  |  |  |  |  | my @forms = HTML::Form->parse($s->{response}{monthly_summary_free}); | 
| 551 | 0 |  |  |  |  |  | @forms = grep $_->attr('name') eq 'frmVendorPage', @forms; | 
| 552 | 0 | 0 |  |  |  |  | return undef unless @forms; | 
| 553 | 0 |  |  |  |  |  | shift @forms; | 
| 554 |  |  |  |  |  |  | } | 
| 555 |  |  |  |  |  |  |  | 
| 556 |  |  |  |  |  |  | # Use the Sales/Trend Reports form to get a form for fetching weekly summaries | 
| 557 |  |  |  |  |  |  | sub weekly_sales_summary_form | 
| 558 |  |  |  |  |  |  | { | 
| 559 | 0 |  |  | 0 | 0 |  | my ($s) = @_; | 
| 560 |  |  |  |  |  |  |  | 
| 561 |  |  |  |  |  |  | # Use cached response to avoid another trip on the net | 
| 562 | 0 | 0 |  |  |  |  | unless( $s->{response}{weekly_summary_sales} ) | 
| 563 |  |  |  |  |  |  | { | 
| 564 |  |  |  |  |  |  | # Get an HTML::Form object for the Sales/Trends Reports page. Then fill it out | 
| 565 |  |  |  |  |  |  | #  and submit it to get a list of available Weekly Summary dates. | 
| 566 | 0 |  |  |  |  |  | my $form = $s->sales_form(); | 
| 567 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 568 | 0 |  |  |  |  |  | $form->value('#selReportType', 'Summary'); | 
| 569 | 0 |  |  |  |  |  | $form->value('#selDateType', 'Weekly'); | 
| 570 | 0 |  |  |  |  |  | $form->value('hiddenSubmitTypeName', 'ShowDropDown'); | 
| 571 | 0 |  |  |  |  |  | my $r = $s->{ua}->request($form->click('download')); | 
| 572 | 0 |  |  |  |  |  | $s->{response}{weekly_summary_sales} = $r; | 
| 573 |  |  |  |  |  |  | } | 
| 574 |  |  |  |  |  |  |  | 
| 575 |  |  |  |  |  |  | # The response includes a form containing a select input element with the list | 
| 576 |  |  |  |  |  |  | #  of available dates. Create and return a form object for it. | 
| 577 | 0 |  |  |  |  |  | my @forms = HTML::Form->parse($s->{response}{weekly_summary_sales}); | 
| 578 | 0 |  |  |  |  |  | @forms = grep $_->attr('name') eq 'frmVendorPage', @forms; | 
| 579 | 0 | 0 |  |  |  |  | return undef unless @forms; | 
| 580 | 0 |  |  |  |  |  | shift @forms; | 
| 581 |  |  |  |  |  |  | } | 
| 582 |  |  |  |  |  |  |  | 
| 583 |  |  |  |  |  |  | # Generate an HTML::Form from the cached Sales/Trend Reports page | 
| 584 |  |  |  |  |  |  | sub sales_form | 
| 585 |  |  |  |  |  |  | { | 
| 586 | 0 |  |  | 0 | 0 |  | my $s = shift; | 
| 587 |  |  |  |  |  |  |  | 
| 588 |  |  |  |  |  |  | # Fetch the Sales/Trend Report page | 
| 589 | 0 |  |  |  |  |  | my $r = $s->sales_response(); | 
| 590 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 591 | 0 | 0 |  |  |  |  | return undef if $r->is_error;   # Check the response code | 
| 592 |  |  |  |  |  |  |  | 
| 593 | 0 |  |  |  |  |  | my @forms = HTML::Form->parse($r); | 
| 594 | 0 |  |  |  |  |  | @forms = grep $_->attr('name') eq 'frmVendorPage', @forms; | 
| 595 | 0 | 0 |  |  |  |  | return undef unless @forms; | 
| 596 | 0 |  |  |  |  |  | shift @forms; | 
| 597 |  |  |  |  |  |  | } | 
| 598 |  |  |  |  |  |  |  | 
| 599 |  |  |  |  |  |  | # Fetch the desired Financial Reports page and cache the response | 
| 600 |  |  |  |  |  |  | #  Fetches the first page if no page number is given | 
| 601 |  |  |  |  |  |  | sub financial_response | 
| 602 |  |  |  |  |  |  | { | 
| 603 | 0 |  |  | 0 | 0 |  | my $s = shift; | 
| 604 | 0 |  |  |  |  |  | my $page = 1; | 
| 605 | 0 | 0 |  |  |  |  | $page = shift if scalar @_; | 
| 606 |  |  |  |  |  |  |  | 
| 607 |  |  |  |  |  |  | # Try the cache first | 
| 608 | 0 | 0 |  |  |  |  | return $s->{'response'}{'financial'}{$page} if $s->{'response'}{'financial'}{$page}; | 
| 609 |  |  |  |  |  |  |  | 
| 610 | 0 | 0 |  |  |  |  | unless( $s->{financial_path} ) | 
| 611 |  |  |  |  |  |  | { | 
| 612 |  |  |  |  |  |  | # Nothing to do without the main menu | 
| 613 | 0 | 0 |  |  |  |  | return undef unless $s->{main_menu_tree}; | 
| 614 |  |  |  |  |  |  |  | 
| 615 |  |  |  |  |  |  | # Find the Financial Reports path that's listed on the main menu | 
| 616 | 0 |  |  | 0 |  |  | my $element = $s->{main_menu_tree}->look_down('_tag', 'a', sub { $_[0]->as_trimmed_text eq 'Financial Reports'}); | 
|  | 0 |  |  |  |  |  |  | 
| 617 | 0 | 0 |  |  |  |  | return undef unless $element; | 
| 618 | 0 |  |  |  |  |  | $s->{financial_path} = $element->attr('href'); | 
| 619 | 0 | 0 |  |  |  |  | return undef unless $s->{financial_path}; | 
| 620 |  |  |  |  |  |  | } | 
| 621 |  |  |  |  |  |  |  | 
| 622 | 0 |  |  |  |  |  | my $r; | 
| 623 | 0 | 0 |  |  |  |  | if( $page > 1 ) | 
| 624 |  |  |  |  |  |  | { | 
| 625 | 0 |  |  |  |  |  | $r = $s->financial_response;		# Want the form on the first page | 
| 626 |  |  |  |  |  |  |  | 
| 627 | 0 | 0 |  |  |  |  | return undef if $page > $s->{num_financial_report_pages}; | 
| 628 |  |  |  |  |  |  |  | 
| 629 |  |  |  |  |  |  | # Get the Items/Page form and set to display the desired page | 
| 630 | 0 |  |  |  |  |  | my @forms = HTML::Form->parse($r); | 
| 631 | 0 |  |  |  |  |  | @forms = grep $_->find_input('currPage', 'text'), @forms; | 
| 632 | 0 |  |  |  |  |  | my $form = shift @forms; | 
| 633 | 0 | 0 |  |  |  |  | return undef unless $form; | 
| 634 |  |  |  |  |  |  |  | 
| 635 | 0 |  |  |  |  |  | $form->value('currPage', $page);	# Set the input for the desired page | 
| 636 | 0 |  |  |  |  |  | $r = $s->{ua}->request($form->click);	# Get the new page | 
| 637 |  |  |  |  |  |  | } | 
| 638 |  |  |  |  |  |  | else | 
| 639 |  |  |  |  |  |  | { | 
| 640 | 0 |  |  |  |  |  | $r = $s->request($s->{'financial_path'}); | 
| 641 |  |  |  |  |  |  |  | 
| 642 |  |  |  |  |  |  | # Find the number of available financial reports | 
| 643 | 0 |  |  |  |  |  | $r->content =~ /(\d+) iTunes Financial Reports/; | 
| 644 | 0 |  |  |  |  |  | $s->{num_financial_reports} = $1; | 
| 645 |  |  |  |  |  |  |  | 
| 646 | 0 |  |  |  |  |  | $r->content =~ /Page\s*\s*of\s*(\d+)\s*/; | 
| 647 | 0 |  |  |  |  |  | $s->{num_financial_report_pages} = $1; | 
| 648 |  |  |  |  |  |  |  | 
| 649 |  |  |  |  |  |  | # Parse the input's label to find the highest value that it can be set to | 
| 650 | 0 |  |  |  |  |  | $r->content =~ /items\/page \(max (\d+)\)/; | 
| 651 | 0 |  |  |  |  |  | $s->{max_financial_reports_per_page} = $1; | 
| 652 |  |  |  |  |  |  | } | 
| 653 |  |  |  |  |  |  |  | 
| 654 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 655 | 0 |  |  |  |  |  | $s->{'response'}{'financial'}{$page} = $r; | 
| 656 |  |  |  |  |  |  | } | 
| 657 |  |  |  |  |  |  |  | 
| 658 |  |  |  |  |  |  | # Follow the Sales and Trends redirect and store the response for later use | 
| 659 |  |  |  |  |  |  | sub sales_response | 
| 660 |  |  |  |  |  |  | { | 
| 661 | 0 |  |  | 0 | 0 |  | my $s = shift; | 
| 662 |  |  |  |  |  |  |  | 
| 663 |  |  |  |  |  |  | # Returned cached response to avoid another trip on the net | 
| 664 | 0 | 0 |  |  |  |  | return $s->{response}{sales} if $s->{response}{sales}; | 
| 665 |  |  |  |  |  |  |  | 
| 666 | 0 | 0 |  |  |  |  | unless( $s->{sales_path} ) | 
| 667 |  |  |  |  |  |  | { | 
| 668 |  |  |  |  |  |  | # Nothing to do without the main menu | 
| 669 | 0 | 0 |  |  |  |  | return undef unless $s->{main_menu_tree}; | 
| 670 |  |  |  |  |  |  |  | 
| 671 |  |  |  |  |  |  | # Find the Sales and Trends path that's listed on the main menu | 
| 672 | 0 |  |  | 0 |  |  | my $element = $s->{main_menu_tree}->look_down('_tag', 'a', sub { $_[0]->as_trimmed_text eq 'Sales and Trends'}); | 
|  | 0 |  |  |  |  |  |  | 
| 673 | 0 | 0 |  |  |  |  | return undef unless $element; | 
| 674 | 0 |  |  |  |  |  | $s->{sales_path} = $element->attr('href'); | 
| 675 | 0 | 0 |  |  |  |  | return undef unless $s->{sales_path}; | 
| 676 |  |  |  |  |  |  | } | 
| 677 |  |  |  |  |  |  |  | 
| 678 |  |  |  |  |  |  | # Handle the Sales and Trends page redirect | 
| 679 | 0 |  |  |  |  |  | my $r = $s->request($s->{sales_path}); | 
| 680 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 681 |  |  |  |  |  |  |  | 
| 682 | 0 |  |  |  |  |  | $r->as_string =~ //; | 
| 683 | 0 |  |  |  |  |  | $r = $s->{ua}->get($1); | 
| 684 | 0 | 0 |  |  |  |  | return undef unless $r; | 
| 685 |  |  |  |  |  |  |  | 
| 686 | 0 |  |  |  |  |  | $s->{response}{sales} = $r; | 
| 687 |  |  |  |  |  |  | } | 
| 688 |  |  |  |  |  |  |  | 
| 689 |  |  |  |  |  |  | # --- Internal use only --- | 
| 690 |  |  |  |  |  |  |  | 
| 691 |  |  |  |  |  |  | sub request | 
| 692 |  |  |  |  |  |  | { | 
| 693 | 0 |  |  | 0 | 0 |  | my ($s, $url) = @_; | 
| 694 | 0 | 0 |  |  |  |  | return undef unless $s->{ua}; | 
| 695 | 0 |  |  |  |  |  | return $s->{ua}->get(URL_PHOBOS.$url); | 
| 696 |  |  |  |  |  |  | } | 
| 697 |  |  |  |  |  |  |  | 
| 698 |  |  |  |  |  |  | 1; | 
| 699 |  |  |  |  |  |  |  | 
| 700 |  |  |  |  |  |  | =head1 NAME | 
| 701 |  |  |  |  |  |  |  | 
| 702 |  |  |  |  |  |  | iTunesConnect - An iTunesConnect client interface | 
| 703 |  |  |  |  |  |  |  | 
| 704 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 705 |  |  |  |  |  |  |  | 
| 706 |  |  |  |  |  |  | use WWW::iTunesConnect; | 
| 707 |  |  |  |  |  |  |  | 
| 708 |  |  |  |  |  |  | my $itc = WWW::iTunesConnect->new(user=>$user, password=>$password); | 
| 709 |  |  |  |  |  |  | my %report = $itc->daily_sales_summary; | 
| 710 |  |  |  |  |  |  |  | 
| 711 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 712 |  |  |  |  |  |  |  | 
| 713 |  |  |  |  |  |  | C provides an interface to Apple's iTunes Connect website. | 
| 714 |  |  |  |  |  |  | Daily, Weekly and Monthly summaries, as well as Finanacial Reports, can be | 
| 715 |  |  |  |  |  |  | retrieved. Eventually this will become a complete interface. | 
| 716 |  |  |  |  |  |  |  | 
| 717 |  |  |  |  |  |  | A script suitable for use as a nightly cronjob can be found at | 
| 718 |  |  |  |  |  |  | L | 
| 719 |  |  |  |  |  |  |  | 
| 720 |  |  |  |  |  |  | =head1 CONSTRUCTOR | 
| 721 |  |  |  |  |  |  |  | 
| 722 |  |  |  |  |  |  | =over | 
| 723 |  |  |  |  |  |  |  | 
| 724 |  |  |  |  |  |  | =item $itc = WWW::iTunesConnect->new(user=>$user, password=>$password); | 
| 725 |  |  |  |  |  |  |  | 
| 726 |  |  |  |  |  |  | Constructs and returns a new C interface object. Accepts a hash | 
| 727 |  |  |  |  |  |  | containing the iTunes Connect username and password. | 
| 728 |  |  |  |  |  |  |  | 
| 729 |  |  |  |  |  |  | =back | 
| 730 |  |  |  |  |  |  |  | 
| 731 |  |  |  |  |  |  | =head1 ATTRIBUTES | 
| 732 |  |  |  |  |  |  |  | 
| 733 |  |  |  |  |  |  | =over | 
| 734 |  |  |  |  |  |  |  | 
| 735 |  |  |  |  |  |  | =item $itc->user | 
| 736 |  |  |  |  |  |  |  | 
| 737 |  |  |  |  |  |  | Get/Set the iTunes Connect username. NOTE: User and Password must be set | 
| 738 |  |  |  |  |  |  | before calling any other methods. | 
| 739 |  |  |  |  |  |  |  | 
| 740 |  |  |  |  |  |  | =item $itc->password | 
| 741 |  |  |  |  |  |  |  | 
| 742 |  |  |  |  |  |  | Get/Set the iTunes Connect password. NOTE: User and Password must be set | 
| 743 |  |  |  |  |  |  | before calling any other methods. | 
| 744 |  |  |  |  |  |  |  | 
| 745 |  |  |  |  |  |  | =back | 
| 746 |  |  |  |  |  |  |  | 
| 747 |  |  |  |  |  |  | =head1 Class Methods | 
| 748 |  |  |  |  |  |  |  | 
| 749 |  |  |  |  |  |  | =over | 
| 750 |  |  |  |  |  |  |  | 
| 751 |  |  |  |  |  |  | =item %report = WWW::iTunesConnect->parse_sales_summary($input, %options) | 
| 752 |  |  |  |  |  |  |  | 
| 753 |  |  |  |  |  |  | Parse a gzip'd summary file fetched from the Sales/Trend page. Arguments are | 
| 754 |  |  |  |  |  |  | the same as the L constructor, less the output argument. | 
| 755 |  |  |  |  |  |  | To parse a file pass a scalar containing the file name as $input. To parse a | 
| 756 |  |  |  |  |  |  | string of content, pass a scalar reference as $input. The %options hash is | 
| 757 |  |  |  |  |  |  | passed directly to I. | 
| 758 |  |  |  |  |  |  |  | 
| 759 |  |  |  |  |  |  | The returned hash has two elements: I | 
| 760 |  |  |  |  |  |  | is a reference to an array of the column headers in the fetched TSV file. The | 
| 761 |  |  |  |  |  |  | I element is a reference to an array of array references, one for each | 
| 762 |  |  |  |  |  |  | non-header line in the fetched TSV file. | 
| 763 |  |  |  |  |  |  |  | 
| 764 |  |  |  |  |  |  | =back | 
| 765 |  |  |  |  |  |  |  | 
| 766 |  |  |  |  |  |  | =head1 METHODS | 
| 767 |  |  |  |  |  |  |  | 
| 768 |  |  |  |  |  |  | These methods fetch various bits of information from the iTunes Connect servers. | 
| 769 |  |  |  |  |  |  | Everything here uses LWP and is therefore essentially a screen scraper. So, be | 
| 770 |  |  |  |  |  |  | careful and try not to load up Apple's servers too much. We don't want them to | 
| 771 |  |  |  |  |  |  | make this any more difficult than it already is. | 
| 772 |  |  |  |  |  |  |  | 
| 773 |  |  |  |  |  |  | =over | 
| 774 |  |  |  |  |  |  |  | 
| 775 |  |  |  |  |  |  | =item $itc->login() | 
| 776 |  |  |  |  |  |  |  | 
| 777 |  |  |  |  |  |  | Uses the username and password properties to authenticate to the iTunes Connect | 
| 778 |  |  |  |  |  |  | server. This is automatically called as needed by the other fetch methods if | 
| 779 |  |  |  |  |  |  | user and password have already been set. | 
| 780 |  |  |  |  |  |  |  | 
| 781 |  |  |  |  |  |  | =item $itc->daily_sales_summary_dates | 
| 782 |  |  |  |  |  |  |  | 
| 783 |  |  |  |  |  |  | Fetch the list of available dates for Sales/Trend Daily Summary Reports. This | 
| 784 |  |  |  |  |  |  | caches the returned results so it can be safely called multiple times. Note, | 
| 785 |  |  |  |  |  |  | however, that if the parent script runs for longer than 24 hours the cached | 
| 786 |  |  |  |  |  |  | results will be invalid. | 
| 787 |  |  |  |  |  |  |  | 
| 788 |  |  |  |  |  |  | Dates are sorted in descending order. | 
| 789 |  |  |  |  |  |  |  | 
| 790 |  |  |  |  |  |  | =item $itc->daily_sales_summary() | 
| 791 |  |  |  |  |  |  |  | 
| 792 |  |  |  |  |  |  | Fetch the most recent Sales/Trends Daily Summary report and return it as a | 
| 793 |  |  |  |  |  |  | hash of array references. The returned hash has two elements in addition to the | 
| 794 |  |  |  |  |  |  | elements returned by I: I and I. The | 
| 795 |  |  |  |  |  |  | I element is the raw content of the file retrieved from iTunes Connect | 
| 796 |  |  |  |  |  |  | and the I element is the filename provided by the Content-Disposition | 
| 797 |  |  |  |  |  |  | header line. | 
| 798 |  |  |  |  |  |  |  | 
| 799 |  |  |  |  |  |  | If a single string argument is given in the form 'MM/DD/YYYY' that date will be | 
| 800 |  |  |  |  |  |  | fetched instead (if it's available). | 
| 801 |  |  |  |  |  |  |  | 
| 802 |  |  |  |  |  |  | =item $itc->fetch_financial_report($month, $region) | 
| 803 |  |  |  |  |  |  |  | 
| 804 |  |  |  |  |  |  | Fetch the raw report content for a given month and region. The month argument | 
| 805 |  |  |  |  |  |  | must be of the form 'YYYYMM' and the region argument is the name of a region | 
| 806 |  |  |  |  |  |  | as listed on the Financial Reports page of iTunes Connect. | 
| 807 |  |  |  |  |  |  |  | 
| 808 |  |  |  |  |  |  | Returns a hash with two keys: | 
| 809 |  |  |  |  |  |  |  | 
| 810 |  |  |  |  |  |  | Key		Description | 
| 811 |  |  |  |  |  |  | ----------------------------------------------------------------------- | 
| 812 |  |  |  |  |  |  | filename	The report filename as listed on the Financial Reports page | 
| 813 |  |  |  |  |  |  | content	Raw content of the report file | 
| 814 |  |  |  |  |  |  |  | 
| 815 |  |  |  |  |  |  | =item $itc->financial_report_list() | 
| 816 |  |  |  |  |  |  |  | 
| 817 |  |  |  |  |  |  | Fetch the list of available Financial Reports. This caches the returned results | 
| 818 |  |  |  |  |  |  | and can be safely called multiple times. | 
| 819 |  |  |  |  |  |  |  | 
| 820 |  |  |  |  |  |  | =item $itc->financial_report() | 
| 821 |  |  |  |  |  |  |  | 
| 822 |  |  |  |  |  |  | Fetch the most recent Financial Report and return it as a hash. The keys of the | 
| 823 |  |  |  |  |  |  | returned hash are of the form 'YYYYMM', each of which is a hash containing one | 
| 824 |  |  |  |  |  |  | entry for each region included in that month's report. Each of the region | 
| 825 |  |  |  |  |  |  | entries is a yet another hash with six elements: | 
| 826 |  |  |  |  |  |  |  | 
| 827 |  |  |  |  |  |  | Key		Description | 
| 828 |  |  |  |  |  |  | --------------------------------------------- | 
| 829 |  |  |  |  |  |  | currency	Currency code | 
| 830 |  |  |  |  |  |  | data	Reference to array of report rows | 
| 831 |  |  |  |  |  |  | file	Raw content of the retrieved file | 
| 832 |  |  |  |  |  |  | filename	Retrieved file name | 
| 833 |  |  |  |  |  |  | header	Header row | 
| 834 |  |  |  |  |  |  | total	Sum of all rows in data | 
| 835 |  |  |  |  |  |  |  | 
| 836 |  |  |  |  |  |  | If a single string argument is given in the form 'YYYYMM', that month's report | 
| 837 |  |  |  |  |  |  | will be fetched instead (if it's available). | 
| 838 |  |  |  |  |  |  |  | 
| 839 |  |  |  |  |  |  | =item $itc->monthly_free_summary_dates | 
| 840 |  |  |  |  |  |  |  | 
| 841 |  |  |  |  |  |  | Fetch the list of available months for Sales/Trend Monthly Summary Reports. This | 
| 842 |  |  |  |  |  |  | caches the returned results so it can be safely called multiple times. | 
| 843 |  |  |  |  |  |  |  | 
| 844 |  |  |  |  |  |  | Months are returned as an array of hash references in descending order. Each | 
| 845 |  |  |  |  |  |  | hash contains the keys I and I, indicating the start and end dates of | 
| 846 |  |  |  |  |  |  | each report. | 
| 847 |  |  |  |  |  |  |  | 
| 848 |  |  |  |  |  |  | =item $itc->monthly_free_summary( %options ) | 
| 849 |  |  |  |  |  |  |  | 
| 850 |  |  |  |  |  |  | Fetch the most recent Sales/Trends Monthly Summary report and return it as a | 
| 851 |  |  |  |  |  |  | hash of array references. The returned hash has two elements in addition to the | 
| 852 |  |  |  |  |  |  | elements returned by I: I and I. The | 
| 853 |  |  |  |  |  |  | I element is the raw content of the file retrieved from iTunes Connect | 
| 854 |  |  |  |  |  |  | and the I element is the filename provided by the Content-Disposition | 
| 855 |  |  |  |  |  |  | header line. | 
| 856 |  |  |  |  |  |  |  | 
| 857 |  |  |  |  |  |  | If both I and I options are passed, and both are of the form | 
| 858 |  |  |  |  |  |  | 'MM/DD/YYYY', the monthly summary matching the two dates will be fetched | 
| 859 |  |  |  |  |  |  | instead (if it's available). The hashes returned by monthly_free_summary_dates() | 
| 860 |  |  |  |  |  |  | are suitable for passing to this method. | 
| 861 |  |  |  |  |  |  |  | 
| 862 |  |  |  |  |  |  | =item $itc->weekly_sales_summary_dates | 
| 863 |  |  |  |  |  |  |  | 
| 864 |  |  |  |  |  |  | Fetch the list of available dates for Sales/Trend Weekly Summary Reports. This | 
| 865 |  |  |  |  |  |  | caches the returned results so it can be safely called multiple times. | 
| 866 |  |  |  |  |  |  |  | 
| 867 |  |  |  |  |  |  | Dates are sorted in descending order. | 
| 868 |  |  |  |  |  |  |  | 
| 869 |  |  |  |  |  |  | =item $itc->weekly_sales_summary() | 
| 870 |  |  |  |  |  |  |  | 
| 871 |  |  |  |  |  |  | Fetch the most recent Sales/Trends Weekly Summary report and return it as a | 
| 872 |  |  |  |  |  |  | hash of array references. The returned hash has two elements in addition to the | 
| 873 |  |  |  |  |  |  | elements returned by I: I and I. The | 
| 874 |  |  |  |  |  |  | I element is the raw content of the file retrieved from iTunes Connect | 
| 875 |  |  |  |  |  |  | and the I element is the filename provided by the Content-Disposition | 
| 876 |  |  |  |  |  |  | header line. | 
| 877 |  |  |  |  |  |  |  | 
| 878 |  |  |  |  |  |  | If a single string argument is given in the form 'MM/DD/YYYY' the week ending | 
| 879 |  |  |  |  |  |  | on the given date will be fetched instead (if it's available). | 
| 880 |  |  |  |  |  |  |  | 
| 881 |  |  |  |  |  |  | =back | 
| 882 |  |  |  |  |  |  |  | 
| 883 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 884 |  |  |  |  |  |  |  | 
| 885 |  |  |  |  |  |  | L | 
| 886 |  |  |  |  |  |  | L | 
| 887 |  |  |  |  |  |  | L | 
| 888 |  |  |  |  |  |  | L | 
| 889 |  |  |  |  |  |  | L | 
| 890 |  |  |  |  |  |  |  | 
| 891 |  |  |  |  |  |  | =head1 AUTHOR | 
| 892 |  |  |  |  |  |  |  | 
| 893 |  |  |  |  |  |  | Brandon Fosdick, Ebfoz@bfoz.netE | 
| 894 |  |  |  |  |  |  |  | 
| 895 |  |  |  |  |  |  | =head1 COPYRIGHT AND LICENSE | 
| 896 |  |  |  |  |  |  |  | 
| 897 |  |  |  |  |  |  | Copyright 2008-2009 Brandon Fosdick | 
| 898 |  |  |  |  |  |  |  | 
| 899 |  |  |  |  |  |  | This software is provided under the terms of the BSD License. | 
| 900 |  |  |  |  |  |  |  | 
| 901 |  |  |  |  |  |  | =cut |