--- /dev/null
+#! /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";