view release on metacpan or  search on metacpan

uHTML.pm  view on Meta::CPAN

sub _close( $$ )
{
  my( $Node,$Name,$Tail ) = @_ ;

  my( $p, $e ) ;

  for( $p = $Node; $p and $p->{Name} ne $Name or $p->{XMLClose} or $p->{End} ; $p=$p->{Prev} ) {} ;
  errorMsg( 0,"wrong close of $Name." ) and return undef unless $p ;

  if( $p and $p->{Next} )
  {
    $e           = $p->{Next} ;
    $p->{Next} = 0 ;
    $p->{FirstChild} = $e ;
    $p->{LastChild}  = $Node ;
    $e->{Prev} = 0 ;
    while( $e )
    {
      $e->{Parent} = $p ;
      $e = $e->{Next} ;
    }
  }
  else
  {
    $p = $Node ;
  }
  $p->{Text} = $p->{Trailer} ;
  $p->{End} = 1 ;
  $p->{Trailer} = $Tail ;
  return $p ;
}

sub ParamCount
{
  my $self = shift ;

  return( ref $self->{PCount} eq 'ARRAY' ? $self->{PCount}->[-1] : '' ) ;
}

sub _callwrap
{
  my( $Func,$Node,$AttrName,$Params ) = @_ ;
  my @FParams = ($Params =~ m/([^,'"](?:\\,|[^,])*|'(?:\\'|[^'])*'|"(?:\\"|[^"])*"|)\s*,?/sg) ;

  s/^\s*['"]?//s + s/['"]?\s*$//s foreach @FParams ;
  push @{$Node->{PCount}},scalar( @FParams ) ;
  return $uHTML::uAttr{$Func}( $Node,$AttrName,$Func,map((m/(?<!\\)\$(?=[a-zA-Z_])/s?codeAttr($Node,$AttrName,$_):$_),@FParams) ) if $uHTML::uAttr{$Func} ;
  errorMsg( 0,"unknown variable $Func.") ;
  return "\\\$$Func" ;
}

sub codeAttr
{
  my $Node  = shift ;
  my $Attr  = shift ;
  my $Value = shift ;

  return '' unless $Value or $Node->{Attributes} and ($Value = $Node->{Attributes}->{$Attr}) ne '' ;

  my( $func,$par,$tail,$sub,$rsub ) ;
  my @subs = split m/(?<!\\)\$(?=[a-zA-Z_\$])/s,$Value ;
  while( $#subs > 0 )
  {
    $rsub++ ;
    next unless $sub = pop @subs ;
    $sub =~ s/\\(?=\$)//s ;

    ( $func,$par,$tail ) = ($sub  =~ m/([a-zA-Z_][0-9a-zA-Z_]*)(?:\(\s*('(?:\\'|[^'])*'|"(?:\\"|[^"])*"|(?:\\.|[^()])*(?:\s*,(?:'(?:\\'|[^'])*'|"(?:\\"|[^"])*"|(?:\\.|[^()])))*)\s*\))?(.*)$/s) ;
    $sub = _callwrap( $func,$Node,$Attr,$par ) . $tail ;
    pop @{$Node->{PCount}} ;

    $subs[$#subs] .= $sub ;
  }
  $subs[0] =~ s/\\(?!\\)//sg ;

  return $subs[0] ;
}

sub attr
{
  my $Node  = shift ;
  my $Attr = shift ;
  my $Value = shift ;
  return( defined $Value ? rawAttr($Node,$Attr,$Value) : codeAttr($Node,$Attr) ) ;
}

sub errorMsg
{
  print STDERR "uHTML Error in $uHTML::FileName: $_[1]\n" if $_[2] or $uHTML::FileName ;
}

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

package uHTML;

local( $uHTML::Pos,@uHTML::Blocks,%uHTML::uHTML,%uHTML::uTag,%uHTML::uAttr,%uHTML::uSTag,$uHTML::FileName ) ;

sub _checkName
{
  my $Name = shift ;
  my $Code = shift ;

  $_->{$Name} and $_->{$Name} != $Code and return 0 foreach @_ ;
  return 1 ;
}

sub registerTagCode( $$ )
{
  my( $TagName,$Code ) = @_ ;

  push @{$uHTML::uCode{$TagName}},$Code if _checkName( $TagName,$Code ) ;
}

sub registerTag
{
  my( $TagName,$Code,$nowarn ) = @_ ;

  $uHTML::uTag{$TagName} = $Code if $nowarn or _checkName( $TagName,$Code,\%uHTML::uTag, \%uHTML::uSTag ) ;
}