This repository has been archived by the owner on Apr 3, 2018. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 352
/
tgdb.pl
executable file
·99 lines (80 loc) · 2.18 KB
/
tgdb.pl
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
#!/usr/bin/perl
# Downloads boxarts from TheGameDB
# Usage: ./tgdb.pl path/to/file.dat
use v5.16.0;
use File::Basename;
use feature "switch";
use utf8;
use Data::Dumper;
use LWP::Simple;
use LWP::UserAgent;
use XML::Simple;
binmode(STDOUT, ":utf8");
sub slurp { local $/; open(my $fh, '<:utf8', shift); <$fh> }
my $dat = slurp $ARGV[0];
my $system = basename($ARGV[0]);
$system =~ s/\.dat//;
say $system;
mkdir "$system/Named_Boxarts", 0755;
my $hashes = slurp "hash.csv";
my @hashes = split "\n", $hashes;
my $ua = LWP::UserAgent->new;
$ua->agent('Mozilla/5.0');
while ($dat =~ /game \(\r\n(?<game>.*?)\r\n\)\r\n/smg) {
my %rom;
my $title;
for my $line (split "\r\n", $+{game}) {
$line =~ /(?<key>\w+)\s(?<value>.*)$/;
if ($+{key} eq "name")
{
$title = $+{value};
$title =~ s/"(?<title>.*)"/$1/;
}
elsif ($+{key} eq "rom")
{
my @rom;
my $romline = $+{value};
while ($romline =~ /(".+?")|(\w+)/g)
{
push @rom, $1 || $2;
}
%rom = @rom;
}
}
my $sha1 = lc %rom{sha1};
#if (($title cmp 'S') == -1) {
# next;
#}
say "sha1 ", $sha1;
my @res = grep { /^${sha1}(.*)$/ } @hashes;
my $res = @res[0];
my $gdbid = (split ",", $res)[1];
say $gdbid;
if ($gdbid and ! -e "$system/Named_Boxarts/$title.png"
and ! -e "$system/Named_Boxarts/$title.jpg")
{
my $txt = $ua->get("http://thegamesdb.net/api/GetGame.php?id=$gdbid")->content;
my $xml = XMLin($txt, ForceArray => [ 'boxart' ]);
for (@{ $$xml{Game}{Images}{boxart} })
{
say $$xml{baseImgUrl} . $$_{content} if $$_{side} eq "front";
if ($$_{side} eq "front") {
my $request = HTTP::Request->new( GET => $$xml{baseImgUrl} . $$_{content} );
my $response = $ua->request($request);
my $content = $response->content."\n";
open FILE, ">$system/Named_Boxarts/$title.jpg" or die "Can't create file: $!.\n";
binmode FILE;
if ($response->is_success){
print FILE $content;
say "File downloaded and saved!!!";
}
close FILE;
}
}
}
if (!$gdbid)
{
open TXT, ">>$system/Named_Boxarts/$title.txt" or die "Can't create file: $!.\n";
close TXT;
}
}