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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
package Multi::PlayAsia;
use strict;
use warnings;
use Multi::Core;
use AnyEvent::HTTP;
my %C = (
api => '',
gtin_timeout => 1*60,
info_timeout => 3*60,
sync_gtin_timeout => 24*3600,
);
sub run {
shift;
$C{ua} = "VNDB.org Affiliate Crawler (Multi v$VNDB::S{version}; contact\@vndb.org)";
%C = (%C, @_);
push_watcher schedule 0, $C{sync_gtin_timeout}, \&sync_gtin;
push_watcher schedule 0, $C{gtin_timeout}, \&syncpax;
push_watcher schedule 0, $C{info_timeout}, \&syncinfo;
}
sub sync_gtin {
pg_cmd q{
INSERT INTO shop_playasia_gtin (gtin)
SELECT DISTINCT r.gtin
FROM releases r
WHERE r.gtin <> 0
AND NOT r.hidden
AND NOT EXISTS(SELECT 1 FROM shop_playasia_gtin spg WHERE spg.gtin = r.gtin)};
pg_cmd q{
DELETE FROM shop_playasia_gtin spg WHERE NOT EXISTS(
SELECT 1 FROM releases r WHERE r.gtin = spg.gtin AND NOT r.hidden)};
}
sub pa_expect {
my($body, $hdr, $prefix) = @_;
if($hdr->{Status} !~ /^2/) {
AE::log warn => "$prefix ERROR: $hdr->{Status} $hdr->{Reason}";
return 1;
}
my $errorstr = $body =~ s/<errorstring>\s*([^<]+)\s*<\/errorstring>// ? $1 : undef;
if($errorstr && !($body =~ /paxfrombarcode/ && $errorstr =~ /Unknown error/)) {
AE::log warn => "$prefix ERROR: $errorstr";
return 1;
}
return 0;
}
sub getpax {
my $bc = shift;
my $ts = AE::now;
http_get "$C{api}&query=paxfrombarcode&bc=$bc", headers => {'User-Agent' => $C{ua} }, timeout => 60,
sub {
my($body, $hdr) = @_;
my $time = AE::now-$ts;
my $prefix = sprintf '[%.1fs] paxfrombarcode[%s]', $time, $bc;
return if pa_expect $body, $hdr, $prefix;
my @pax;
push @pax, $1 while ($body =~ s/<pax>\s*([^<]+)\s*<\/pax>//);
AE::log debug => "$prefix Got new paxes: @pax";
pg_cmd 'UPDATE shop_playasia_gtin SET lastfetch = NOW() WHERE gtin = $1', [ $bc ];
pg_cmd 'INSERT INTO shop_playasia (pax, gtin) VALUES ($1, $2) ON CONFLICT DO NOTHING', [ $_, $bc ] for (@pax);
pg_cmd 'DELETE FROM shop_playasia WHERE gtin = $1', [ $bc ] if !@pax;
my $lst = join ',', map "\$$_", 2..(@pax+1);
pg_cmd "DELETE FROM shop_playasia WHERE gtin = \$1 AND pax NOT IN($lst)", [ $bc, @pax ] if @pax;
};
}
sub syncpax {
pg_cmd 'SELECT gtin FROM shop_playasia_gtin ORDER BY lastfetch ASC NULLS FIRST LIMIT 1', [],
sub {
my($res) = @_;
return if pg_expect $res, 1 or !$res->nRows;
getpax $res->value(0,0);
}
}
sub getinfo {
my $pax = shift;
my $ts = AE::now;
http_get "$C{api}&query=info&pax=$pax&mask=aps", headers => {'User-Agent' => $C{ua} }, timeout => 60,
sub {
my($body, $hdr) = @_;
my $time = AE::now-$ts;
my $prefix = sprintf '[%.1fs] info[%s]', $time, $pax;
return if pa_expect $body, $hdr, $prefix;
my $url = $body =~ /<affiliate_url>\s*([^<]+)\s*<\/affiliate_url>/ ? $1 : '';
my $onsale = $body =~ /<on_sale>\s*yes/ ? 't' : 'f';
my $price = $url && $onsale eq 't'
&& $body =~ /<price>\s*(\d+(?:\.\d+)?)\s*<\/price>/ && $1 ? sprintf('US$ %.2f', $1) : '';
AE::log debug => "$prefix got price='$price' onsale=$onsale url=$url";
pg_cmd
q{UPDATE shop_playasia SET url = $2, price = $3, lastfetch = NOW() WHERE pax = $1},
[ $pax, $url, $price ];
};
}
sub syncinfo {
pg_cmd 'SELECT pax FROM shop_playasia ORDER BY lastfetch ASC NULLS FIRST LIMIT 1', [],
sub {
my $res = shift;
return if pg_expect $res, 1 or !$res->nRows;
getinfo $res->value(0,0);
};
}
1;
|
