This script is broken in a number of ways. First off, it doesn't understand very much at all about the OBJ format, although it seems to know what to do with the OBJs anim8or emits. Second, it only knows how to triangulate quads, and triangulates those in what's probably a non-optimal way. Finally, it could use refactoring -- write_obj in particular is pretty ugly. Nevertheless, it does what I want, and it took about an hour to hack together.

#! /usr/bin/perl -w

use strict;
use Data::Dumper;

my %handlers = (
    'v'     => \&vert,
    'vn'    => \&norm,
    'vt'    => \&texc,
    'f'     => \&face,
);

=head2 read_obj(filename)

Reads an OBJ file and returns it as an array of hashrefs.  Yeah, one d
+ay
this might be a class constructor.

    my @groups = &read_obj("foo.obj");

    my $group = shift @groups
    $group->{'name'};     -- Group name, from "g foobar\n"
    $group->{'verts'};    -- Array of vertices
    $group->{'norms'};    -- Array of vertex normals
    $group->{'texcs'};    -- Array of vertex texture coordinates
    $group->{'faces'};    -- Array of polygons

    my $vert = shift @{$group->{'verts'}};
    $vert->{'x'};       -- x coordinate of $vert.
    $vert->{'y'};       -- y coordinate of $vert.
    $vert->{'z'};       -- z coordinate of $vert.
=cut

sub vert
{
    my ($group, @args) = @_;

    my $vert = {
        'x' => $args[0],
        'y' => $args[1],
        'z' => $args[2],
    };

    push @{$group->{'verts'}}, $vert;
}

=pod
    my $norm = shift @{$group->{'norms'}};
    $norm->{'nx'};      -- x component of $norm.
    $norm->{'ny'};      -- y component of $norm.
    $norm->{'nz'};      -- z component of $norm.
=cut

sub norm
{
    my ($group, @args) = @_;

    my $norm = {
        'nx' => $args[0],
        'ny' => $args[1],
        'nz' => $args[2],
    };

    push @{$group->{'norms'}}, $norm;
}

=pod
    my $texc = shift @{$group->{'texcs'}};
    $texc->{'s'};       -- s coordinate of $texc.
    $texc->{'t'};       -- t coordinate of $texc.
=cut

sub texc
{
    my ($group, @args) = @_;

    my $texc = {
        's' => $args[0],
        't' => $args[1],
    };

    push @{$group->{'texcs'}}, $texc;
}

=pod
    # Eww!
    my $face = shift @{$group->{'faces'}};
    $face == [
        [v, t, n],      -- vert, texc, norm indices for vertex 1
        [v, t, n],      -- vert, texc, norm indices for vertex 2
        ...
        [v, t, n],      -- vert, texc, norm indices for vertex k
    ];
=cut

sub face
{
    my ($group, @args) = @_;

    my $verts = [];
    for (@args) {
        my @vert = split '/';
        push @$verts, \@vert;
    }
    push @{$group->{'faces'}}, $verts;
}


sub read_obj
{
    my ($file) = @_;

    open OBJ, '<', $file
        or die "Can't open $file: $!\n";

    my @groups  = ();
    my $group   = undef;

    while(<OBJ>) {
        next unless /\S/;
        my ($cmd, @args) = split;
 
        # handle groups separately; this is a Red Flag(tm)
        if($cmd eq 'g') {
            push @groups, $group if $group;
            $group = { 'name' => shift @args };
            next;
        }

        # otherwise, use the appropriate function
        my $handler = $handlers{$cmd};
        if(defined $handler) {
            $handler->($group, @args);
        } else {
            warn "Got odd command $cmd with args ",
                 join(' ', @args),
                 " in $file\n";
        }
    }
    push @groups, $group;

    close OBJ
        or die "Can't close $file: $!\n";
    return @groups;
}

sub triangulate_obj
{
    my ($groups) = @_;

    for my $group (@$groups) {
        my $old_faces = $group->{'faces'};
        $group->{'faces'} = [];

        for my $face (@$old_faces) {
            if (scalar @$face == 3) {
                push @{$group->{'faces'}}, $face;
            } elsif (scalar @$face == 4) {
                my $tri_1 = [$face->[0], $face->[1], $face->[2]];
                my $tri_2 = [$face->[0], $face->[2], $face->[3]];
                push @{$group->{'faces'}}, $tri_1, $tri_2;
            } else {
                warn "Don't know how to triangulate a general poly\n";
                push @{$group->{'faces'}}, $face;
            }
        }
    }
}

sub write_obj
{
    my ($file, @groups) = @_;

    open OBJ, '>', $file
        or die "Can't open $file: $!\n";

    print OBJ "# Generated by tri_obj\n\n";

    for my $group (@groups) {
        print OBJ "g ", $group->{'name'}, "\n";

        for my $v (@{$group->{'verts'}}) {
            printf OBJ "v %f %f %f\n", 
                $v->{'x'}, $v->{'y'}, $v->{'z'};
        }

        for my $vn (@{$group->{'norms'}}) {
            printf OBJ "vn %f %f %f\n", 
                $vn->{'nx'}, $vn->{'ny'}, $vn->{'nz'};
        }

        for my $vt (@{$group->{'texcs'}}) {
            printf OBJ "vt %f %f\n", $vt->{'s'}, $vt->{'t'};
        }

        for my $f (@{$group->{'faces'}}) {
            print OBJ "f ";
            for my $vs (@$f) {
                print Dumper $vs;
                print OBJ join('/', @$vs), ' ';
            }
            print OBJ "\n";
        }
    }

    close OBJ
        or die "Can't close $file: $!\n";
}

my @groups = &read_obj($ARGV[0]);
&triangulate_obj(\@groups);
&write_obj('new_'.$ARGV[0], @groups);
[download]