diff options
Diffstat (limited to 'contrib/very-important-source-code/make-csv.pl')
| -rw-r--r-- | contrib/very-important-source-code/make-csv.pl | 105 | 
1 files changed, 0 insertions, 105 deletions
| diff --git a/contrib/very-important-source-code/make-csv.pl b/contrib/very-important-source-code/make-csv.pl deleted file mode 100644 index 5dc265f8..00000000 --- a/contrib/very-important-source-code/make-csv.pl +++ /dev/null @@ -1,105 +0,0 @@ -#!/usr/bin/env perl - -use strict; -use List::Util qw'reduce'; - -use POSIX qw(locale_h); -setlocale(LC_ALL, "C"); - -sub get_games_1 -{ -    my @games; - -    open my $fd, "<", $ARGV[1] or die "open: $!"; -    binmode $fd; -    <$fd>; - -    while (defined(my $line = <$fd>)) -    { -        $line =~ s/[\r\n]+$//s; -        if ($line !~ /^(\d+)\s+"([^;"]+)"(?:\s+\(([0-9A-F]{16})\))?$/) -        { -            warn "Broken line"; -            next; -        } -        next if $1 <= 0; -        push @games, +{ id => $1, name => $2, key => $3 } -    } -    [sort { lc($a->{name}) cmp lc($b->{name}) } @games] -} - -sub get_games_2 -{ -    open my $fd, "<", $ARGV[0] or die "open: $!"; -    binmode $fd; -    <$fd>; -    my @games; -    my %ids; -    while (defined(my $line = <$fd>)) -    { -        $line =~ s/[\r\n]+$//s; -        my @line = split/;/, $line; -        if (@line != 8) -        { -            warn "Broken line"; -            next; -        } -        my @cols = qw'no name proto since verified by id key'; -        my $h = +{ map { $cols[$_] => $line[$_] } 0..$#cols }; -        next if exists $ids{$h->{id}}; -        $ids{$h->{id}} = undef; -        next if $h->{id} <= 0; -        push @games, $h; -    } -    [@games]; -} - -sub merge -{ -    my ($new_games, $old_games) = @_; -    my $no = (reduce { $a->{no} > $b->{no} ? $a : $b } +{id=>0}, @$old_games)->{no} + 1; -    my %ids = map { $_->{id} => $_ } @$old_games; -    binmode \*STDOUT; -    for my $g (@$new_games) -    { -        my $id = $g->{id}; -        my $no_ = $ids{$id} ? $ids{$id}->{no} : $no; -        next if (exists($ids{$id}) && $ids{$id}->{verified} ne ''); -        my $old = $ids{$id} || do { $no++; +{} }; -        $ids{$id} = -            +{ -                no => $no_, -                name => $g->{name}, -                proto => 'FreeTrack20', -                verified => '', -                by => '', -                id => $g->{id}, -                %$old, -                since => $g->{key} ? 'V170' : 'V160', -                key => $g->{key} ? (sprintf "%04X", $no_) . $g->{key} . '00' : $old->{key} -            }; -    } -    print "No;Game Name;Game protocol;Supported since;Verified;By;INTERNATIONAL_ID;FTN_ID\n"; -    for (sort { $a->{no} <=> $b->{no} } values %ids) -    { -        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"; -    } -} - -if (@ARGV != 2) -{ -    warn "usage: $0 orig.csv dump.txt\n"; -    exit 1; -} -else -{ -    merge(get_games_1(), get_games_2()); -    exit 0; -} | 
