#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use LWP::Simple;

my $file=shift;

my $data='';

if($file=~m!^http://!)
{ $data=get($file); }
elsif(-f $file)
{ $data=eval{local($/,@ARGV)=(undef,$file); <>}; }
elsif($file eq '-')
{
  local $/=undef;
  $data=<STDIN>;
}
else
{ $data=$file; }

print Dumper(parse($data));

########################################################################

sub parse
{
  # Liste mit allen Single-Tags
  my @single=qw( br hr );
  # Abschuss-Tag erzwingen
  my %optional=( li=>[qw(ul ol)] td=>[qw(tr th)]);

  my $data=shift || '';
  my $tree={name=>'root',childs=>[],opts=>{}};

  my @deep=({name=>'root',ref=>$tree});

  #Sind überhaupt html-tags enthalten?
  return undef if($data!~m!</?[\w\-_]+\s*(?:[\w\-_]+\s*=\s*(?:"[^"]*"|'[^']*'|[^<>]*)\s*)*\s*?/?>!s);

  # alle Tags finden und bearbeiten
  while($data=~m#<(/?[A-Za-z0-9][\w\-_]+)\s*((?:[\w\-_]+\s*=\s*(?:"[^"]*"|'[^']*'|[^<>]*)\s*)*)\s*?(/?)>((?:<!--.*?-->|[^<>]*)*)#gcs)
  {
    my $name=lc($1);
    my $opts=$2;
    my $single=$3;
    my $text=$4;
    my $end=0;

    # Single-Tag erzwingen
    $single=1 if(grep{lc($_) eq lc($name)}@single);

    $text=~s/^\s*(.*?)\s*$/$1/gs;

    # es handelt sich um einen Abschluss-Tag
    if(substr($name,0,1) eq '/')
    {
      # / entfernen
      substr($name,0,1,'');
      # Schon letzter end-tag
      last unless(@deep>1);
      # Passenden Abschluss-Tag finden
      while(my $p=shift(@deep))
      { last if($p->{name} eq $name); }
      # keinen passenden gefunden
      last unless(@deep);
      # Block als Singeltag verarbeiten
      $single=1;
      $end=1;
    }

    # Abschusstag erzwingen
    if(exists($optional{$name}) && @deep>0)
    {
      my $cnt=1;
      while($cnt<@deep)
      {
        last if(grep{$deep[-$cnt]->{name} eq $_}@{$optional{$name}});
        $cnt++;
      }
      $end=-$cnt;
    }

    # es ist kein Abschluss-Tag
    if($end<1)
    {
      # neuen Eintrag Erzeugen
      my $ref={name=>$name,childs=>[],opts=>{}};
      push(@{$deep[$end]->{ref}->{childs}},$ref);

      # wir haben keine Single-Tag
      unshift(@deep,{name=>$name,ref=>$ref}) if(!$single);

      # Optionen Parsen
      if($opts)
      {
        while($opts=~s!(\w+)\s*=\s*"([^"]*)"!!s)
        { $ref->{opts}->{$1}=$2; }
        while($opts=~s!(\w+)\s*=\s*'([^']*)'!!s)
        { $ref->{opts}->{$1}=$2; }
        while($opts=~s!(\w+)\s*=\s*(\S*)!!s)
        { $ref->{opts}->{$1}=$2; }
      }
    }

    push(@{$deep[0]->{ref}->{childs}}, $text) if($text);
  }

  return $tree;
}