From 65951496288f8dcb7181be90af119bc5bee187ad Mon Sep 17 00:00:00 2001 From: Stanislaw Halik Date: Sat, 16 Jul 2016 23:45:05 +0200 Subject: contrib: update --- contrib/very-important-source-code/make-csv.pl | 140 +++++++++++++++---------- 1 file changed, 82 insertions(+), 58 deletions(-) (limited to 'contrib/very-important-source-code/make-csv.pl') 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; +} -- cgit v1.2.3