summaryrefslogtreecommitdiffhomepage
path: root/contrib/very-important-source-code
diff options
context:
space:
mode:
authorStanislaw Halik <sthalik@misaki.pl>2016-07-16 23:45:05 +0200
committerStanislaw Halik <sthalik@misaki.pl>2016-07-16 23:54:28 +0200
commit65951496288f8dcb7181be90af119bc5bee187ad (patch)
treef3ad68b50c88cb4e78de433f2619ae8640004dec /contrib/very-important-source-code
parent2ade169751dd1d6d1bc2c279633914f62ed4724f (diff)
contrib: update
Diffstat (limited to 'contrib/very-important-source-code')
-rw-r--r--contrib/very-important-source-code/make-csv.pl140
1 files changed, 82 insertions, 58 deletions
diff --git a/contrib/very-important-source-code/make-csv.pl b/contrib/very-important-source-code/make-csv.pl
index fcac9369..552edea7 100644
--- a/contrib/very-important-source-code/make-csv.pl
+++ b/contrib/very-important-source-code/make-csv.pl
@@ -3,70 +3,94 @@
use strict;
use List::Util qw'reduce';
-sub get_games_1 {
- my @games;
+use POSIX qw(locale_h);
+setlocale(LC_ALL, "C");
- open my $fd, "<", $ARGV[1] or die "open: $!";
- <$fd>;
+sub get_games_1
+{
+ my @games;
- while (defined(my $line = <$fd>)) {
- chomp $line;
- if ($line !~ /^(\d+)\s+"([^"]+)"(?:\s+\(([0-9A-F]{16})\))?$/) {
- warn "Broken line";
- next;
- }
- push @games, +{ id => $1, name => $2, key => defined $3 ? (sprintf "%04X", $1) . $3 . '00' : undef};
- }
+ open my $fd, "<", $ARGV[1] or die "open: $!";
+ <$fd>;
- [@games];
+ while (defined(my $line = <$fd>))
+ {
+ chomp $line;
+ if ($line !~ /^(\d+)\s+"([^"]+)"(?:\s+\(([0-9A-F]{16})\))?$/)
+ {
+ warn "Broken line";
+ next;
+ }
+ push @games, +{ id => $1, name => $2, key => defined $3 ? (sprintf "%04X", $1) . $3 . '00' : undef};
+ }
+
+ [@games];
}
-sub get_games_2 {
- open my $fd, "<", $ARGV[0] or die "open: $!";
- <$fd>;
- my @games;
- while (defined(my $line = <$fd>)) {
- chomp $line;
- my @line = split/;/, $line;
- if (@line != 8) {
- warn "Broken line";
- next;
- }
- my @cols = qw'no name proto since verified by id key';
- push @games, +{ map { $cols[$_] => $line[$_] } 0..$#cols };
- }
- [@games];
+sub get_games_2
+{
+ open my $fd, "<", $ARGV[0] or die "open: $!";
+ <$fd>;
+ my @games;
+ while (defined(my $line = <$fd>))
+ {
+ chomp $line;
+ my @line = split/;/, $line;
+ if (@line != 8)
+ {
+ warn "Broken line";
+ next;
+ }
+ my @cols = qw'no name proto since verified by id key';
+ push @games, +{ map { $cols[$_] => $line[$_] } 0..$#cols };
+ }
+ [@games];
}
-sub merge {
- my ($new_games, $old_games) = @_;
- my $no = (reduce { $a->{no} > $b->{no} ? $a : $b } +{id=>0}, @$old_games)->{no} + 1;
- my %game_hash = map { $_->{name} => $_ } @$old_games;
- my %ids = map { $_->{id} => 1 } @$old_games;
- for my $g (@$new_games) {
- if (!exists $game_hash{$g->{name}} && !exists $ids{$g->{id}}) {
- $game_hash{$g->{name}} = +{
- no => $no++,
- name => $g->{name},
- proto => 'FreeTrack20',
- since => (defined $g->{key} ? 'V170' : 'V160'),
- verified => '',
- by => '',
- id => $g->{id},
- key => $g->{key}
- };
- }
- }
- print "No;Game Name;Game protocol;Supported since;Verified;By;INTERNATIONAL_ID;FTN_ID\n";
- for (sort { $a->{name} cmp $b->{name} } values %game_hash) {
- my $g = {%$_};
- if (!defined $g->{key}) {
- $g->{key} = (sprintf "%04X", $g->{no}) . (join"", map { sprintf "%02X", int rand 256 } 0 .. 7) . '00';
- }
- my @cols = qw'no name proto since verified by id key';
- print join";", map { $g->{$_} } @cols;
- print "\n";
- }
+sub merge
+{
+ my ($new_games, $old_games) = @_;
+ my $no = (reduce { $a->{no} > $b->{no} ? $a : $b } +{id=>0}, @$old_games)->{no} + 1;
+ my %game_hash = map { $_->{name} => $_ } @$old_games;
+ my %ids = map { $_->{id} => 1 } @$old_games;
+ for my $g (@$new_games)
+ {
+ if (!exists $ids{$g->{id}} || defined $g->{key})
+ {
+ $game_hash{$g->{name}} =
+ +{
+ no => $no++,
+ name => $g->{name},
+ proto => 'FreeTrack20',
+ since => (defined $g->{key} ? 'V170' : 'V160'),
+ verified => '',
+ by => '',
+ id => $g->{id},
+ key => $g->{key}
+ };
+ }
+ }
+ print "No;Game Name;Game protocol;Supported since;Verified;By;INTERNATIONAL_ID;FTN_ID\n";
+ for (sort { $a->{name} cmp $b->{name} } values %game_hash)
+ {
+ my $g = {%$_};
+ if (!defined $g->{key})
+ {
+ $g->{key} = (sprintf "%04X", $g->{no}) . (join"", map { sprintf "%02X", int rand 256 } 0 .. 7) . '00';
+ }
+ my @cols = qw'no name proto since verified by id key';
+ print join";", map { $g->{$_} } @cols;
+ print "\n";
+ }
}
-merge(get_games_1(), get_games_2());
+if (@ARGV != 2)
+{
+ warn "usage: $0 orig.csv dump.txt\n";
+ exit 1;
+}
+else
+{
+ merge(get_games_1(), get_games_2());
+ exit 0;
+}