matroska.pl

#! /usr/bin/env perl

# Generate C definitions for parsing Matroska files.

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/lib";
use Parse::Matroska::Definitions;
use Parse::Matroska::Reader;

use Getopt::Long;
use List::Util qw{max};

my @global_elem_list = @Parse::Matroska::Definitions::global_elem_list;

Getopt::Long::Configure(qw{auto_version auto_help});
my %opt;
GetOptions(\%opt,
    "generate-header",
    "generate-definitions",
    "full",
    );

if ($opt{"generate-header"}) {
    generate_c_header();
} elsif ($opt{"generate-definitions"}) {
    generate_c_definitions();
} else {
    for (@ARGV) {
        my $reader = Parse::Matroska::Reader->new($_ eq '-' ? \*STDIN : $_) or die $!;
        while (my $elem = $reader->read_element($_ eq '-')) {
            process_elem($elem, $_ eq '-');
        }
    }
}

# Generate declarations for libmpdemux/ebml_types.h
sub generate_c_header {
    print "/* Generated by TOOLS/matroska.pl, do not edit manually */\n\n";

    # Write a #define for the ElementID of each known element
    for my $el (@global_elem_list) {
        printf "#define %-40s 0x%s\n", $el->{definename}, $el->{elid};
    }
    print "\n";

    # Define a struct for each ElementID that has child elements
    for my $el (@global_elem_list) {
        next unless $el->{subelements};
        print "\nstruct $el->{structname} {\n";

        # Figure out the length of the longest variable name
        # Used for pretty-printing in the next step
        my $l = max(map { length $_->{valname} } values %{$el->{subelements}});

        # Output each variable, with pointers for array (multiple) elements
        for my $subel (sort { $a->{definename} cmp $b->{definename} } values %{$el->{subelements}}) {
            printf "    %-${l}s %s%s;\n",
                $subel->{valname}, $subel->{multiple}?'*':' ', $subel->{fieldname};
        }
        print "\n";

        # Output a counter variable for each element
        # (presence/absence for scalars, item count for arrays)
        for my $subel (values %{$el->{subelements}}) {
            print "    int n_$subel->{fieldname};\n"
        }
        print "};\n";
    }
    print "\n";

    # Output extern references for ebml_elem_desc structs for each of the elements
    # These are defined by generate_c_definitions
    for my $el (@global_elem_list) {
        next unless $el->{subelements};
        print "extern const struct ebml_elem_desc $el->{structname}_desc;\n";
    }
    print "\n";

    # Output the max number of sub-elements a known element might have
    printf "#define MAX_EBML_SUBELEMENTS %d\n",
        max(map { scalar keys %{$_->{subelements}} }
            grep { $_->{subelements} } @global_elem_list);
}

# Generate definitions for libmpdemux/ebml_defs.c
sub generate_c_definitions {
    print "/* Generated by TOOLS/matroska.pl, do not edit manually */\n\n";
    # ebml_defs.c uses macros declared in ebml.c
    for my $el (@global_elem_list) {
        print "\n";
        if ($el->{subelements}) {
            # set N for the next macros
            print "#define N $el->{fieldname}\n";

            # define a struct ebml_$N_desc and gets ready to define fields
            # this secretly opens two scopes; hence the }}; at the end
            print "E_S(\"$el->{name}\", ".scalar(keys %{$el->{subelements}}).")\n";

            # define a field for each subelement
            # also does lots of macro magic, but doesn't open a scope
            for my $subel (sort { $a->{definename} cmp $b->{definename} } values %{$el->{subelements}}) {
                print "F($subel->{definename}, $subel->{fieldname}, ".
                    ($subel->{multiple}?'1':'0').")\n";
            }
            # close the struct
            print "}};\n";

            # unset N since we've used it
            print "#undef N\n";
        } else {
            print "E(\"$el->{name}\", $el->{fieldname}, $el->{ebmltype})\n";
        }
    }
}

sub repr {
    my @ret;
    foreach (@_) {
        if (/'/) {
            s/"/\\"/g;
            push @ret, "\"$_\"";
        } else {
            push @ret, "'$_'";
        }
    }
    return @ret if wantarray;
    return pop @ret if defined wantarray;
    return;
}

sub process_elem {
    my ($elem, $read_bin) = @_;
    unless ($opt{full}) {
        if ($elem->{name} eq 'Cluster' || $elem->{name} eq 'Cues') {
            $elem->skip;
            return;
        }
    }
    die unless $elem;

    if ($elem->{type} ne 'skip') {
        print "$elem->{depth} $elem->{elid} $elem->{name} size: $elem->{content_len} value: ";
    }

    if ($elem->{type} eq 'sub') {
        print "subelements:\n";
        while (my $chld = $elem->next_child($read_bin)) {
            process_elem($chld);
        }
    } elsif ($elem->{type} eq 'binary') {
        my $t = "<skipped $elem->{content_len} bytes>";
        if ($elem->{content_len} < 20) {
            $t = unpack "H*", $elem->get_value;
        }
        print "binary $t\n";
        delete $elem->{value};
    } elsif ($elem->{type} eq 'ebml_id') {
        print "binary $elem->{value}->{elid} (".($elem->{value}->{name}||"UNKNOWN").")\n";
    } elsif ($elem->{type} eq 'skip') {
        # skip
    } elsif ($elem->{type} eq 'str') {
        print "string ". repr($elem->get_value) . "\n";
    } else {
        print "$elem->{type} ". $elem->get_value ."\n";
    }
}