DDR Europe tournament parser now by default sets all players to Norway. Syntax fixes...
[ccbs] / parse / parse-ddrfreak-songlist.pl
1 #! /usr/bin/perl
2 use strict;
3 use warnings;
4
5 my $machine = shift;
6 die "Missing machine (first argument on the command line)" if (!defined($machine));
7
8 # Parses songlist from ddrfreak.com
9
10 print "begin;\n";
11
12 while (<>) {
13         while (not m/<tr bgcolor=\#CFDCF8>/) {
14                 $_ = <>;
15                 last if not $_;
16         }
17         $_ = <>;
18         last if not $_;
19         next if /<td bgcolor=\#DFECF8>Beginner<\/td>/;
20         m/ <td \s* align=center> .*? <\/td> /x or die "Parse error, line 1";
21         $_ = <>;
22         m/ <td> (?: <font \s* color=.*?> )? (.*?) (?: <\/font> )? <\/td> /x or die "Parse error, line 2";
23
24         my $songname = $1;
25
26         $_ = <>;
27         m/ <td \s* align=center> (.*?) <\/td> \s*            # artist
28            <td \s* align=center \s* bgcolor=\#DFECF8>
29              (?: <a \s* href=" .*? "> ([0-9-] | 10) <\/a>)?  # beginner single
30            <\/td>
31          /x or die "Parse error, line 3";
32
33         my ($artist, $sb) = ($1, $2);
34
35         # single standard
36         $_ = <>;
37         m/ <td \s* align=center \s* bgcolor=\#CFDCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
38                 or die "Parse error, line 4";
39         my $ss = $1;
40         
41         # single difficult
42         $_ = <>;
43         m/ <td \s* align=center \s* bgcolor=\#BFCCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
44                 or die "Parse error, line 5";
45         my $sd = $1;
46
47         # single expert
48         $_ = <>;
49         m/ <td \s* align=center \s* bgcolor=\#AFBCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
50                 or die "Parse error, line 6";
51         my $se = $1;
52
53         # single challenge 
54         $_ = <>;
55         m/ <td \s* align=center \s* bgcolor=\#9FACF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
56                 or die "Parse error, line 7";
57         my $sc = $1;
58         
59         # double standard
60         $_ = <>;
61         m/ <td \s* align=center \s* bgcolor=\#CFDCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
62                 or die "Parse error, line 8";
63         my $ds = $1;
64         
65         # double difficult
66         $_ = <>;
67         m/ <td \s* align=center \s* bgcolor=\#BFCCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
68                 or die "Parse error, line 9";
69         my $dd = $1;
70
71         # double expert
72         $_ = <>;
73         m/ <td \s* align=center \s* bgcolor=\#AFBCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
74                 or die "Parse error, line 10";
75         my $de = $1;
76
77         # double challenge 
78         $_ = <>;
79         m/ <td \s* align=center \s* bgcolor=\#9FACF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
80                 or die "Parse error, line 11";
81         my $dc = $1;
82
83         # Blarg, hack
84         if ($songname eq 'FANTASY') {
85                 $songname = "$songname ($artist)";
86         }
87
88         # Some HTML -> UTF-8 stuff
89         $songname =~ s/&hearts;/\xe2\x9d\xa4/g;
90         $songname =~ s/&forall;/\xe2\x88\x80/g;
91         $songname =~ s/CANDY&#9733;/CANDY\xe2\x98\x86/g;  # white star, not black
92         $songname =~ s/&#9733;/\xe2\x98\x85/g;
93         $songname =~ s/&#233;/\xc3\xa9/g;
94         $songname =~ s/<sup>2<\/sup>/\xc2\xb2/g;
95
96         # minimal SQL escaping
97         $songname =~ s/'/\\'/g;
98         $artist =~ s/'/\\'/g;
99
100         # Insert the song only if it doesn't already exist
101         printf "INSERT INTO songs SELECT nextval('songs_song_seq') AS song, '%s' AS title, '%s' AS artist, 0 AS minbpm, 0 AS maxbpm WHERE LOWER('%s') NOT IN ( SELECT LOWER(title) FROM songs );\n",
102                 $songname, $artist, $songname;
103         printf "INSERT INTO machinesongs SELECT ( SELECT song FROM songs WHERE LOWER(title)=LOWER('%s') ), ( SELECT machine FROM machines WHERE machinename='%s' );\n",
104                 $songname, $machine;
105         
106         for my $t (['single', 'beginner', $sb],
107                    ['single', 'standard', $ss],
108                    ['single', 'difficult', $sd],
109                    ['single', 'expert', $se],
110                    ['single', 'challenge', $sc],
111                    ['double', 'standard', $ds],
112                    ['double', 'difficult', $dd],
113                    ['double', 'expert', $de],
114                    ['double', 'challenge', $dc]) {
115                 next if (!defined($t->[2]) || $t->[2] eq '');
116                 printf "INSERT INTO songratings (song,machine,playmode,difficulty,feetrating) VALUES ((SELECT song FROM songs WHERE LOWER(title)=LOWER('%s')),(SELECT machine FROM machines WHERE machinename='%s'),'%s','%s',%u);\n",
117                         $songname, $machine, $t->[0], $t->[1], $t->[2];
118         }
119 }
120
121 printf "commit;\n";