Add a script for parsing DDRFreak's song lists.

[ccbs] / parse / parse-ddrfreak-songlist.pl

diff --git a/parse/parse-ddrfreak-songlist.pl b/parse/parse-ddrfreak-songlist.pl
new file mode 100644 (file)
index 0000000..7c02865
--- /dev/null
+++ b/parse/parse-ddrfreak-songlist.pl
@@ -0,0 +1,105 @@
+#! /usr/bin/perl
+use strict;
+use warnings;
+
+my $machine = shift;
+die "Missing machine (first argument on the command line)" if (!defined($machine));
+
+# Parses songlist from ddrfreak.com
+
+print "begin;\n";
+
+while (<>) {
+       while (not m/<tr bgcolor=\#CFDCF8>/) {
+               $_ = <>;
+               last if not $_;
+       }
+       $_ = <>;
+       last if not $_;
+       next if /<td bgcolor=\#DFECF8>Beginner<\/td>/;
+       m/ <td \s* align=center> .*? <\/td> /x or die "Parse error, line 1";
+       $_ = <>;
+       m/ <td> (?: <font \s* color=.*?> )? (.*?) (?: <\/font> )? <\/td> /x or die "Parse error, line 2";
+
+       my $songname = $1;
+
+       $_ = <>;
+       m/ <td \s* align=center> (.*?) <\/td> \s*            # artist
+          <td \s* align=center \s* bgcolor=\#DFECF8>
+            (?: <a \s* href=" .*? "> ([0-9-] | 10) <\/a>)?  # beginner single
+          <\/td>
+        /x or die "Parse error, line 3";
+
+       my ($artist, $sb) = ($1, $2);
+
+       # single standard
+       $_ = <>;
+       m/ <td \s* align=center \s* bgcolor=\#CFDCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
+               or die "Parse error, line 4";
+       my $ss = $1;
+       
+       # single difficult
+       $_ = <>;
+       m/ <td \s* align=center \s* bgcolor=\#BFCCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
+               or die "Parse error, line 5";
+       my $sd = $1;
+
+       # single expert
+       $_ = <>;
+       m/ <td \s* align=center \s* bgcolor=\#AFBCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
+               or die "Parse error, line 6";
+       my $se = $1;
+
+       # single challenge 
+       $_ = <>;
+       m/ <td \s* align=center \s* bgcolor=\#9FACF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
+               or die "Parse error, line 7";
+       my $sc = $1;
+       
+       # double standard
+       $_ = <>;
+       m/ <td \s* align=center \s* bgcolor=\#CFDCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
+               or die "Parse error, line 8";
+       my $ds = $1;
+       
+       # double difficult
+       $_ = <>;
+       m/ <td \s* align=center \s* bgcolor=\#BFCCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
+               or die "Parse error, line 9";
+       my $dd = $1;
+
+       # double expert
+       $_ = <>;
+       m/ <td \s* align=center \s* bgcolor=\#AFBCF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
+               or die "Parse error, line 10";
+       my $de = $1;
+
+       # double challenge 
+       $_ = <>;
+       m/ <td \s* align=center \s* bgcolor=\#9FACF8> (?: <a \s* href=" .*? "> )? (\d*) ( ?: <\/a> )? <\/td> /x
+               or die "Parse error, line 11";
+       my $dc = $1;
+
+       # minimal SQL escaping
+       $songname =~ s/'/\\'/g;
+       $artist =~ s/'/\\'/g;
+
+       printf "INSERT INTO songs (title,artist,minbpm,maxbpm) VALUES ('%s','%s',0,0);\n",
+               $songname, $artist;
+       
+       for my $t (['single', 'beginner', $sb],
+                   ['single', 'standard', $ss],
+                   ['single', 'difficult', $sd],
+                   ['single', 'expert', $se],
+                   ['single', 'challenge', $sc],
+                   ['double', 'standard', $ds],
+                   ['double', 'difficult', $dd],
+                   ['double', 'expert', $de],
+                   ['double', 'challenge', $dc]) {
+               next if (!defined($t->[2]) || $t->[2] eq '');
+               printf "INSERT INTO songratings (song,machine,playmode,difficulty,feetrating) VALUES ((SELECT song FROM songs WHERE title='%s'),(SELECT machine FROM machines WHERE machinename='%s'),'%s','%s',%u);\n",
+                       $songname, $machine, $t->[0], $t->[1], $t->[2];
+       }
+}
+
+printf "commit;\n";