summaryrefslogtreecommitdiff
path: root/lib/Multi/DLsite.pm
blob: a329d2b7a61814cc5bdd776ff60d968342e97b90 (plain)
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
package Multi::DLsite;

use strict;
use warnings;
use utf8;
use Encode 'decode_utf8';
use Multi::Core;
use AnyEvent::HTTP;
use VNDB::Config;


my %C = (
  url => 'https://www.dlsite.com/%s/work/=/product_id/%s.html',
  clean_timeout => 48*3600,
  check_timeout => 5*60,
);


sub run {
  shift;
  $C{ua} = sprintf 'VNDB.org Affiliate Crawler (Multi v%s; contact@vndb.org)', config->{version};
  %C = (%C, @_);

  push_watcher schedule 0, $C{clean_timeout}, sub {
    pg_cmd q{DELETE FROM shop_dlsite WHERE id NOT IN(
        SELECT l_dlsite FROM releases WHERE NOT hidden
      UNION ALL
        SELECT l_dlsiteen FROM releases WHERE NOT hidden)};
  };
  push_watcher schedule 0, $C{check_timeout}, sub {
    pg_cmd q{
      INSERT INTO shop_dlsite (id)
      SELECT DISTINCT l_dlsite
        FROM releases
       WHERE NOT hidden AND l_dlsite <> ''
         AND NOT EXISTS(SELECT 1 FROM shop_dlsite WHERE id = l_dlsite)
    }, [], sub {
      pg_cmd q{
        INSERT INTO shop_dlsite (id)
        SELECT DISTINCT l_dlsiteen
          FROM releases
         WHERE NOT hidden AND l_dlsiteen <> ''
           AND NOT EXISTS(SELECT 1 FROM shop_dlsite WHERE id = l_dlsiteen)
      }, [], \&sync
    }
  }
}


sub data {
  my($shop, $time, $id, $body, $hdr) = @_;
  my $prefix = sprintf '[%.1fs] %s', $time, $id;
  #use Data::Dumper 'Dumper'; AE::log warn => Dumper $hdr, $body; exit;
  return AE::log warn => "$prefix ERROR: $hdr->{Status} $hdr->{Reason}" if $hdr->{Status} !~ /^2/ && $hdr->{Status} ne '404';

  $body = decode_utf8($body);
  my $found = $hdr->{Status} ne '404' && $body =~ /"id":"\Q$id\E",/;

  my $price =
    $body =~ m{<div class="work_buy_content"><span class="price">([0-9,]+)<i>円</i></span></div>} ? sprintf('JP¥ %d', $1 =~ s/,//gr) :
    $body =~ m{<i class="work_jpy">([0-9,]+) JPY</i></span>} ? sprintf('JP¥ %d', $1 =~ s/,//gr) : '';

  $shop = $body =~ /,"category":"([^"]+)"/ ? $1 : '';
  $shop = 'ecchi-eng' if $shop eq 'ecchieng'; # Both work, but DLsite seems to prefer a dash.

  return AE::log warn => "$prefix Product found, but no price ($price) or shop ($shop)" if $found && (!$price || !$shop);

  # We have a price? Update database.
  if($price && $shop) {
    pg_cmd q{UPDATE shop_dlsite SET found = TRUE, shop = $2, price = $3, lastfetch = NOW() WHERE id = $1}, [ $id, $shop, $price ];
    AE::log debug => "$prefix for $price at /$shop/";

  # Nothing? Update DB
  } else {
    pg_cmd q{UPDATE shop_dlsite SET found = FALSE, lastfetch = NOW() WHERE id = $1}, [ $id ];
    AE::log info => "$prefix not found.";
  }
}


sub fetch {
  my($shop, $id) = @_;
  my $ts = AE::now;
  my $url = sprintf $C{url}, $shop, $id;
  http_get $url, headers => {'User-Agent' => $C{ua} }, timeout => 60,
    sub { data($shop, AE::now-$ts, $id, @_) };
}


sub sync {
  pg_cmd 'SELECT id, shop FROM shop_dlsite ORDER BY lastfetch ASC NULLS FIRST LIMIT 1', [], sub {
    my($res, $time) = @_;
    return if pg_expect $res, 1 or !$res->nRows;
    fetch 'home', $res->value(0,0);
  };
}