File Coverage

blib/lib/Finance/Google/Portfolio.pm
Criterion Covered Total %
statement 31 67 46.2
branch 1 14 7.1
condition 1 17 5.8
subroutine 11 15 73.3
pod 4 5 80.0
total 48 118 40.6


line stmt bran cond sub pod time code
1             package Finance::Google::Portfolio;
2             # ABSTRACT: Manipulate Google Finance portfolios a little
3              
4 1     1   197279 use 5.008;
  1         9  
5 1     1   4 use strict;
  1         2  
  1         16  
6 1     1   4 use warnings;
  1         2  
  1         18  
7              
8 1     1   469 use Moo;
  1         9385  
  1         5  
9 1     1   1583 use namespace::clean;
  1         9510  
  1         7  
10 1     1   813 use LWP::UserAgent;
  1         33724  
  1         33  
11 1     1   499 use HTML::Form;
  1         5505  
  1         30  
12 1     1   616 use JSON::PP;
  1         11408  
  1         76  
13 1     1   7 use Carp 'croak';
  1         2  
  1         38  
14 1     1   6 use URI;
  1         1  
  1         821  
15              
16             our $VERSION = '1.05'; # VERSION
17              
18             has user => ( is => 'rwp' );
19             has passwd => ( is => 'rwp' );
20             has is_authed => ( is => 'rwp', default => 0 );
21             has hash => ( is => 'rwp' );
22             has json => ( is => 'ro', default => sub { JSON::PP->new->utf8->allow_barekey } );
23             has ua => (
24             is => 'ro',
25             default => sub {
26             my $ua = LWP::UserAgent->new(
27             max_redirect => 24,
28             );
29             push( @{ $ua->requests_redirectable }, 'POST' );
30             $ua->cookie_jar({});
31             return $ua;
32             },
33             );
34              
35             sub BUILD {
36 1     1 0 12 my ($self) = @_;
37 1 50 33     17 $self->login( $self->user, $self->passwd ) if ( $self->user and $self->passwd );
38             }
39              
40             sub login {
41 0     0 1   my ( $self, $user, $passwd ) = @_;
42              
43 0 0         $self->_set_user($user) if ($user);
44 0 0         $self->_set_passwd($passwd) if ($passwd);
45              
46 0 0 0       croak('Must provide "user" and "passwd" values to login() or new()')
47             unless ( $self->user and $self->passwd );
48              
49 0           my $form = ( HTML::Form->parse(
50             $self->ua->request( HTTP::Request->new( 'GET', 'https://mail.google.com/tasks/ig' ) )
51             ) )[0];
52 0           $form->value( 'Email', $self->user );
53 0           $form = ( HTML::Form->parse( $self->ua->request( $form->click ) ) )[0];
54 0           $form->value( 'Passwd', $self->passwd );
55              
56 0           my $res = $self->ua->request( $form->click );
57              
58 0 0         croak('Authentication failed; check user and passwd values and that LWP::Protocol::https is installed')
59             if ( $res->content =~ /Sign in/ ); </td> </tr> <tr> <td class="h" > <a name="60">60</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="61">61</a> </td> <td class="c0" > <a href="#62"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->_set_is_authed(1); </td> </tr> <tr> <td class="h" > <a name="62">62</a> </td> <td class="c0" > <a href="#66"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return $self; </td> </tr> <tr> <td class="h" > <a name="63">63</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="64">64</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="65">65</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub portfolio { </td> </tr> <tr> <td class="h" > <a name="66">66</a> </td> <td class="c0" > <a href="#67"> 0 </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--subroutine.html#66-1"> 0 </a> </td> <td class="c3" > <a href="blib-lib-Finance-Google-Portfolio-pm--subroutine.html#66-1"> 1 </a> </td> <td >   </td> <td class="s"> my ( $self, $pid ) = @_; </td> </tr> <tr> <td class="h" > <a name="67">67</a> </td> <td class="c0" > <a href="#69"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--condition.html#67-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $pid ||= 1; </td> </tr> <tr> <td class="h" > <a name="68">68</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="69">69</a> </td> <td class="c0" > <a href="#73"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $res = $self->ua->request( </td> </tr> <tr> <td class="h" > <a name="70">70</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> HTTP::Request->new( 'GET', 'https://www.google.com/finance/portfolio?action=view&pid=' . $pid ) </td> </tr> <tr> <td class="h" > <a name="71">71</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="72">72</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="73">73</a> </td> <td class="c0" > <a href="# "> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($fgp_data_string) = grep { $_ =~ /^\s*google\.finance\.data\s/ } split( "\n", $res->content ); </td> </tr> <tr> <td class="h" > <a > </a> </td> <td class="c0" > <a href="#74"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="74">74</a> </td> <td class="c0" > <a href="#75"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $fgp_data_string =~ s/^\s*google\.finance\.data\s*=\s*//; </td> </tr> <tr> <td class="h" > <a name="75">75</a> </td> <td class="c0" > <a href="#77"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $fgp_data_string =~ s/;$//; </td> </tr> <tr> <td class="h" > <a name="76">76</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="77">77</a> </td> <td class="c0" > <a href="#78"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $fgp_data = $self->json->decode($fgp_data_string); </td> </tr> <tr> <td class="h" > <a name="78">78</a> </td> <td class="c0" > <a href="#80"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->_set_hash( $fgp_data->{common}{hash} ); </td> </tr> <tr> <td class="h" > <a name="79">79</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="80">80</a> </td> <td class="c0" > <a href="#86"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return $fgp_data->{portfolio_view}{portfolio_table}{cps}; </td> </tr> <tr> <td class="h" > <a name="81">81</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="82">82</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="83">83</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> { </td> </tr> <tr> <td class="h" > <a name="84">84</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @months = qw( January February March April May June July August September October November December ); </td> </tr> <tr> <td class="h" > <a name="85">85</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub add { </td> </tr> <tr> <td class="h" > <a name="86">86</a> </td> <td class="c0" > <a href="#87"> 0 </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--subroutine.html#86-1"> 0 </a> </td> <td class="c3" > <a href="blib-lib-Finance-Google-Portfolio-pm--subroutine.html#86-1"> 1 </a> </td> <td >   </td> <td class="s"> my ( $self, $details ) = @_; </td> </tr> <tr> <td class="h" > <a name="87">87</a> </td> <td class="c0" > <a href="#89"> 0 </a> </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--branch.html#87-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> croak('Transaction details must be supplied to add() as a hashref') unless ( ref $details eq 'HASH' ); </td> </tr> <tr> <td class="h" > <a name="88">88</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="89">89</a> </td> <td class="c0" > <a href="#101"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $uri = URI->new; </td> </tr> <tr> <td class="h" > <a name="90">90</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $uri->query_form( </td> </tr> <tr> <td class="h" > <a name="91">91</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> editmode => 'trans', </td> </tr> <tr> <td class="h" > <a name="92">92</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> menu_type => 'transaction', </td> </tr> <tr> <td class="h" > <a name="93">93</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> pid => $details->{pid} || 1, </td> </tr> <tr> <td class="h" > <a name="94">94</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> add_ttype_1 => uc( $details->{type} || '' ), </td> </tr> <tr> <td class="h" > <a name="95">95</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> add_symbols_1 => $details->{symbol}, </td> </tr> <tr> <td class="h" > <a name="96">96</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> add_shares_1 => $details->{shares}, </td> </tr> <tr> <td class="h" > <a name="97">97</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> add_price_1 => $details->{price}, </td> </tr> <tr> <td class="h" > <a name="98">98</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> add_commission_1 => $details->{commission}, </td> </tr> <tr> <td class="h" > <a name="99">99</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> add_notes_1 => $details->{notes}, </td> </tr> <tr> <td class="h" > <a name="100">100</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> add_is_cash_synced_1 => 'on', </td> </tr> <tr> <td class="h" > <a name="101">101</a> </td> <td class="c0" > <a href="#107"> 0 </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--condition.html#101-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> add_date_1 => $details->{date} || do { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--condition.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--condition.html#-3"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="102">102</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ( $month, $day, $year ) = ( localtime() )[ 4, 3, 5 ]; </td> </tr> <tr> <td class="h" > <a name="103">103</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $months[$month] . ' ' . $day . ', ' . ( $year + 1900 ); </td> </tr> <tr> <td class="h" > <a name="104">104</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }, </td> </tr> <tr> <td class="h" > <a name="105">105</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="106">106</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="107">107</a> </td> <td class="c0" > <a href="#111"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $req = HTTP::Request->new( </td> </tr> <tr> <td class="h" > <a name="108">108</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 'POST', </td> </tr> <tr> <td class="h" > <a name="109">109</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 'https://www.google.com/finance/portfolio?action=add&hash=' . $self->hash, </td> </tr> <tr> <td class="h" > <a name="110">110</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="111">111</a> </td> <td class="c0" > <a href="#112"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $req->content( $uri->query ); </td> </tr> <tr> <td class="h" > <a name="112">112</a> </td> <td class="c0" > <a href="#117"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->ua->request($req); </td> </tr> <tr> <td class="h" > <a name="113">113</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="114">114</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="115">115</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="116">116</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub watchlist { </td> </tr> <tr> <td class="h" > <a name="117">117</a> </td> <td class="c0" > <a href="#119"> 0 </a> </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--subroutine.html#117-1"> 0 </a> </td> <td class="c3" > <a href="blib-lib-Finance-Google-Portfolio-pm--subroutine.html#117-1"> 1 </a> </td> <td >   </td> <td class="s"> my ( $self, $details ) = @_; </td> </tr> <tr> <td class="h" > <a name="118">118</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="119">119</a> </td> <td class="c0" > <a href="#125"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $uri = URI->new; </td> </tr> <tr> <td class="h" > <a name="120">120</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $uri->query_form( </td> </tr> <tr> <td class="h" > <a name="121">121</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> editmode => 'trans', </td> </tr> <tr> <td class="h" > <a name="122">122</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> pid => $details->{pid} || 1, </td> </tr> <tr> <td class="h" > <a name="123">123</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> watchlist => ( </td> </tr> <tr> <td class="h" > <a name="124">124</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ( ref( $details->{list} ) eq 'ARRAY' ) </td> </tr> <tr> <td class="h" > <a name="125">125</a> </td> <td class="c0" > <a href="#127"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ? join( ' ', @{ $details->{list} } ) </td> </tr> <tr> <td class="h" > <a name="126">126</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> : $details->{list} </td> </tr> <tr> <td class="h" > <a name="127">127</a> </td> <td class="c0" > <a href="#130"> 0 </a> </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--branch.html#127-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-Finance-Google-Portfolio-pm--condition.html#127-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ), </td> </tr> <tr> <td class="h" > <a name="128">128</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="129">129</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="130">130</a> </td> <td class="c0" > <a href="#134"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $req = HTTP::Request->new( </td> </tr> <tr> <td class="h" > <a name="131">131</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 'POST', </td> </tr> <tr> <td class="h" > <a name="132">132</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 'https://www.google.com/finance/portfolio?action=edit_portfolio_del_btn&hash=' . $self->hash, </td> </tr> <tr> <td class="h" > <a name="133">133</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> ); </td> </tr> <tr> <td class="h" > <a name="134">134</a> </td> <td class="c0" > <a href="#135"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $req->content( $uri->query ); </td> </tr> <tr> <td class="h" > <a name="135">135</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->ua->request($req); </td> </tr> <tr> <td class="h" > <a name="136">136</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="137">137</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="138">138</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> <tr> <td class="h" > <a name="139">139</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="140">140</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> __END__ </td> </tr> </table> </body> </html>