1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
#!/usr/bin/perl
##############################################################################
#
# Routines to get FRB money input
#
# This package needs to be installed
# # perl -MCPAN -e 'install HTML::TableExtract'
#
##############################################################################
use LWP::UserAgent;
use HTML::TableExtract;
sub frb {
#
# get the federal reserve bank web page
#
my $ua = LWP::UserAgent->new;
$ua->agent("MyApp/0.1 ");
my $hdrs = HTTP::Headers->new;
$hdrs->user_agent('Mozilla/4.78 [en] (X11; U; Linux 2.4.9-21 i686)');
my $url="http://app.ny.frb.org/dmm/mkt.cfm";
my $req = HTTP::Request->new("GET", $url, $hdrs);
my $rc = $ua->simple_request($req);
if (!$rc->is_success && !$rc->is_redirect) {
print $rc->content;
die "get request failed";
}
#
# Insert a couple of dummy headers (because TableExtract doesn't have
# an option to return the header columns, which contain the date).
#
my $page = $rc->content;
$page =~ s/(.*Temporary Open.*)/<td>Dummy1<\/td><td>Dummy2<\/td><\/tr><tr>\1/g;
#
# Combine table pairs together
#
$page =~ s/<\/table>[\s\r\n]*<table width=".5%" border="0" cellspace="0" bgcolor="acc0b5">//g;
#print $page;
# Should destroy $ua, $hdrs, $req here
#
# Extract table rows and columns
#
my $te = new HTML::TableExtract( headers => [qw(Dummy1 Dummy2)]);
$te->parse($page);
#
# Format the output
#
my $cnt = 0;
foreach my $ts ($te->table_states) {
my @rows = $ts->rows;
my $amt;
my $what;
my $date = @rows->[0]->[0];
$date =~ s/\n//g;
$date =~ s/^[^0-9]*([0-9]+\/[0-9]+\/[0-9]+).*$/\1/;
if (defined(@rows->[3]->[0])) {
$what = @rows->[3]->[0];
$what =~ s/\n//g;
$what =~ s/\r//g;
$what =~ s/.*:[ \t]+(.*)$/\1/;
$what =~ s/[ \t]+$//;
} else {
$what = "No Action";
}
if (defined(@rows->[12]->[1])) {
$amt = @rows->[12]->[1];
$amt =~ s/\n//g;
$amt =~ s/\r//g;
$amt =~ s/[ \t]+(.*)$/\1/;
$amt =~ s/[ \t]+$//;
} elsif (defined(@rows->[9]->[1])) {
$amt = @rows->[9]->[1];
$amt =~ s/\n//g;
$amt =~ s/\r//g;
$amt =~ s/[ \t]+(.*)$/\1/;
$amt =~ s/[ \t]+$//;
} else {
$amt = 0;
}
my $buf = sprintf("%s \$%.3fB %s\n", $date, $amt, $what);
print $buf;
# $self->privmsg($to, "$color$buf");
last if (++$cnt == 15);
}
# Should destroy $te here
}
&frb;
|
