view release on metacpan or  search on metacpan

uHTML/std.pm  view on Meta::CPAN

my $SO = qr/\s*,\s*/ ;
my $RO = qr/\s*[,;:]\s*/ ;

use constant { TIMEOUT => 6000 } ;

sub setDebug
{
  $DEBUG      = shift ;
  $DEBUG_MASK = shift ;
}

sub DoIf( $ )
{
  my $Node = shift ;

  my $Child ;


  if( eval( $Node->attr( 'cond' ) ) )
  {
    my @D ;

    for( $Child=$Node->{'FirstChild'}; $Child; $Child=$Child->{'Next'} )
    {
      push @D,$Child if $Child->{'Name'} eq 'else';
    }
    $_->delete() foreach @D ;
    $Node->map( '','' ) ;
  }
  else
  {
    my( $Elif,$Else ) ;

    for( $Child=$Node->{'FirstChild'}; $Child && !$Elif; $Child=$Child->{'Next'} )
    {
      next unless $Child->{'Name'} eq 'else' ;

      if( $Child->testAttr( 'cond' ) )
      {
        $Elif = $Child if eval( $Child->attr( 'cond' ) ) ;
      }
      else
      {
        $Else = $Child ;
      }
    }
    $Else = $Elif if $Elif ;
    $Node->{'Text'} = '' ;
    $Node->{'HTML'} = $Else ? $Else->map( '','' ) : undef ;
  }
}

sub Choice( $ )
{
  my $Node = shift ;
  return unless $Node->testAttr( 'tag' ) ;
  my $Name = $Node->attr( 'tag' ) ;
  return unless $Name ;
  my $cond = eval( $Node->attr( 'cond' ) ) ? 0 : 1 ;
  my( $P,@S ) ;
  @S = split m/\|/,$Name,2 ;
  $Name = $S[$cond] if $#S>0 ;
  return unless $Name and $Name ne 'choice' ;
  $Node->name( $Name ) ;
  my $Add  = $Node->attr( 'attr' ) ;
  $Node->deleteAttr( 'cond','tag','attr' ) ;
  foreach( keys %{$Node->attributes()} )
  {
    next unless $P = $Node->rawAttr( $_ ) ;
    @S = split m/\|/,$P,2 ;
    $S[$cond] ne '' ? $Node->rawAttr( $_,$S[$cond] ) : $Node->deleteAttr( $_ ) if $#S>0 ;
  }
  if( $Add )
  {
    @S = split m/\|/,$Add,2 ;
    $Node->addAttr( split $SO,( $#S>0?$S[$cond]:$Add ) ) ;
  }
  $Node->process() ;     #kein insert da dann uHTML-Tags nicht berücksichtigt werden
  $Node->trailer( '' ) ; #process hat den Anhang bereits angefügt
}

sub VarChoice( $ )
{
  my( $Node,$Par,$Var,$cond,$true,$false ) = @_ ;
  return( eval $cond ? $true : $false ) ;
}

sub CondAttr
{
  my $Node = shift ;
  my $Name = $Node->attr( 'tag' ) ;

  return unless $Name ;
  $Node->name( $Name ) ;
  $Node->deleteAttr( 'tag' ) ;
  $Node->attr( $_ ) ne '' or $Node->deleteAttr( $_ ) foreach keys %{$Node->attributes()} ;
  $Node->map( '','' ) ;
}

sub Identity( $ )
{
  my $Node = shift ;

  return $_[1] if shift ;
  $Node->map( '','' ) ;
}

sub InsertText( $ )
{
  my $Node = shift ;

  return uHTML::recode( $_[1],$Node->{'ENV'} ) if shift ;
  $Node->testAttr( 'raw' ) ? $Node->HTML( $Node->attr( 'text' ) ) : $Node->map( $Node->attr( 'text' ),'' ) ;
}

sub ReplaceText
{
  my( $Node,$Par,$Var,$Text,$Pattern,$Replace,$opt ) = @_ ;

  unless( $Par )
  {
    $Text    = $Node->attr( 'text' ) ;
    $Pattern = $Node->attr( 'pattern' ) ;
    $Replace = $Node->attr( 'replace' ) ;
    $opt     = $Node->attr( 'options' ) ;
  }
  $Pattern =~ s"(?<!\\)/"\\/"g ;
  $Replace =~ s"(?<!\\)/"\\/"g ;
  $opt     =~ s"[^msixpgcadlu]""g ;
  eval( "\$Text =~ s/$Pattern/$Replace/$opt" ) ;
  return $Text ;
}

sub uFilePath( $$ )
{

uHTML/std.pm  view on Meta::CPAN

  }

  return $env->{'uHTML.Macros'}->{$Name} ;
}

sub _getMacroValue()
{
  my $Node = shift ;
  my $Par  = shift ;
  my $Name = shift ;
  my $Cnt  = scalar @_ ;
  my $env  = $Node->{'ENV'} ;
  my $M    = _checkMacro( $env,$Name ) ;

  print STDERR "getMacroValue $Name (".ref($M).")\n" if $DEBUG > 0 ;
  return '' unless $M and ref $M eq 'uHTMLnode' ;
  return $env->{'uHTML.MacroHTML'}->{$Name} if exists $env->{'uHTML.MacroHTML'}->{$Name} ;
  my $Macro = $M->copy ;
  if( $Cnt and ref $env->{'uHTML.MacroAttr'}->{$Name} eq 'ARRAY' )
  {
    my( $attr,$val ) ;
    $env->{'uHTML.MacroVal'}->{$Name}->{$a} = $b ;
    foreach $attr( @{$env->{'uHTML.MacroAttr'}->{$Name}} )
    {
      $val = $Cnt-- > 0 ? shift : $env->{'uHTML.MacroVal'}->{$Name}->{$attr} ;
      uHTML::register( $attr,\&_Replace,1 ) unless _testDefine( $env,$attr ) ;
      unshift @{$env->{'uHTML.Defines'}->{$attr}},$val ;
    }
    $Macro->map( '','' ) ;
    shift @{$env->{'uHTML.Defines'}->{$_}} foreach @{$env->{'uHTML.MacroAttr'}->{$Name}} ;
  }
  else
  {
    $Macro->map( '','' ) ;
  }
  return( $env->{'uHTML.MacroHTML'}->{$Name} = $Macro->HTML() ) ;
}

sub _DoMacro( $ )
{
  my $Node = shift ;
  my $env  = $Node->{'ENV'} ;
  my $Name = $Node->name() ;
  my $Macro ;

  print STDERR "Check Macro '$Name'\n" if $DEBUG > 1 ;
  return unless my $M = _checkMacro( $env,$Name ) ;
  print STDERR "Execute Macro '$Name'\n" if $DEBUG > 0 ;

  $Macro = $M->copy() ;

  $Node->attr( $_ ) or $Node->deleteAttr( $_ ) foreach qw( createonly replace ) ;
  $Node->testAttr( $_ ) or $Node->setAttr( $_,$env->{'uHTML.MacroVal'}->{$Name}->{$_} ) foreach @{$env->{'uHTML.MacroAttr'}->{$Name}} ;
  print STDERR "Execute macro $Name(${\(join ',',map \"$_='${\($Node->attr($_))}'\",keys %{$Node->attributes()})})\n" if $DEBUG > 0 ;

  Define( $Node ) ;
  if( $env->{'uHTML.MacroBody'}->{$Name} )
  {
    $Node->map( '','' ) ;
    $Macro->map( '','' ) ;
    my( $H,$T ) = split m/<MacroBody>/s,$Macro->HTML(),2 ;
    unshift @{$Node->{HTML}},$H ;
    push    @{$Node->{HTML}},$T ;
  }
  else
  {
    $Macro->map( '','' ) ;
    $Node->{HTML} = $Macro->{HTML} ;
  }
  ClearDef( $Node ) ;
}

sub _findMacroBody
{
  my $Node = shift ;

  return undef unless $Node->firstChild() ;

  my( $Child,$MBody ) ;

  for( $Child = $Node->firstChild() ; $Child ; $Child=$Child->next() )
  {
    $MBody ? $Child->delete()         : ($MBody = $Child) if $Child->name() eq 'MacroBody' ;
    $MBody ? _findMacroBody( $Child ) : ($MBody = _findMacroBody( $Child )) ;
  }
  return $MBody ;
}

sub Macro( $ )
{
  my $Node = shift ;
  my $env  = $Node->{'ENV'} ;
  my $Replace ;
  my $Name ;

  return unless $Node->end() and $Name = $Node->attr( 'name' ) ;
  return if     $Replace = _checkMacro( $env,$Name ) and not $Node->testAttr( 'replace' ) ;
  print STDERR "Define Macro '$Name\(${\($Node->attr( 'attributes' ))}\)'\n" if $DEBUG > 1 ;

  $env->{'uHTML.MacroBody'}->{$Name} = _findMacroBody( $env->{'uHTML.Macros'}->{$Name} = $Node->copy() ) ;

  if( $Node->testAttr( 'attributes' ) )
  {
    my( @AT,@A ) ;

    if( @AT = ($Node->attr( 'attributes' ) =~ m/([^,'"=\s]+)(?:\s*\=\s*((?:\\,|[^'",])(?:\\,|[^,\s])*|'(?:\\'|[^'])*'|"(?:\\"|[^"])*")?)?\s*,?/sg) )
    {
      $_ & 1 ? $AT[$_] =~ m/^["']/ && $AT[$_] =~ s/^["']|["']$//g : push( @A,$AT[$_] ) foreach 0 .. $#AT ;
      %{$env->{'uHTML.MacroVal'}->{$Name}} = ( @AT ) ;
      $env->{'uHTML.MacroAttr'}->{$Name}   = \@A ;
    }
  }

  return if $Replace ;
  print STDERR "Register Macro '$Name'\n" if $DEBUG > 0 and $env->{'uHTML.Macros'}->{$Name} and $Name eq 'Help' ;
  uHTML::registerTag( $Name,\&_DoMacro,1 ) ;
  uHTML::registerVar( $Name,\&_getMacroValue,1 ) ;
}

sub DefinedVar
{