Goes to show that if you plug away the answer will come....

while (<PIL>) {
# print ;
    if (m/\ *object\ \{/) {
        @lines = $_ ;
        $objcount++ ;    
    } elsif (m/^\ *\}/) {
        &Parse_Obj(@lines) ; 
        # print "Found Match!\n" ;
    } else {
        push @lines, $_ ;
    }
}

sub Parse_Obj {

    $id = @_[3] ; $origin = @_[1] ; $dims = @_[2] ;

    $id =~ s/^.*?\"//g ; #remove up to first "
    $id =~ s/\".*\n$//g ; #remove everything from last "

    $origin =~ s/^.*?\{\ //g ; #remove up to first {
    $origin =~ s/\ \}.*\n$//g ; #remove from last }

    $dims =~ s/^.*?\{\ //g ; #remove up to first {
    $dims =~ s/\ \}.*\n$//g ; #remove from last }

    ( $originw, $originh ) = split / /, $origin ;
    ( $dimsw, $dimsh ) = split / /, $dims ;

#    print "$objcount : $id $originw $originh $dimsw $dimsh \n" ;

if (exists($object{$objcount})) {
    break
    } else {
$object{"$objcount$;id"} = $id ;
$object{"$objcount$;originw"} = $originw ;
$object{"$objcount$;originh"} = $originh ;
$object{"$objcount$;dimsw"} = $dimsw ;
$object{"$objcount$;dimsh"} = $dimsh ;
}
}

# print "join(" ", %object) \n" ;
    
for ($count < $objcount) {
print "$object{$count,id} $object{$count,originw} $object{$count,origi
+nh} \n" ;
}
[download]

Thanks for everybody's help. ~Das Ham Man

Now your basic problem is that you need to recognize seeing "object" and then extract nested parens. But unfortunately for you you cannot possibly handle arbitrary nesting with an RE. However the following code works for me with the example data you gave:

use strict;
use Carp;

my @objects = get_objects("data");
print join "\n\n", @objects;


sub get_block {
  my $a_ref = shift;
  my $open = 0;
  my @read;
  while (my $line = shift @$a_ref) {
    push @read, $line;
    $open += () = ($line =~ /\{/g);
    $open -= () = ($line =~ /\}/g);
    if (0 == $open) {
      return join '', @read;
    }
    elsif (0 > $open) {
      my $not_block = join '', @read;
      warn("Too many closing parentheses in:\n$not_block\n\n");
      unshift @$a_ref, @read;
      return;
    }
  }
  confess "Unclosed brace at end of file\n";
}

# Takes a filename, returns the contents.
sub get_file {
  my $file = shift;
  local *IN;
  open (IN, "< $file") or confess "Cannot read '$file': $!";
  if (wantarray) {
    return <IN>;
  }
  else {
    return join '', <IN>;
  }
}

# Takes the name of a pil-file and returns an array of object blocks.
# Not particularly robust.
sub get_objects {
  my @objs;

  my @lines = get_file(shift);
  while (my $line = shift @lines) {
    if ($line =~ /object\s*\{/) {
      # Found a block?
      unshift @lines, $line;
      push @objs, get_block(\@lines);
    }
  }

  return @objs;
}
[download]

If you have the energy to learn Parse::RecDescent and figure out a real grammar, it will be much much better than a hack like the above...

use strict; 

my %object;

open IN, '<'.pop or die "can't open data: $!\n";

until(<IN> =~ /^object\s*\{/) {};   #skip ahead to the body of the fir
+st object{}

my($id, $origin, $dims);
while(<IN>) {
  SWITCH: {
    /id "(.+)"/                     &&   do { $id = $1;
                                              last SWITCH;
                                            };
    /origin \{ (\d+) (\d+) \}/      &&   do { $origin = "$1,$2";
                                              last SWITCH;
                                            };
    /dimensions \{ (\d+) (\d+) \}/  &&   do { $dims = "$1,$2";
                                              last SWITCH;
                                            };
    (/^object\s*\{/ || eof(IN))     &&   do { $object{$id}{'origin'} =
+ $origin;
                                              $object{$id}{'dims'}   =
+ $dims; 
                                            };
    # default: on to the next line

  }#SWITCH
}

foreach my $id (keys %object) {
    print "$id: ";
    foreach my $attr (keys %{$object{$id}} ) {
        print "$attr = $object{$id}{$attr} ";
    }
    print "\n";
}
[download]

DAILY.evo: origin = 0,0 dims = 9360,130
1400.cm1: origin = 0,130 dims = 900,1
[download]

--
I'd like to be able to assign to an luser

In case anyone wants to know what it would look like, a Parse::RecDescent parser would be something like this:

#!/usr/bin/perl -w

use strict;

use Parse::RecDescent;

sub Parse::RecDescent::dispatch {
    my $self = shift();
    my ($key, $value) = @_;

    print "$key: ";
    if ( ref($value) eq 'ARRAY' ) { print join(", ", @$value); }
    else { print $value; }

    print "\n";
}

my $parser = new Parse::RecDescent << '__GRAMMAR__';
    Pil:        Title '{' NameTable Canvas Object(s) '}' /\Z/

    Title:      /^pageoutput-[^;]+;/

        # the name-table
    NameTable:  'name-table' '{' NTLine(s) '}'
    NTLine:     FileName FileType 'unix-filename' FileName
    FileName:   '"' /[^"]+/ '"'
    FileType:   'atex-itf' | 'eps'

        # the canvas
    Canvas:     'canvas' '{' Data '}'
                { print "============================= CANVAS\n"; }

        # the objects
    Object:     'object' '{' Data '}'
                { print "============================= OBJECT\n"; }

    Data:       KeyValue(s)

    KeyValue:   Key Value
                { $thisparser->dispatch( $item[1], $item[2] ); }

    Key:        /^\S+/

    Value:      '"' /[^"]+/ '"'     { $item[2]; }   |
                Number                              |
                '{' Array '}'       { $item[2]; }

    Array:      Number(s) |
                KeyValue(s)

    Number:     /\d+/

__GRAMMAR__


undef $/;
$parser->Pil(<STDIN>);
[download]

This is incomplete. What is left to do is to associate the various key/value pairs with their respective owners (either a 'canvas' or 'object'). If you try it out, note that an object's key/value pairs are printed before that object.