#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::HTMLParser;

use strict;

# ----------------------------------------------------------------------------
# Function    : tokenize
# Description : parse html into tokens and return an array of hash refs.  Each
#               hash ref has two keys, content and type.  Type is either:
#               text, comment, tag, or entity.  Unknown entities are treated as
#               text.
#
#               This function does not account for enclosing tags like textarea
#               which include their content AFTER the tag.  The content will be
#               returned as a text token after the textarea html token.
#
#               Also, unicode entities (&#NNNN or &#xHHHH with values over 255)
#               are treated as text since we can't convert them to unicode on
#               the older versions of perl we need to support.
#
# Usage       : my $tokens = &tokenize($HTML);
#
# Reference   : HTML::Tagset, HTML::Entities, HTML::TokeParser,
#               perldoc perlop, perldoc perlre
# ----------------------------------------------------------------------------

sub tokenize {
  my $html = shift;
  my @tokens;

  # In scalar context, each execution of m//g finds the next match, returning
  # true if it matches, and false if there is no further match.  A failed match
  # normally resets the search position to the beginning of the string, but you
  # can avoid that by adding the /c modifier (e.g. m//gc).
  #
  # /c   Do not reset search position on a failed match when /g is in effect.
  # \G   Zero-width assertion that matches the exact position where the previous m//g, if any, left off.
  #      (This prevents your regexp from jumping further ahead to match something).
  # See m// under 'perldoc perlop' for more details

  my($lastToken, $lastType);
  while (1) {

    # Match next token
    my($tokenContent, $tokenType);

    if ($html =~ /\G([^<&]+)/gcs) {   # match text
      $tokenContent = $1;
      $tokenType    = 'text';
    }

    elsif ($html =~ /\G(<!--.*?-->)/gcs) {  # match comments
      $tokenContent = $1;
      $tokenType    = 'comment';
    }

    elsif ($html =~ /\G(<\/?[a-zA-Z]+(?:\'[^\']*\'|"[^"]*"|[^>]+?)*>)/gcs) {   # match tag
      $tokenContent = $1;
      $tokenType    = 'tag';
    }

    elsif ($html =~ /\G(<)/gcs) {   # match < as text (when tag didn't match)
      $tokenContent = $1;
      $tokenType    = 'text';
    }

    elsif ($html =~ /\G(&)/gcs) {   # match HTML entities
      $tokenContent = $1;
      my $isText    = 0;

      # Regexps & code from decode_entities_old in HTML::Entities 1.39 - Copyright 1995-2004 Gisle Aas.
      if    ($html =~ /\G(\#(\d+);?)/gcs) {              # numeric entity &#169; is ©
        $tokenContent .= $1;
        my $decimalValue = $2;
        if ($decimalValue > 255) { $isText = 1; }
      }
      elsif ($html =~ /\G(\#[xX]([0-9a-fA-F]+);?)/gcs) { # hexadecimal entity &#xA9; is ©
        $tokenContent .= $1;
        my $hexValue = $2;
        my $decimalValue = hex($hexValue);
        if ($decimalValue > 255) { $isText = 1; }
      }
      elsif ($html =~ /\G((\w+);?)/gcs) {                # named entity &#copy; is ©
        $tokenContent .= $1;
        my $entityName = $2;
        my $entity2char = &_entity2charHash();
        unless (exists $entity2char->{ $entityName }) { $isText = 1; }
      }
      else { $isText = 1; }

      $tokenType = ($isText) ? 'text' : 'entity';
    }

    elsif ($html =~ /\G\z/g) {        # Match end of string
      last;
    }
    else {
      die "Error matching next token after '$lastType': $lastToken\n";
    }

    # Add to token list
    push @tokens, {
      content => $tokenContent,
      type    => $tokenType
    };

    # save as lastToken/Type
    ($lastToken, $lastType) = ($tokenContent, $tokenType);
  }

  my $mergedTokens = &_mergeNeighboringTextTokens(\@tokens);

  return $mergedTokens;
}



# ----------------------------------------------------------------------------
# Function    : _mergeNeighboringTextTokens
# Description : merge text tokens that are beside each other in the token array
#               into single token
# Usage       : my $tokens = &_mergeNeighboringTextTokens($tokens);
# ----------------------------------------------------------------------------

sub _mergeNeighboringTextTokens {
  my $tokens = shift;

  my @joinedTokens;
  my $joinedIndex = 0;

  for my $index (0..$#$tokens) {
    my $token               = $tokens->[$index];
    my $lastTokenDefined    = $joinedTokens[$joinedIndex]->{'type'};
    my $sameTypeAsLastToken = ($token->{'type'} eq $joinedTokens[$joinedIndex]->{'type'});
    my $isTextToken         = $token->{'type'} eq 'text';

    my $canMergeWithLastToken = $lastTokenDefined && $isTextToken && $sameTypeAsLastToken;

    if (!$canMergeWithLastToken && $lastTokenDefined) { $joinedIndex++; }

    $joinedTokens[$joinedIndex]->{'content'} .= $token->{'content'};
    $joinedTokens[$joinedIndex]->{'type'}    = $token->{'type'};
  }

  return \@joinedTokens;

}

# ----------------------------------------------------------------------------
# Function    : convertTokensToHtmlString
# Description : convert tokens to html (or string)
# Usage       : $html = &convertTokensToHtmlString($tokens);
# ----------------------------------------------------------------------------

sub convertTokensToHtmlString {
  my $tokens = shift;
  my $html   = '';

  foreach my $token (@$tokens) {
    $html .= $token->{'content'};
  }

  return $html;
}

# ----------------------------------------------------------------------------
# Function    : convertTokensToTextOnlyString
# Description : convert tokens to text.  Removes tables entirely, tags, comments,
#               and converts entities to characters if possible.
# Usage       : $text = &convertTokensToTextOnlyString($tokens);
# ----------------------------------------------------------------------------

sub convertTokensToTextOnlyString {
  my $tokens   = shift;

  my $tokensWithoutTags = &removeTablesAndTagTokens($tokens);

  my $textOnlyString = '';

  # parse out text and convert entities
  foreach my $token (@$tokensWithoutTags) {
    if    ($token->{'type'} eq 'tag')     { next; }
    elsif ($token->{'type'} eq 'comment') { next; }
    elsif ($token->{'type'} eq 'text')    { $textOnlyString .= $token->{'content'}; }
    elsif ($token->{'type'} eq 'entity')  {
      my $char = &convertEntityToCharacter( $token->{'content'} );
      if (defined $char) { $textOnlyString .= $char; }
      else               { $textOnlyString .= $token->{'content'}; }  # if we can't convert entity to char than leave it intact.
    }
    else { die "unknown token type '$token->{'type'}'"; }
  }

  return $textOnlyString;
}

# ----------------------------------------------------------------------------
# Function    : convertTokensToMaxWordsString
# Description : return specified numbers of words as a string after removing
#               tables, table content, and tags.  Entities are left intact.
#               Splits on space chars, not on &nbsp;

# Usage       : my $maxWordsString = &convertTokensToMaxWordsString($tokens, $maxWords);
# ----------------------------------------------------------------------------

sub convertTokensToMaxWordsString {
  my $tokens   = shift;
  my $maxWords = shift;

  my $tokensWithoutTags = &removeTablesAndTagTokens($tokens);

  # parse out text and entities
  my $textAndEntities = '';
  foreach my $token (@$tokensWithoutTags) {
    if    ($token->{'type'} eq 'tag')     { die "tag found in text only tokens!"; }
    elsif ($token->{'type'} eq 'comment') { die "comment found in text only tokens!"; }
    elsif ($token->{'type'} eq 'text')    { $textAndEntities .= $token->{'content'}; }
    elsif ($token->{'type'} eq 'entity')  { $textAndEntities .= $token->{'content'}; }
    else                                  { die "unknown token type '$token->{'type'}'"; }
  }

  # split into words
  my @words;
  my $containsWords = $textAndEntities =~ /\S/s;
  if ($containsWords) {
    @words = $textAndEntities =~ m/(\s*\S+)/gs;
  }

  # get word tokens
  my $endIndex       = &IT::Common::mathMin( ($maxWords-1), $#words );
  my $maxWordsString = join '', @words[0..$endIndex];

  return $maxWordsString;
}

# ----------------------------------------------------------------------------
# Function    : returnTokensFromSelectedParagraphs
# Description : returns tokens from the specified paragraphs.  Paragraph numbers
#               start at 1.  Can take a range or a single paragraph number.  If
#               end if defined as '+' then all paragraphs to the end are returned.
#               Paragraphs are closed on 2nd <br>, </p>, or just before <p>.
#
# Usage       : my $selectedParagraphTokens = &returnTokensFromSelectedParagraphs($tokens, $start, $end);
#               my $selectedParagraphTokens = &returnTokensFromSelectedParagraphs($tokens, $paragraphNumber);
#
# Note        : Context is ignored when parsing paragraph tags.  That means
#               paragraphs may be split in the middle of div, span, b, i, links,
#               and so on.  The one expection is tables, which are never split
#               and treated as one element in a paragraph.
# ----------------------------------------------------------------------------

sub returnTokensFromSelectedParagraphs {
  my ($tokens, $startParagraph, $endParagraph) = @_;
  $endParagraph ||= $startParagraph;

  my @paragraphs;
  my $currentParagraphTokens = [];
  my $lastParagraphTokens = [];
  my $brCounter = 0;
  my $tableCounter = 0;

  foreach my $token (@$tokens) {

    if    ($token->{'type'} ne 'tag') {
      my $isWhitespace = $token->{'type'} eq 'text' && $token->{'content'} !~ /\S/;
      my $isComment    = $token->{'type'} eq 'comment';

      if (!$isWhitespace && !$isComment) { $brCounter = 0; }

      # add leading whitespace to previous paragraph.
      if ($token->{'type'} eq 'text' && !@$currentParagraphTokens && @$lastParagraphTokens && ($token->{'content'} =~ m/^(\s+)(.*)/s)) {
        my($leadingWhitespace, $remainingContent) = ($1, $2);
        push @$lastParagraphTokens, { type => 'text', content => $leadingWhitespace };
        push @$currentParagraphTokens, { type => 'text', content => $remainingContent };
      }
      else {
        push @$currentParagraphTokens, $token;
      }
    }

    elsif ($token->{'type'} eq 'tag') {

      # skip over tables (don't start/end paragraphs in the middle of tables)
      if    ($token->{'content'} =~ /<table\W/i)   { $tableCounter++; }
      elsif ($token->{'content'} =~ /<\/table\W/i) { $tableCounter--; }

      if ($tableCounter > 0) {
        push @$currentParagraphTokens, $token;
        next;
      }
      # /skip over tables

      if ($token->{'content'} =~ /<br\W/i) {     # match <br> tag
        push @$currentParagraphTokens, $token;
        $brCounter++;
        if ($brCounter >= 2) {
          push @paragraphs, $currentParagraphTokens;
          $lastParagraphTokens    = $currentParagraphTokens;
          $currentParagraphTokens = [];
          $brCounter = 0;
        }
      }

      elsif ($token->{'content'} =~ /<p\W/i) {   # match <p> tag
        my $onlyWhitespace = (@$currentParagraphTokens == 1 && $currentParagraphTokens->[0]{'content'} !~ /\S/s);
        if (@$currentParagraphTokens && !$onlyWhitespace) {  # close off existing paragraph if any
          push @paragraphs, $currentParagraphTokens;
          $lastParagraphTokens    = $currentParagraphTokens;
          $currentParagraphTokens = [];
          $brCounter = 0;
        }
        push @$currentParagraphTokens, $token;
      }

      elsif ($token->{'content'} =~ /<\/p\W/i) { # match </p> tag
        push @$currentParagraphTokens, $token;
        push @paragraphs, $currentParagraphTokens;
        $lastParagraphTokens    = $currentParagraphTokens;
        $currentParagraphTokens = [];
        $brCounter = 0;
      }

      else {
        push @$currentParagraphTokens, $token;             # all other tags, add to current paragraph
      }
    }
  }

  if (@$currentParagraphTokens) {
    push @paragraphs, $currentParagraphTokens;
  }


  # get tokens from selected paragraphs
  my $highestIndex = $#paragraphs;
  my $startIndex   = $startParagraph - 1;
  my $endIndex;
  if ($endParagraph eq '+') { $endIndex = $highestIndex; }
  else                      { $endIndex = &IT::Common::mathMin( $endParagraph - 1, $highestIndex); }

  my $selectedParagraphTokens;
  if ($startIndex > $highestIndex) { $selectedParagraphTokens = &tokenize(''); }
  else {
    foreach my $index ($startIndex..$endIndex) {
      push @$selectedParagraphTokens, @{$paragraphs[$index]};
    }
  }

  # return selected paragraph tokens
  return $selectedParagraphTokens;

}

# ----------------------------------------------------------------------------
# Function    : removeTablesAndTagTokens
# Description : remove tables, table contents, tags and comments.
#               The following tags will be replaced with \n if they
#               don't have whitespace on either side of them: <p>, </p>, <br>
# Usage       : $tokens = &removeTablesAndTagTokens($tokens);
# ----------------------------------------------------------------------------

sub removeTablesAndTagTokens {
  my $tokens   = shift;
  my @tokensWithoutTags;
  my $tableCounter = 0;

  foreach my $index (0..$#$tokens) {
    my $token     = $tokens->[$index];

    # skip over tables
    if    ($token->{'type'} eq 'tag' && $token->{'content'} =~ /<table\W/i)   { $tableCounter++; }
    elsif ($token->{'type'} eq 'tag' && $token->{'content'} =~ /<\/table\W/i) { $tableCounter--; }
    if ($tableCounter > 0) { next; }

    # make sure <br> and <p> tags have whitespace around them
    if ($token->{'type'} eq 'tag') {
      my $nextToken           = $tokens->[$index + 1];
      my $lastToken           = $index ? $tokens->[$index - 1] : {};
      my $isBreakOrParagraph  = $token->{'content'} =~ /<br\W/i || $token->{'content'} =~ /<\/?p\W/i;
      my $neighborsWhitespace = $lastToken->{'content'} =~ /\s$/si || $nextToken->{'content'} =~ /^\s/si;

      if ($isBreakOrParagraph && !$neighborsWhitespace) {
        my $newToken = { content => "\n", type => "text" };
        push @tokensWithoutTags, $newToken;
      }
      next;
    }
    elsif ($token->{'type'} eq 'comment') { next; }
    elsif ($token->{'type'} eq 'entity')  { push @tokensWithoutTags, $token; }
    elsif ($token->{'type'} eq 'text')    { push @tokensWithoutTags, $token; }
    else { die "unknown token type '$token->{'type'}'"; }
  }

  # removing tags creates neighboring text tokens that should be merged
  my $mergedTokens = &_mergeNeighboringTextTokens(\@tokensWithoutTags);

  return $mergedTokens;
}

# ----------------------------------------------------------------------------
# Function    : convertEntityToCharacter
# Description : return a character represented by entity or nothing if entity
#               can't be matched.  Entity can be in the following forms:
#               &#NNN; &XNN; &NamedEntity;
#               Leading & and trailing ; aren't required
#               Unicode entites are NOT decoded (not supported by perl 5.004)
#
# Usage       : my $char = &convertEntityToCharacter($entityString);
#               unless (defined $char) { die "no entity found!"; }
# ----------------------------------------------------------------------------

sub convertEntityToCharacter {
  my $entity = shift;
  unless (defined $entity) { die "no entity specified!"; }
  my $char;

  # Regexps & code from decode_entities_old in HTML::Entities 1.39 - Copyright 1995-2004 Gisle Aas.
  if    ($entity =~ /^&?\#(\d+);?\z/gcs) {              # numeric entity &#169; is ©
    my $decimalValue = $1;
    if ($decimalValue <= 255) { $char = chr($decimalValue); }
  }
  elsif ($entity =~ /^&?\#[xX]([0-9a-fA-F]+);?\z/gcs) { # hexadecimal entity &#xA9; is ©
    my $hexValue = $1;
    my $decimalValue = hex($hexValue);
    if ($decimalValue <= 255) { $char = chr($decimalValue); }
  }
  elsif ($entity =~ /^&?(\w+);?\z/gcs) {                # named entity &#copy; is ©
    my $entityName = $1;
    my $entity2char = &_entity2charHash();

    if (exists $entity2char->{$entityName}) { $char = $entity2char->{$entityName}; }
  }
  else {
    die "Unrecognized Entity '$entity'\n";
  }

  return $char;
}

# ----------------------------------------------------------------------------
# Function    : convertEntitiesToCharacters
# Description : Call &convertEntityToCharacter for every entity token, replacing
#               all entities with characters.  If an entity is unknown or unicode
#               then it will be left intact.
#
# Usage       : $tokens = &convertEntitiesToCharacters($tokens);
# ----------------------------------------------------------------------------

sub convertEntitiesToCharacters {
  my $tokens   = shift;
  my @newTokens;

  foreach my $token (@$tokens) {
    if    ($token->{'type'} eq 'text')    { push @newTokens, $token; }
    elsif ($token->{'type'} eq 'comment') { push @newTokens, $token; }
    elsif ($token->{'type'} eq 'tag')     { push @newTokens, $token; }
    elsif ($token->{'type'} eq 'entity')  {
      my $char = &convertEntityToCharacter( $token->{'content'} );
      if (defined $char) {
        my $newToken = { content => $char, type => "text" };
        push @newTokens, $newToken;
      }
      else { push @newTokens, $token; } # leave unknown entities intact
    }
    else { die "unknown token type '$token->{'type'}'"; }
  }

  # replacing entities with characters creates neighboring text tokens that should be merged
  my $mergedTokens = &_mergeNeighboringTextTokens(\@newTokens);

  return $mergedTokens;
}

# ----------------------------------------------------------------------------
# Function    : _entity2charHash
# Description : returns hash of HTML Entities and their corresponding characters
#               from HTML::Entities v1.29 (Copyright 1995-2004 Gisle Aas)
# Usage       : my $entity2char = &_entity2charHash();
# ----------------------------------------------------------------------------

sub _entity2charHash {

  my %entity2char = (

    # Some normal chars that have special meaning in SGML context
    amp    => "\x26",  # & - ampersand
   'gt'    => "\x3e",  # > - greater than
   'lt'    => "\x3c",  # < - less than
    quot   => "\x22",  # " - double quote
    apos   => "\x27",  # ' - single quote

    # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
    AElig  => "\xc6",    # Æ - capital AE diphthong (ligature)
    Aacute => "\xc1",    # Á - capital A, acute accent
    Acirc  => "\xc2",    # Â - capital A, circumflex accent
    Agrave => "\xc0",    # À - capital A, grave accent
    Aring  => "\xc5",    # Å - capital A, ring
    Atilde => "\xc3",    # Ã - capital A, tilde
    Auml   => "\xc4",    # Ä - capital A, dieresis or umlaut mark
    Ccedil => "\xc7",    # Ç - capital C, cedilla
    ETH    => "\xd0",    # Ð - capital Eth, Icelandic
    Eacute => "\xc9",    # É - capital E, acute accent
    Ecirc  => "\xca",    # Ê - capital E, circumflex accent
    Egrave => "\xc8",    # È - capital E, grave accent
    Euml   => "\xcb",    # Ë - capital E, dieresis or umlaut mark
    Iacute => "\xcd",    # Í - capital I, acute accent
    Icirc  => "\xce",    # Î - capital I, circumflex accent
    Igrave => "\xcc",    # Ì - capital I, grave accent
    Iuml   => "\xcf",    # Ï - capital I, dieresis or umlaut mark
    Ntilde => "\xd1",    # Ñ - capital N, tilde
    Oacute => "\xd3",    # Ó - capital O, acute accent
    Ocirc  => "\xd4",    # Ô - capital O, circumflex accent
    Ograve => "\xd2",    # Ò - capital O, grave accent
    Oslash => "\xd8",    # Ø - capital O, slash
    Otilde => "\xd5",    # Õ - capital O, tilde
    Ouml   => "\xd6",    # Ö - capital O, dieresis or umlaut mark
    THORN  => "\xde",    # Þ - capital THORN, Icelandic
    Uacute => "\xda",    # Ú - capital U, acute accent
    Ucirc  => "\xdb",    # Û - capital U, circumflex accent
    Ugrave => "\xd9",    # Ù - capital U, grave accent
    Uuml   => "\xdc",    # Ü - capital U, dieresis or umlaut mark
    Yacute => "\xdd",    # Ý - capital Y, acute accent
    aacute => "\xe1",    # á - small a, acute accent
    acirc  => "\xe2",    # â - small a, circumflex accent
    aelig  => "\xe6",    # æ - small ae diphthong (ligature)
    agrave => "\xe0",    # à - small a, grave accent
    aring  => "\xe5",    # å - small a, ring
    atilde => "\xe3",    # ã - small a, tilde
    auml   => "\xe4",    # ä - small a, dieresis or umlaut mark
    ccedil => "\xe7",    # ç - small c, cedilla
    eacute => "\xe9",    # é - small e, acute accent
    ecirc  => "\xea",    # ê - small e, circumflex accent
    egrave => "\xe8",    # è - small e, grave accent
    eth    => "\xf0",    # ð - small eth, Icelandic
    euml   => "\xeb",    # ë - small e, dieresis or umlaut mark
    iacute => "\xed",    # í - small i, acute accent
    icirc  => "\xee",    # î - small i, circumflex accent
    igrave => "\xec",    # ì - small i, grave accent
    iuml   => "\xef",    # ï - small i, dieresis or umlaut mark
    ntilde => "\xf1",    # ñ - small n, tilde
    oacute => "\xf3",    # ó - small o, acute accent
    ocirc  => "\xf4",    # ô - small o, circumflex accent
    ograve => "\xf2",    # ò - small o, grave accent
    oslash => "\xf8",    # ø - small o, slash
    otilde => "\xf5",    # õ - small o, tilde
    ouml   => "\xf6",    # ö - small o, dieresis or umlaut mark
    szlig  => "\xdf",    # ß - small sharp s, German (sz ligature)
    thorn  => "\xfe",    # þ - small thorn, Icelandic
    uacute => "\xfa",    # ú - small u, acute accent
    ucirc  => "\xfb",    # û - small u, circumflex accent
    ugrave => "\xf9",    # ù - small u, grave accent
    uuml   => "\xfc",    # ü - small u, dieresis or umlaut mark
    yacute => "\xfd",    # ý - small y, acute accent
    yuml   => "\xff",    # ÿ - small y, dieresis or umlaut mark


    # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
    copy   => "\xa9",  # © - copyright sign
    reg    => "\xae",  # ® - registered sign
    nbsp   => "\xa0", # non breaking space

    # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
    iexcl  => "\xa1",    # ¡ -
    cent   => "\xa2",    # ¢ -
    pound  => "\xa3",    # £ -
    curren => "\xa4",    # ¤ -
    yen    => "\xa5",    # ¥ -
    brvbar => "\xa6",    # ¦ -
    sect   => "\xa7",    # § -
    uml    => "\xa8",    # ¨ -
    ordf   => "\xaa",    # ª -
    laquo  => "\xab",    # « -
   'not'   => "\xac",    # ¬ - not is a keyword in perl
    shy    => "\xad",    # ­ -
    macr   => "\xaf",    # ¯ -
    deg    => "\xb0",    # ° -
    plusmn => "\xb1",    # ± -
    sup1   => "\xb9",    # ¹ -
    sup2   => "\xb2",    # ² -
    sup3   => "\xb3",    # ³ -
    acute  => "\xb4",    # ´ -
    micro  => "\xb5",    # µ -
    para   => "\xb6",    # ¶ -
    middot => "\xb7",    # · -
    cedil  => "\xb8",    # ¸ -
    ordm   => "\xba",    # º -
    raquo  => "\xbb",    # » -
    frac14 => "\xbc",    # ¼ -
    frac12 => "\xbd",    # ½ -
    frac34 => "\xbe",    # ¾ -
    iquest => "\xbf",    # ¿ -
   'times' => "\xd7",    # × - times is a keyword in perl
    divide => "\xf7",    # ÷ -

  );

  return \%entity2char;

}

# ------------------------------------------------------------------------------
# Function    : getTagAttributes
# Description : return a hash of attributes from tag.  Attributes without a
#               value (eg: checked) get name assigned as value.
# Usage       : my $attributes = &IT::HTMLParser::getTagAttributes($tag);
# ------------------------------------------------------------------------------

sub getTagAttributes {
  my $tag = shift || die "no tag specified";

  # error checking
  $tag =~ m/^<\/?\w+(.*?)>$/s || die "_getTagAttributes: Invalid tag format '$tag'!";

  # parse tag name
  $tag =~ m/^<\/?\w+/gcs || die "_getTagAttributes: Couldn't match start of tag!";

  # parse attributes
  my %attributes;
  while (1) {
    if    ($tag =~ /\G\s+/gcs)                   { }
    elsif ($tag =~ /\G(\w+)\s*=\s*'([^']*)'/gcs) {   # single quoted name/value
      $attributes{lc $1} = $2;
    }
    elsif ($tag =~ /\G(\w+)\s*=\s*"([^"]*)"/gcs) {   # double quoted name/value
      $attributes{lc $1} = $2;
    }
    elsif ($tag =~ /\G(\w+)\s*=\s*(\S+)(?=.)/gcs) {   # unquoted name/value
      $attributes{lc $1} = $2;
    }
    elsif ($tag =~ /\G(\S+)(?=.)/gcs) {   # name without value (eg: checked)
      $attributes{lc $1} = $1;
    }
    elsif ($tag =~ /\G\/?\s*>$/gcs) { last; }

    else {
      $tag =~ /\G(.*)/gcs;
      my $unmatchedText = $1;
      die "_getTagAttributes: error parsing tag '$tag' at $unmatchedText";
    }
  }

  return \%attributes;
}

# ----------------------------------------------------------------------------
# end of file
1;

