Port several python scripts to Perl

file2string.pl and vdpau_functions.pl are direct ports.
matroska.py was reimplemented as the Parse::Matroska module in CPAN,
and matroska.pl was made a client of Parse::Matroska.
A copy of Parse::Matroska is included in TOOLS/lib, and matroska.pl
looks there first when trying to load the module.

osxbundle.py was not ported since I have no means to verify it.
Python is always available on OSX though, so there is no harm in
removing the check for it on configure.

1 files changed, 169 insertions, 0 deletions

diff --git a/TOOLS/matroska.pl b/TOOLS/matroska.pl
new file mode 100755
index 0000000000..3ab06df6f9
--- /dev/null
+++ b/TOOLS/matroska.pl
@@ -0,0 +1,169 @@
+#! /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 (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 (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";
+    }
+}
\ No newline at end of file