File Coverage

blib/lib/Finance/Quote/HU.pm
Criterion Covered Total %
statement 32 135 23.7
branch 0 34 0.0
condition n/a
subroutine 11 17 64.7
pod 0 7 0.0
total 43 193 22.2


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # HU.pm
4             #
5             # Version 0.3 - Fixed BAMOSZ website scraping and download stocks
6             # directly from www.BET.hu
7             # This version based on ZA.pm module
8             #
9             # Zoltan Levardy <zoltan at levardy dot org> 2008, 2009
10             # Kristof Marussy <kris7topher at gmail dot com> 2014
11              
12             package Finance::Quote::HU;
13              
14 5     5   2588 use strict;
  5         14  
  5         195  
15              
16 5     5   71 use constant DEBUG => $ENV{DEBUG};
  5         14  
  5         304  
17 5     5   33 use if DEBUG, 'Smart::Comments';
  5         10  
  5         29  
18              
19 5     5   152 use LWP::UserAgent;
  5         12  
  5         29  
20 5     5   117 use HTTP::Request::Common;
  5         10  
  5         348  
21 5     5   36 use HTML::TableExtract;
  5         10  
  5         42  
22 5     5   202 use Encode;
  5         18  
  5         445  
23 5     5   35 use JSON;
  5         17  
  5         30  
24 5     5   557 use Web::Scraper;
  5         10  
  5         44  
25              
26             our $VERSION = '1.58'; # VERSION
27              
28             my $BAMOSZ_MAINURL = "http://www.bamosz.hu/";
29             my $BAMOSZ_URL = $BAMOSZ_MAINURL . "alapoldal?isin=";
30              
31             my $BSE_MAINURL = "http://www.bet.hu/";
32             my $BSE_URL = $BSE_MAINURL . '/oldalak/ceg_adatlap/$security/';
33              
34             sub methods {
35 5     5 0 49 return ( hufund => \&bamosz,
36             bamosz => \&bamosz,
37             hustock => \&bse,
38             bse => \&bse,
39             bet => \&bse,
40             hu => \&hu,
41             hungary => \&hu
42             );
43             }
44              
45             sub labels {
46 5     5 0 21 my @fundlabels =
47             qw/symbol method source name currency isin date isodate price last/;
48 5         18 my @stocklabels =
49             qw/symbol method source currency isin date isodate price open close
50             high low p_change last/;
51 5         14 my @alllabels = ( @stocklabels, "name" );
52 5         39 return ( hufund => \@fundlabels,
53             bamosz => \@fundlabels,
54             hustock => \@stocklabels,
55             bse => \@stocklabels,
56             bet => \@stocklabels,
57             hu => \@alllabels,
58             hungary => \@alllabels
59             );
60             }
61              
62             sub hu {
63 0     0 0   my $quoter = shift;
64 0           my @symbols = @_;
65 0           my %info;
66              
67 0           for my $symbol (@symbols) {
68 0           my %bse_info = bse( $quoter, $symbol );
69 0 0         if ( $bse_info{ $symbol, "success" } ) {
70 0           %info = ( %info, %bse_info );
71 0           next;
72             }
73              
74 0           my %bamosz_info = bamosz( $quoter, $symbol );
75 0 0         if ( $bamosz_info{ $symbol, "success" } ) {
76 0           %info = ( %info, %bamosz_info );
77 0           next;
78             }
79              
80 0           $info{ $symbol, "success" } = 0;
81 0           $info{ $symbol, "errormsg" } = "Fetch from bse or bamosz failed";
82             }
83              
84 0 0         return wantarray() ? %info : \%info;
85             }
86              
87             sub bse {
88 0     0 0   my $quoter = shift;
89 0           my @symbols = @_;
90 0           my %info;
91              
92 0           my $ua = $quoter->user_agent;
93              
94 0           for my $symbol (@symbols) {
95 0           eval {
96 0           my $url = $BSE_URL . $symbol;
97 0           my $response = $ua->request(GET $url);
98              
99             ### bse response : $response->content
100              
101 0 0         die "Request error" unless $response->is_success;
102 0 0         die "Failed to find JSON data" unless $response->content =~ m|window[.]dataSourceResults=([{].+[}])</script>|;
103              
104 0           my $json = decode_json $1;
105              
106             ### json : $json
107              
108             ### keys : keys %{$json}
109 0           my @profile_key = grep {/CompanyProfileDataSource;table=left/} keys %{$json};
  0            
  0            
110 0 0         die "Failed to process JSON" unless @profile_key == 1;
111              
112 0           my $profile = $json->{$profile_key[0]};
113              
114             ### profile : $profile
115              
116 0           foreach my $term (@{$profile}) {
  0            
117 0 0         $info{$symbol, "close"} = hu_decimal($term->{value}) if $term->{title} eq "El\x{151}z\x{151} z\x{e1}r\x{f3}\x{e1}r";
118 0 0         $info{$symbol, "high"} = hu_decimal($term->{value}) if $term->{title} eq "Napi maximum";
119 0 0         $info{$symbol, "low"} = hu_decimal($term->{value}) if $term->{title} eq "Napi minimum";
120             }
121              
122 0           my @trade_key = grep {/CompanyProfileDataSource;table=trades/} keys %{$json};
  0            
  0            
123 0 0         die "Failed to process JSON" unless @trade_key == 1;
124              
125 0           my $trade = $json->{$trade_key[0]};
126              
127 0           $info{$symbol, "last"} = hu_decimal($trade->[0]->{price});
128              
129             my $processor = scraper {
130 0     0     process '//*[@id="cp_tab_content_2"]/div[3]/div[3]/table/tbody/tr[1]/td[2]/span', 'ticker' => 'TEXT';
131 0           process '//*[@id="cp_tab_content_2"]/div[3]/div[3]/table/tbody/tr[2]/td[2]/span', 'isin' => 'TEXT';
132 0           process '//*[@id="cp_tab_content_2"]/div[3]/div[3]/table/tbody/tr[4]/td[2]/span', 'currency' => 'TEXT';
133 0           process '//*[@id="cp_tab_content_2"]/div[1]/div/div/div[2]/div/div[2]/span[2]', 'date' => 'TEXT';
134 0           };
135              
136 0           my $data = $processor->scrape($response);
137              
138             ### data : $data
139              
140 0           $info{ $symbol, "symbol" } = $data->{ticker};
141 0           $info{ $symbol, "isin" } = $data->{isin};
142 0           $info{ $symbol, "currency" } = $data->{currency};
143            
144 0           $quoter->store_date(\%info, $symbol, {isodate => $data->{date}});
145              
146 0           $info{ $symbol, "method" } = "bse";
147 0           $info{ $symbol, "source" } = $BSE_MAINURL;
148 0           $info{ $symbol, "success" } = 1;
149             };
150              
151 0 0         if ($@) {
152             ### bse error : $@
153 0           $info{ $symbol, "method"} = "bse";
154 0           $info{ $symbol, "errormsg"} = $@;
155 0           $info{ $symbol, "success"} = 0;
156             }
157             }
158              
159 0 0         return wantarray() ? %info : \%info;
160             }
161              
162             sub bamosz {
163 0     0 0   my $quoter = shift;
164 0           my @symbols = @_;
165 0           my %info;
166              
167 0           my $ua = $quoter->user_agent;
168              
169 0           for my $symbol (@symbols) {
170 0           $info{ $symbol, "method" } = "bamosz";
171 0           $info{ $symbol, "source" } = $BAMOSZ_MAINURL;
172 0           $info{ $symbol, "success" } = 0;
173              
174 0           my $url = $BAMOSZ_URL . $symbol;
175 0           my $response = $ua->request( GET $url);
176              
177             ### bamosz response : $response
178              
179 0 0         unless ( $response->is_success ) {
180 0           $info{ $symbol, "errormsg" } = "Request error";
181 0           next;
182             }
183              
184 0           my $te = HTML::TableExtract->new( attribs => { class => "dataTable" } );
185 0           $te->parse( decode_utf8( $response->content ) );
186 0 0         unless ( $te->first_table_found ) {
187 0           $info{ $symbol, "errormsg" } = "No dataTable found";
188 0           next;
189             }
190              
191 0           my $ts = $te->table( 0, 0 );
192 0           $info{ $symbol, "name" } = $ts->cell( 0, 1 );
193 0           my $isin = $ts->cell( 2, 1 );
194 0           $info{ $symbol, "symbol" } = $isin;
195 0           $info{ $symbol, "isin" } = $isin;
196 0           $info{ $symbol, "currency" } = $ts->cell( 3, 1 );
197 0           my $price = hu_decimal( $ts->cell( 5, 1 ) );
198 0           $info{ $symbol, "price" } = $price;
199 0           $info{ $symbol, "last" } = $price;
200 0           my $date = $ts->cell( 6, 1 );
201 0           $quoter->store_date( \%info, $symbol, { isodate => $date } );
202              
203 0           $info{ $symbol, "success" } = 1;
204             }
205              
206 0 0         return wantarray() ? %info : \%info;
207             }
208              
209             sub trim {
210 0     0 0   my $s = shift;
211 0 0         if ($s) {
212 0           $s =~ s/^\s+//;
213 0           $s =~ s/\s+$//;
214 0           return $s;
215             }
216             else {
217 0           return '';
218             }
219             }
220              
221             sub hu_decimal {
222 0     0 0   my $s = shift;
223 0 0         if ($s) {
224 0           $s =~ s/[^\d,-]//g;
225 0           $s =~ s/,/./;
226 0           return $s;
227             }
228             else {
229 0           return '';
230             }
231             }
232              
233             1;
234              
235             =head1 NAME
236              
237             Finance::Quote::HU - Obtain Hungarian Securities from www.bet.hu
238             and www.bamosz.hu
239              
240             =head1 SYNOPSIS
241              
242             use Finance::Quote;
243             $q = Finance::Quote->new;
244             # Don't know anything about failover yet...
245              
246             =head1 DESCRIPTION
247              
248             This module obtains information about Hungarian Securities. Share fetched from
249             www.bet.hu, while mutual funds retrieved from www.bamosz.hu. Stocks are
250             searched by ticker while mutual funds may only searched by ISIN.
251              
252             =head1 LABELS RETURNED
253              
254             Information available may include the following labels:
255              
256             method source name symbol currency date last price low high open close
257             p_change
258              
259             =head1 SEE ALSO
260              
261             Budapest Stock Exchange (BET) website - http://www.bet.hu
262             BAMOSZ website - http://www.bamosz.hu/
263              
264             Finance::Quote
265              
266             =cut