AoC day 18 (pt2), Perl (dc transpiler)

#!/usr/bin/perl

use strict;
use warnings;

print "0\n";
while (<>) {
    chomp;
    my @stack;

    # assuming only one digit numbers
    foreach my $tok (reverse split( / */ )) {
        if ($tok =~ m#[0-9]#) {
            print "$tok ";
        } elsif ($tok eq '(') {
            # parsing backwards, so ( is close, and ) is open
            while ((my $pop = pop @stack) ne ')') {
                print $pop;
            }
        } else {
            if ($tok eq '*') {
                # pop the higher order precidence +s from stack
                while (@stack && $stack[-1] eq '+') {
                    print pop( @stack );
                }
            }
            push( @stack, $tok );
        }
    }
    print reverse( @stack ), "+\n";
}
print "p\n";