PLJava

 view release on metacpan or  search on metacpan

basiclib/XML/Smart/DTD.pm-txt  view on Meta::CPAN

  return ( $this->get_elem_child_opt(@_) =~ /^[\!\+]?$/ ) ? 1 : undef ;
}

###############
# IS_ELEM_OPT #
###############

sub is_elem_opt {
  my $this = shift ;
  return ( $this->get_elem_opt(@_) =~ /^[\?\*]$/ ) ? 1 : undef ;
}

#####################
# IS_ELEM_CHILD_OPT #
#####################

sub is_elem_child_opt {
  my $this = shift ;
  return ( $this->get_elem_child_opt(@_) =~ /^[\?\*]$/ ) ? 1 : undef ;
}

################
# GET_ELEM_OPT #
################

sub get_elem_opt {
  my $this = shift ;
  my ( $tag ) = @_ ;
  return undef if !$this->{tree}{$tag} ;
  return $this->{tree}{$tag}{option} ;
}

######################
# GET_ELEM_CHILD_OPT #
######################

sub get_elem_child_opt {
  my $this = shift ;
  my ( $tag , $child ) = @_ ;
  return undef if !$this->{tree}{$tag} || !$this->{tree}{$tag}{children} ;
  return $this->{tree}{$tag}{children}{$child} ;
}

###############
# IS_ELEM_ANY #
###############

sub is_elem_any {
  my $this = shift ;
  my ( $tag ) = @_ ;
  return undef if !$this->{tree}{$tag} ;

  return 1 if $this->{tree}{$tag}{any} ;
  return undef ;
}

##################
# IS_ELEM_PCDATA #
##################

sub is_elem_pcdata {
  my $this = shift ;
  my ( $tag ) = @_ ;
  return undef if !$this->{tree}{$tag} ;
  return 1 if $this->{tree}{$tag}{content} ;
}

#################
# IS_ELEM_EMPTY #
#################

sub is_elem_empty {
  my $this = shift ;
  my ( $tag ) = @_ ;
  return undef if !$this->{tree}{$tag} ;

  return 1 if $this->{tree}{$tag}{empty} ;
  return undef ;
}

##################
# IS_ELEM_PARENT #
##################

sub is_elem_parent {
  my $this = shift ;
  my ( $tag , @chk_parent ) = @_ ;
  return undef if !$this->{tree}{$tag} ;

  my @parents = ref($this->{tree}{$tag}{parent}) eq 'ARRAY' ? @{$this->{tree}{$tag}{parent}} : () ;
  my %parents = map { $_ => 1 } @parents ;

  foreach my $chk_parent_i ( @chk_parent ) {
    next if $chk_parent_i eq '' ;
    return undef if !$parents{$chk_parent_i} ;
  }

  return 1 ;
}

###############
# ATTR_EXISTS #
###############

sub attr_exists {
  my $this = shift ;
  my ( $tag , @attrs ) = @_ ;
  return undef if !$this->{tree}{$tag} ;
  
  foreach my $attrs_i ( @attrs ) {
    return undef if !$this->{tree}{$tag}{attributes}{$attrs_i} ;
  }

  return 1 ;
}

###############
# IS_ATTR_REQ #
###############

sub is_attr_req {

basiclib/XML/Smart/DTD.pm-txt  view on Meta::CPAN

}

#############
# READ_DATA #
#############

sub read_data {
  my $data ;
  {
    my ($fh,$open) ;
    
    if (ref($_[0]) eq 'GLOB') { $fh = $_[0] ;}
    elsif ($_[0] =~ /^http:\/\/\w+[^\r\n]+$/s) { $data = &get_url($_[0]) ;}
    elsif ($_[0] =~ /<.*?>/s) { $data = $_[0] ;}
    else { open ($fh,$_[0]) ; binmode($fh) ; $open = 1 ;}
    
    if ($fh) {
      1 while( read($fh, $data , 1024*8 , length($data) ) ) ;
      close($fh) if $open ;
    }
  }
  
  return $data ;
}

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

#############
# APPLY_DTD #
#############

sub apply_dtd {
  my $xml = shift ;
  my $dtd = shift ;
  
  if ( ref($dtd) ne 'XML::Smart::DTD' ) { $dtd = XML::Smart::DTD->new($dtd , @_) ;}
  
  $$xml->{DTD} = $dtd ;

  return if !$dtd || !$dtd->tree || !%{ $dtd->tree } ;
  
  _apply_dtd($dtd , $xml->tree , undef , undef , {} , undef , undef , {} , @_) ;
}

sub _apply_dtd {
  my ($dtd , $tree , $tag , $ar_i , $prev_tree , $prev_tag , $prev_exists , $parsed , %opts) = @_ ;
  
  ##print "$tag>> $tree , $tag , $prev_tree , $prev_tag , $parsed >> $opts{no_delete}\n" ;
  
  if ( ref($tree) ) {
    if ($$parsed{"$tree"}) { return ;}
    ++$$parsed{"$tree"} ;
  }
  
  if (ref($tree) eq 'HASH') {
  
    if ( $tag ne '' && $dtd->elem_exists($tag) ) {
      if ( $dtd->is_elem_empty($tag) ) {
        $prev_tree->{$tag} = {} ;
      }
      elsif ( $dtd->is_elem_pcdata($tag) ) {
        if ( ref $prev_tree->{$tag} eq 'HASH' ) { $prev_tree->{$tag}{CONTENT} = '' if !defined $prev_tree->{$tag}{CONTENT} ;}
        else { $prev_tree->{$tag} = '' if !defined $prev_tree->{$tag} ;}
      }
      else {
        my @childs_req = $dtd->get_childs_req($tag) ;
        foreach my $childs_req_i ( @childs_req ) {
          if ( !exists $tree->{$childs_req_i} ) {
            $tree->{$childs_req_i} = {} ;
          }
        }
      
        my @attrs_req = $dtd->get_attrs_req($tag) ;
        foreach my $attrs_req_i ( @attrs_req ) {
          if ( !exists $tree->{$attrs_req_i} ) {
            $tree->{$attrs_req_i} = $dtd->get_attr_def($tag , $attrs_req_i) ;
          }
        }
        
        {
          my @order = $dtd->get_childs($tag) ;
          
          if ( ! $tree->{'/order'} ) { $tree->{'/order'} = \@order ;}
          else {
            my %in_order ;
            {
              my %n ; %in_order = map { $_ => (++$n{$_}) } @{ $tree->{'/order'} } ;
            }
            
            my (@new_order , %order) ;
            foreach my $order_i ( @order ) {
              push(@new_order , (($order_i) x ($in_order{$order_i} || 1))) ;
              $order{$order_i} = 1 ;
            }
            
            foreach my $order_i ( @{ $tree->{'/order'} } ) {
              next if $order{$order_i} ;
              push(@new_order , $order_i) ;
            }
            
            $tree->{'/order'} = \@new_order ;
          }
          
        }
        
        
      }
            
    }
  
    foreach my $Key ( keys %$tree ) {
      if ($Key eq '' || $Key eq '/order' || $Key eq '/nodes' || $Key eq 'CONTENT') { next ;}
      
      if ( $dtd->elem_exists($Key) ) {
        if ( $tree->{'/nodes'}{$Key} =~ /^(\w+,\d+),(\d*)/ ) { $tree->{'/nodes'}{$Key} = "$1,1" ;}
        else { $tree->{'/nodes'}{$Key} = 1 ;}
        
        if ( !ref($tree->{$Key}) ) {
          my $content = $tree->{$Key} ;
          $tree->{$Key} = {} if !ref $tree->{$Key} ;
          $tree->{$Key}{CONTENT} = $content if $content ne '' ;

basiclib/XML/Smart/DTD.pm-txt  view on Meta::CPAN

Return the defined values of an attribute.

=head2 get_attrs ( TAG )

Return the attribute list of a element.

=head2 get_attrs_req ( TAG )

Return the required attribute list of a element.

=head2 get_childs ( TAG )

Return the child list of an element.

=head2 get_childs_req ( TAG )

Return the required child list of an element.

=head2 get_elem_opt ( TAG )

Return the occurrence option of an element:

  !  REQUIRED AND ONLY ONE MATCH
  +  1 or more
  *  0 or more
  ?  0 or 1

=head2 get_elem_child_opt ( TAG , CHILD )

Same of I<get_elem_opt()> but this element as a child of an element.

=head2 is_attr_fix ( TAG , ATTR )

Return I<TRUE> if an attribute is I<FIXED>.

=head2 is_attr_req ( TAG , ATTR )

Return I<TRUE> if an attribute is I<REQUIRED>.

=head2 is_elem_any ( TAG )

Return I<TRUE> if an element is I<ANY>.

=head2 is_elem_child_multi ( TAG , CHILD )

Return I<TRUE> if an element can have multiple occurrences as a child of TAG.

=head2 is_elem_child_opt ( TAG , CHILD )

Return I<TRUE> if an element is optional as a child of TAG.

=head2 is_elem_child_req ( TAG , CHILD )

Return I<TRUE> if an element is optional as a child of TAG.

=head2 is_elem_child_uniq ( TAG , CHILD )

Return I<TRUE> if an element is required and unique as a child of TAG.

=head2 is_elem_pcdata ( TAG )

Return I<TRUE> if an element is I<PCDATA> (have content).

=head2 is_elem_empty ( TAG )

Return I<TRUE> if an element is I<EMPTY> (doesn't have attributes, content or children).

=head2 is_elem_multi ( TAG )

Return I<TRUE> if an element can have multiple occurrences globally.

=head2 is_elem_opt ( TAG )

Return I<TRUE> if an element is optional globally.

=head2 is_elem_parent ( TAG , @PARENTS )

Return I<TRUE> if the list of @PARENTS can be parent of element TAG.

=head2 is_elem_req

Return I<TRUE> if an element is required globally.

=head2 is_elem_uniq

Return I<TRUE> if an element is unique and required globally.

=head2 root

Return the root name of the DTD.

=head2 tree

Return the HASH tree of the DTD.

=head1 SEE ALSO

L<XML::Smart>, L<XML::DTDParser>.

=head1 AUTHOR

Graciliano M. P. <gm@virtuasites.com.br>

I will appreciate any type of feedback (include your opinions and/or suggestions). ;-P

=head1 THANKS

Thanks to Jenda@Krynicky.cz http://Jenda.Krynicky.cz that is the author of L<XML::DTDParser>.

=head1 COPYRIGHT

The DTD parser was based on XML-DTDParser-1.7 by Jenda@Krynicky.cz http://Jenda.Krynicky.cz

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut