HTML Tree Parsing in Perl

I finally converted my horrific HTML regex parsing:

if (
    $info =~ /
    Platform\sType<\/td>\n\s+<td><b>(.*?)<\/b>(.*?)<\/td>.*
    Codeset<\/td>\n\s+<td><b><i>(.*?)<\/i>.*
    Status<\/td>\n\s+<td>\n\s+<div(?:.*?)">(.*?)<\/div><br>.*
    Instance\sID<\/td>\n\s+<td>(.*?)<\/td>.*
    Instance\sName<\/td>\n\s+<td>(.*?)<\/td>.*
    Brand<\/td>\n\s+<td><span(?:.*?)">(.*?)<\/span>.*
    Date\sAdded<\/td>\n\s+<td>(.*?)<\/td>.*
    Date\sUsed<\/td>\n\s+<td>(.*?)<\/td>.*
    Date\sModified<\/td>\n\s+<td>(.*?)<\/td>.*
    Flavor\sid<\/td>\n\s+<td>(\d+)<\/td>.*
    Flavor\sname<\/td>\n\s+<td>(.*?)<\/td>.*
    Image\sgroup\sid<\/td>\n\s+<td>(.*?)<\/td>.*
    Image\sid<\/td>\n\s+<td>(.*?)<\/td>.*
    Image\sname<\/td>\n\s+<td>(.*?)<\/td>.*
    Customer\suid<\/td>\n\s+<td><input(?:.*?)value="(.*?)">.*
    Back\sreference<\/td>\n\s+<td><input(?:.*?)value="(.*?)">.*
    HG\sserver\sid<\/td>\n\s+<td><input(?:.*?)value="(.*?)">.*
    HG\sMigration\sState<\/td>\n\s+<td>(?:.*?)<option\sselected="selected">(.*?)<\/option>.*
    HG\sUsed<\/td>(?:.*?)selected="selected">(.*?)<\/option>.*
    HG\slast\smodified<\/td>(?:.*?)value="(.*?)">.*
    Box\sIP<\/td>\n\s+<td\sclass="ping"\sdata-ip="(.*?)">.*
    Box\sHostname<\/td>\n\s+<td>(.*?)\s\(<a.*
    Volumes<\/td>\n\s+<td\svalign="top">\n\s+(.*?)<\/td>.*
    Addons<\/td>\n\s+<td\svalign="top">\n\s+(.*?)<\/td>.*
    Main\sIP<\/td>\n\s+(?:.*?)data-ip="(.*?)"(?:.*?)inline-block">(.*?)<\/div>.*?
    <table\sclass="concise">(.*?)<\/table>
    /xsm
  )
{

To what I hope is the right way of doing things, however, I feel like there could be some improvements.

my $tree = HTML::TreeBuilder->new;
$tree->parse_file($file_name);
$tree->eof();
my $t = Text::ASCIITable->new({headingText => 'HAL Server Report'});
$t->setCols('Field', 'Result');
$t->alignCol({Result => 'left'});
my $table = $tree->look_down(_tag => 'table', class => 'grid');
foreach my $tr ( $tree->look_down(_tag => 'tr') ) {
    last if $tr->look_down(_tag => 'td', class => 'key', sub { $_[0]->as_text() eq 'Meta' });
    my @tmp;
    my $count = 0;
    foreach my $td ( $tr->look_down(_tag => 'td') ) {
        if ( $count < 2 ) {
            if ( $td->look_down(_tag => 'select') ) {
                    my $select = $td->look_down(_tag => 'option', sub { $_[0]->attr('selected') });
                    push @tmp, $select->as_text() if $select;
            } elsif ( $td->look_down(_tag => 'input') ) {
                    my $input = $td->look_down(_tag => 'input', sub { $_[0]->attr('value') });
                    push @tmp, $input->attr_get_i('value') if $input;
            } elsif ( $td->look_down(_tag => 'table', class => 'concise') ) {
                    my @ips;
                    foreach my $td2 ( $td->look_down(_tag => 'tr') ) {
                        my $ip = $td2->look_down(_tag => 'td', sub { $_[0]->attr('data-ip') });
                        push @ips, $ip->attr_get_i('data-ip') if $ip;
                    }
                    push @tmp, join ", ", @ips;
            } else {
                push @tmp, $td->as_trimmed_text();
            }
        }
        $count++;
    }
    if ( $tmp[0] =~ /^([a-zA-Z0-9]+)([ a-zA-Z0-9]+?)$/ ) {
        $t->addRow($tmp[0], $tmp[1]);
    }
}
print $t;