UPD: Внимание! Последняя самая актуальная и полная версия руководства по GnuCash на русском языке в различных форматах доступна по адресу
http://kilork.org/gnucash.html.
Для разнообразия решил писать этот пост в emacs. Несколько странно, поскольку делаю это уже где-то в 4-й раз, привыкаю к emacs, потом начинаешь пользоваться "классическим редактором", и emacs забывается. А зря. На eee есть правда существенный недостаток - справа нет ctrl, что делает пользование несколько осложненным. В четвертый раз вместо забоя пользуюсь backspace, что свидетельствует о наличии застарелых рудиментарных атавизмов, а ведь одна из главных идей emacs - отказ от лишних и утомительных движений, а тянуться к backspace между прочим очень утомительно. Все, хватит о emacs, вернемся к нашим баранчикам.
Чтобы сделать что-то полезное, зайдем на сайт Сбербанка на страничку с котировками ОМС. Текст странички сохраняем на диск. Файл с котировками в формате xls аналогично. Начнем разбираться с последним. Для работы с excel файлами используется модуль Spreadsheet::Read. Все тонкости работы с excel нам не нужны, достаточно с первой странички получить значение из ячейки с известным адресом. Делается это следующим образом:
#!/usr/bin/perl
use Spreadsheet::Read;
my $xls = ReadData("dm1002.xls");
print "$xls->[1]{'A1'}\n";
Этот код выведет первую ячейку, с первой страницы.
Нам надо существенно больше. Найти котировки счетов и вытащить цену покупки/продажи. Но простота обращения с модулем облегчит нам задачу. Теперь надо разобраться со страничкой. Если взглянуть на реализации других модулей для Finance::Quote, то можно понять, что люди предпочитают HTML::TableExtract. Нам же только вытащить ссылку с первой строчкой, так что сойдут и более простые методы. Котировки в Сбербанке идут по месяцам. Страница для января 2009 года это:
http://sbrf.ru/ru/valkprev/archive_1/index.php?year114=2009&month114=01
Получаемая страница содержит котировки с датами, идут они в обратном порядке. Пример HTML кода с котировками:
<li class="xls"><a href="/common/img/uploaded/c_list/sdmet/download/2009/01/dm0131.xls" target="_blank">31 января 2009 года</a><!-- --> (с 00 часов 00 мин.)</li>
Для отбора нам понадобится регулярное выражение. Наверно это самый сложный для понимания кусок, но к счастью, писать регулярные выражения существенно проще, чем читать. Итак, на основе предыдущего текста:
<li class="xls"><a href="(.*\/(\d{4})\/(\d{2})\/dm(\d{2})(\d{2})(?:\_\d+)?\.xls)"[^\(]*\(.+(\d{2}).+(\d{2})
Еще один кусок кода. Пора объединить все это в единое целое. В модуле Finance::Quote::Sberbank находим метод sberbank. Сейчас он имеет следующий вид:
sub sberbank {
my $quoter = shift;
my @stocks = @_;
}
Для получения текста страничек нам понадобится user agent. К счастью, он есть у нас, итак, первая строка:
my $ua = $quoter->user_agent;
Теперь можно и запросить страничку.
my $year = 2009;
my $mon = 1;
my $url = "http://sbrf.ru/ru/valkprev/archive_1/index.php?year114=${year}&month114=${mon}";
my $response = $ua->request(GET $url);
Важно стараться сделать какую-никакую, но обработку ошибок, в случае с запросом странички, стоит проверить успешность операции. А если неуспешно, нам надо правильно выставить статусы ошибок. Статусы ошибок записываются в @stocks следующим образом:
unless ($response->is_success) {
foreach my $stock (@stocks) {
$info{$stock, "success"} = 0;
$info{$stock, "errormsg"} = "HTTP failure";
}
return wantarray() ? %info : \%info;
}
Т.е. для каждого запрашиваемого инструмента ставим статус success = 0 и errormsg = HTTP failure. Какая-то обработка ошибок. Теперь надо разобрать содержимое на предмет интересующих нас ссылок:
my $link = "";
my $content = $response->content;
if($content =~ /<li class="xls"><a href="(.*\/(\d{4})\/(\d{2})\/dm(\d{2})(\d{2})(?:\_\d+)?\.xls)"[^\(]*\(.+(\d{2}).+(\d{2})/g) {
$link = $1;
}
Получили ссылку на файлик xls, теперь надо бы его получить, и наконец уже зачитать наши котировки. Единственное, надо бы определиться как мы их назовем. Например, вот так:
Золото SBRF.AU
Серебро SBRF.AG
Платина SBRF.PT
Палладий SBRF.PD
Итак, ссылка найдена, и мы получаем котировки:
if($link) {
$url = "http://sbrf.ru/".$link;
$response = $ua->request(GET $url);
unless($response->is_success) {
foreach my $stock (@stocks) {
$info{$stock, "success"} = 0;
$info{$stock, "errormsg"} = "HTTP failure";
}
return wantarray() ? %info : \%info;
}
$content = $response->content;
Загружаем его как xls-файл:
my $xls = ReadData($content);
Теперь нам надо найти начало котировок ОМС. Это место начинается со строки, определяемой следующим регулярным выражением:
/\d+\. Котировки продажи и покупки драгоценных металлов в обезличенном виде/
Пробегаем примитивным поиском:
my $start = 1;
while($xls->[1]{"A$start"} !~ /\d+\. Котировки продажи и покупки драгоценных металлов в обезличенном виде/ && $start < 100) {
$start++;
}
Определим хэш значений для поиска, в соответствии с определенными выше кодами для различных ОМС:
my %map = (
'Золото' => 'SBRF.AU',
'Серебро' => 'SBRF.AG',
'Платина' => 'SBRF.PT',
'Палладий' => 'SBRF.PD'
);
Начиная с этого момента нам осталось только пробежать по оставшимся строкам в файле, найти наши котировки и заполнить соответствующие части в info:
while($xls->[1]{"A$start"}) {
$start++;
my $name = $xls->[1]{"A$start"};
if($name) {
my $stock = $map{$name};
next unless($stock);
$info{$stock, "symbol"} = $stock;
$info{$stock, "name"} = $name;
$info{$stock, "currency"} = "RUB";
$info{$stock, "method"} = "sberbank";
$info{$stock, "bid"} = $xls->[1]{"E$start"};
$info{$stock, "ask"} = $xls->[1]{"D$start"};
$info{$stock, "last"} = $info{$stock, "bid"};
$quoter->store_date(\%info, $stock, {today => 1});
$info{$stock, "success"} = 1;
}
}
Теперь осталось только сделать тесты. Здесь на помощь приходит модуль Test::More. Открываем t/Finance-Quote-Sberbank.t и пишем там такое:
use encoding 'utf8';
use Test::More;
plan tests => 5;
use_ok('Finance::Quote');
use_ok('Finance::Quote::Sberbank');
my $quoter = Finance::Quote->new("Sberbank");
ok(defined $quoter, "created");
my %info = $quoter->fetch("sberbank", "SBRF.PD");
ok(%info, "fetched");
ok($info{"SBRF.PD", "name"}, "palladium");
Запускаем тесты в терминале и если все получилось, то видим следующее:
kilork@pantogan:~/Desktop/test/Finance-Quote-Sberbank$ make test
cp lib/Finance/Quote/Sberbank.pm blib/lib/Finance/Quote/Sberbank.pm
PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/Finance-Quote-Sberbank....ok
All tests successful.
Files=1, Tests=5, 1 wallclock secs ( 1.05 cusr + 0.06 csys = 1.11 CPU)
Это хорошо, теперь можно смело делать make install и запускать gnucash с загрузкой нашего свежего модуля:
kilork@pantogan:~/Desktop/test/Finance-Quote-Sberbank$ make install
Manifying blib/man3/Finance::Quote::Sberbank.3pm
Installing /home/kilork/perl/share/perl/5.8.8/Finance/Quote/Sberbank.pm
Installing /home/kilork/perl/man/man3/Finance::Quote::Sberbank.3pm
Writing /home/kilork/perl/lib/perl/5.8.8/auto/Finance/Quote/Sberbank/.packlist
Appending installation info to /home/kilork/perl/lib/perl/5.8.8/perllocal.pod
kilork@pantogan:~/Desktop/test/Finance-Quote-Sberbank$ FQ_LOAD_QUOTELET="-defaults Sberbank" gnucash
gnc.bin-Message: main: binreloc relocation support was disabled at configure time.
Found Finance::Quote version 1.15
Заходим в редактор цен, жмем "Получить котировки", убеждаемся, что все получилось:
Рис 5.1. Получение котировок новым модулем Sberbank.
В заключение, полный текст модуля и скриншот набора текста в emacs:
package Finance::Quote::Sberbank;
use 5.008008;
use strict;
use warnings;
use encoding 'utf8';
use HTTP::Request::Common;
use Spreadsheet::Read;
require Exporter;
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Finance::Quote::Sberbank ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.01';
# Preloaded methods go here.
sub methods { return ( sberbank => \&sberbank ); }
{
my @labels = qw/name last bid ask date isodate currency/;
sub labels { return ( sberbank => \@labels ); }
}
sub sberbank {
my $quoter = shift;
my @stocks = @_;
my %info;
my $ua = $quoter->user_agent;
my $year = 2009;
my $mon = 1;
my $url = "http://sbrf.ru/ru/valkprev/archive_1/index.php?year114=${year}&month114=${mon}";
my $response = $ua->request(GET $url);
unless ($response->is_success) {
foreach my $stock (@stocks) {
$info{$stock, "success"} = 0;
$info{$stock, "errormsg"} = "HTTP failure";
}
return wantarray() ? %info : \%info;
}
my $link = "";
my $content = $response->content;
if($content =~ /<li class="xls"><a href="(.*\/(\d{4})\/(\d{2})\/dm(\d{2})(\d{2})(?:\_\d+)?\.xls)"[^\(]*\(.+(\d{2}).+(\d{2})/g) {
$link = $1;
}
if($link) {
$url = "http://sbrf.ru/".$link;
$response = $ua->request(GET $url);
unless($response->is_success) {
foreach my $stock (@stocks) {
$info{$stock, "success"} = 0;
$info{$stock, "errormsg"} = "HTTP failure";
}
return wantarray() ? %info : \%info;
}
$content = $response->content;
my $xls = ReadData($content);
my $start = 1;
while($xls->[1]{"A$start"} !~ /\d+\. Котировки продажи и покупки драгоценных металлов в обезличенном виде/ && $start < 100) {
$start++;
}
my %map = (
'Золото' => 'SBRF.AU',
'Серебро' => 'SBRF.AG',
'Платина' => 'SBRF.PT',
'Палладий' => 'SBRF.PD'
);
while($xls->[1]{"A$start"}) {
$start++;
my $name = $xls->[1]{"A$start"};
if($name) {
my $stock = $map{$name};
next unless($stock);
$info{$stock, "symbol"} = $stock;
$info{$stock, "name"} = $name;
$info{$stock, "currency"} = "RUB";
$info{$stock, "method"} = "sberbank";
$info{$stock, "bid"} = $xls->[1]{"E$start"};
$info{$stock, "ask"} = $xls->[1]{"D$start"};
$info{$stock, "last"} = $info{$stock, "bid"};
$quoter->store_date(\%info, $stock, {today => 1});
$info{$stock, "success"} = 1;
}
}
}
return wantarray() ? %info : \%info;
}
1;
__END__
Рис 5.2. Набор этого поста в emacs.
Очередная часть могучего труда готова. Удачи и успехов в освоении gnucash!
