XML-Smart

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN


1.5.7 2004-03-23
    - Fixed minor bug with BINARY data and XML::Parser, that handles each line
      of a content as a multiple content.
    
    * Thanks to Rusty Allen <mallen8@houston.sns.slb.com> for the extensive tests
      of CDATA and BINARY handling of XML::Smart.


1.5.6 2004-03-23
    - Fixed minor mistake on set_cdata() method and cdata id inside data().


1.5.5 2004-03-23
    - Added methods set_auto() , set_auto_node(), set_binary(), set_cdata().
    - Fixed bug on copy().
    - Fixed bug with data() when CONTENT key is found and should be CDATA or BINARY.


1.5.4 2004-02-23
    - Added autoload of parts of the module, to save load memory.


1.5.3 2004-02-23
    - Just minor changes and fixes.

lib/XML/Smart.pm  view on Meta::CPAN


	}
    }
    
}

#############
# SET_CDATA #
#############

sub set_cdata {
    my $this = shift ;
    $this->set_node_type('cdata',@_) ;
}

##############
# SET_BINARY #
##############

sub set_binary {
    my $this = shift ;
    $this->set_node_type('binary',@_) ;
}

lib/XML/Smart.pm  view on Meta::CPAN


  <root>aaaaa<tag1 arg="1"/>bbbbb</root>

=head2  copy()

Return a copy of the XML::Smart object (pointing to the base).

** This is good when you want to keep 2 versions of the same XML tree in the memory,
since one object can't change the tree of the other!

B<WARNING:> set_node(), set_cdata() and set_binary() changes are not persistant over copy - 
Once you create a second copy these states are lost.

b<warning:> do not copy after apply_dtd() unless you have checked for dtd errors.

=head2  cut_root()

Cut the root key:

  my $srv = $XML->{rootx}{host}{server} ;
  

lib/XML/Smart.pm  view on Meta::CPAN

=head2 save (FILEPATH , OPTIONS)

Save the XML data inside a file.

Accept the same OPTIONS of the method B<I<data()>>.

=head2  set_auto

Define the key to be handled automatically. Soo, data() will define automatically if it's a node, content or attribute.

I<** This method is useful to remove set_node(), set_cdata() and set_binary() changes.>


=head2  set_auto_node

Define the key as a node, and data() will define automatically if it's CDATA or BINARY.

I<** This method is useful to remove set_cdata() and set_binary() changes.>

=head2  set_binary(BOOL)

Define the node as a BINARY content when TRUE, or force to B<not> handle it as a BINARY on FALSE.

Example of node handled as BINARY:

  <root><foo dt:dt="binary.base64">PGgxPnRlc3QgAzwvaDE+</foo></root>

Original content of foo (the base64 data):

  <h1>test \x03</h1>

=head2  set_cdata(BOOL)

Define the node as CDATA when TRUE, or force to B<not> handle it as CDATA on FALSE.

Example of CDATA node:

  <root><foo><![CDATA[bla bla bla <tag> bla bla]]></foo></root>

=head2  set_node(BOOL)

Set/unset the current key as a node (tag).

lib/XML/Smart/DTD.pm  view on Meta::CPAN

  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 #
#################

lib/XML/Smart/DTD.pm  view on Meta::CPAN

    }
    ++$$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} = {} ;
          }
        }

lib/XML/Smart/DTD.pm  view on Meta::CPAN

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.

lib/XML/Smart/Data.pm  view on Meta::CPAN

    if ( $cont ne '' ) {
      my ( $po , $p1 ) = @$cont ;
      my $cont = substr($tags , $po , $p1) ;
        
      my $tp = _data_type($cont) ;
      
      if ( $node_type =~ /^(\w+),(\d+),(\d*)$/ ) {
        my ( $node_tp , $node_set ) = ($1,$2) ;

        if ( !$node_set ) {
          if    ( $tp == 3 && $node_tp eq 'cdata'  ) { $tp = 0 ;}
          elsif ( $tp == 4 && $node_tp eq 'binary' ) { $tp = 0 ;}
        }
        else {
          if    ( $node_tp eq 'cdata'  ) { $tp = 3 ;}
          elsif ( $node_tp eq 'binary' ) { $tp = 4 ;}
        }
      }
      
      if ( $tp == 3 ) { $cont = "<![CDATA[$cont]]>" ;}
      elsif ( $tp == 4 ) {
        require XML::Smart::Base64 ;
        $cont = &XML::Smart::Base64::encode_base64($cont) ;
        $cont =~ s/\s$//s ;
        $args .= ' dt:dt="binary.base64"' ;

lib/XML/Smart/Data.pm  view on Meta::CPAN

        }
        elsif (ref($value) eq 'SCALAR') { $value = $$value ;}
        elsif (ref($value) ne 'ARRAY') { $value = "$value" ;}
      }
      if ( $do_val && $value ne '') {
        my $tp = _data_type($value) ;
        
        if ( $node_type =~ /^(\w+),(\d+),(\d*)$/ ) {
          my ( $node_tp , $node_set ) = ($1,$2) ;
          if ( !$node_set ) {
            if    ( $tp == 3 && $node_tp eq 'cdata'  ) { $tp = 0 ;}
            elsif ( $tp == 4 && $node_tp eq 'binary' ) { $tp = 0 ;}
          }
          else {
            if    ( $node_tp eq 'cdata'  ) { $tp = 3 ;}
            elsif ( $node_tp eq 'binary' ) { $tp = 4 ;}
          }
        }
        
        if ($tp <= 2) {
          $c++ ;
          my $cont = $value ; &_add_basic_entity($value) ;
          &_add_basic_entity($cont) ;
          $tags .= qq`$ident<$tag>$cont</$tag>`;
          $v = $cont if $c == 1 ;

lib/XML/Smart/Tree.pm  view on Meta::CPAN

    my $data = shift ;

    my @data = split( //, $data ) ;
    my $data_len = @data          ;
    

    # State Machine Definition: 

    my %state_machine = 
	(
	 'in_cdata_block'            =>  0 ,
	 'seen_some_tag'             =>  0 ,
	 'need_to_cdata_this'        =>  0 ,
	 'prev_lt'                   => -1 ,
	 'last_tag_start'            => -1 ,
	 'last_tag_close'            => -1 ,
	 'tag_balance'               =>  0 ,
	);
	  

    CHAR: for( my $index = 0; $index < $data_len; $index++ ) { 

	{ 
	    no warnings ;
	    next CHAR unless( $data[ $index ] eq '<' or $data[ $index ] eq '>' ) ;
	}

	if( $data[ $index ] eq '<' ) { 

	    next CHAR if( $state_machine{ 'in_cdata_block' } ) ;
	    
	    { 
		# Check for possibility of this being a cdata block
		my $possible_cdata_block = join( '', @data[ $index .. ( $index + 8 ) ] ) ;
		if( $possible_cdata_block eq '<![CDATA[' ) { 
		    $state_machine{ 'in_cdata_block' } = 1 ;
		    next CHAR                              ;
		}
		
	    }

	    $state_machine{ 'tag_balance'    }++ ;
	    $state_machine{ 'prev_lt' } = $index ;
	    
	    next CHAR if( $state_machine{ 'need_to_cdata_this' } ) ;
	    	    
	    unless( $state_machine{ 'seen_some_tag' } ) { 
		$state_machine{ 'seen_some_tag' }  = 1      ;
		$state_machine{ 'last_tag_start' } = $index ;
		next CHAR                                   ;
	    } 
	    
	    if( $state_machine{ 'tag_balance' } == 1 ) { 
		$state_machine{ 'last_tag_start' } = $index ;
		next CHAR ;
	    }

	    $state_machine{ 'need_to_cdata_this' } = 1 ;

	    ## Seen a < and 
	    #    1. We are not in a CDATA block
	    #    2. This is not the start of a CDATA block


	} elsif( $data[ $index ] eq '>' ) { 


	    if( $state_machine{ 'in_cdata_block' } ) { 
		
		my $possible_cdata_close = join( '', @data[ ( $index - 2 ) .. $index ] ) ;
		if( $possible_cdata_close eq ']]>' ) {
		    $state_machine{ 'in_cdata_block' } = 0 ;
		    $state_machine{ 'tag_balance'    } = 0 ;
		    next CHAR                              ;
		}
		
		next CHAR ;
	    }
	    
	    unless( $state_machine{ 'seen_some_tag' } ) { 
		croak " > found before < - Input XML seems to have errors!\n";
	    }

lib/XML/Smart/Tree.pm  view on Meta::CPAN

	    

	    ## Need to add CDATA now.

	    my $last_tag_close = $state_machine{ 'last_tag_close' } ;
	    my $prev_lt        = $state_machine{ 'prev_lt'        } ;
	    $data[ $last_tag_close ] = '><![CDATA[' ;
	    $data[ $prev_lt        ] = ']]><'       ;

	    $state_machine{ 'last_tag_close'     } = $index ;
	    $state_machine{ 'need_to_cdata_this' } = 0      ;

	    $state_machine{ 'tag_balance'        } = 0      ;
	    
	}

    }

    $data = join( '', @data ) ;

    return $data;

t/base_tests.t  view on Meta::CPAN

  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  

  cmp_ok( ref $XML->tree->{ root }{ foo }, 'eq', 'HASH' ) ;

  $XML->{root}{foo}->set_node(0) ;

  cmp_ok( ref $XML->tree->{ root }{ foo }, 'eq', '' ) ;
  is( $XML->tree->{root}{'/nodes'}{foo}, undef ) ;
  
  $XML->{root}{foo}->set_cdata(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,1,' )   ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT} , 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_node(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,1,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT},  'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_binary(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,1,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_binary(0) ;

  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,0,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_auto_node ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 1 ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_cdata(0) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,0,1'   ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;
  
  $XML->{root}{foo}->set_binary(0) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,0,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;

  cmp_ok( ref( $XML->tree->{root}{foo} ), 'eq', 'HASH' ) ; 
  $XML->{root}{foo}->set_auto ;

t/base_tests.t  view on Meta::CPAN



subtest 'Default Parser CDATA and Bin data tests' => sub {

  my $XML = new XML::Smart ;
  $XML->{root}{foo} = "bla bla bla <tag> bla bla";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[bla bla bla <tag> bla bla]]></foo></root>' ) ;

  $XML->{root}{foo}->set_cdata(0) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo>bla bla bla &lt;tag&gt; bla bla</foo></root>' ) ;
  
  $XML->{root}{foo}->set_binary(1) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok ($data, 'eq', '<root><foo dt:dt="binary.base64">YmxhIGJsYSBibGEgPHRhZz4gYmxhIGJsYQ==</foo></root>' ) ;

  done_testing() ;

t/base_tests.t  view on Meta::CPAN


subtest 'Default Parser CDATA test' => sub {


  my $XML = new XML::Smart ;
  $XML->{root}{foo} = "simple";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root foo="simple"/>' ) ;
  
  $XML->{root}{foo}->set_cdata(1) ;

  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[simple]]></foo></root>' ) ;
  
  done_testing() ;

} ;
#########################


t/base_tests.t  view on Meta::CPAN



subtest 'Default Parser CDATA and funny chars' => sub {

  my $XML = new XML::Smart ;
  $XML->{root}{foo} = "<words>foo bar baz</words>";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[<words>foo bar baz</words>]]></foo></root>' ) ;
  
  $XML->{root}{foo}->set_cdata(0) ;

  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo>&lt;words&gt;foo bar baz&lt;/words&gt;</foo></root>' ) ;  

  done_testing() ;

} ;
#########################


t/base_tests.t  view on Meta::CPAN

  isnt( $dtd->elem_exists('br') , undef ) ;  
  
  isnt( $dtd->is_elem_req('requisito') , undef ) ;
  isnt( $dtd->is_elem_uniq('requisito') , undef ) ;
  
  isnt( $dtd->is_elem_opt('curriculo') , undef ) ;
  isnt( !$dtd->is_elem_req('curriculo') , undef ) ;
  
  isnt( $dtd->is_elem_multi('professor') , undef ) ;
  
  isnt( $dtd->is_elem_pcdata('professor') , undef ) ;
  isnt( $dtd->is_elem_empty('br') , undef ) ;

  isnt( $dtd->attr_exists('curso','centro') , undef ) ;
  isnt( $dtd->attr_exists('curso','nome') , undef ) ;
  
  isnt( $dtd->attr_exists('curso','centro','nome') , undef ) ;
  
  is( $dtd->attr_exists('curso','centro','nomes'), undef ) ;
  
  my @attrs = $dtd->get_attrs('curso', undef ) ;

t/base_tests_for_mem_leak.t  view on Meta::CPAN

  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  

  cmp_ok( ref $XML->tree->{ root }{ foo }, 'eq', 'HASH' ) ;

  $XML->{root}{foo}->set_node(0) ;

  cmp_ok( ref $XML->tree->{ root }{ foo }, 'eq', '' ) ;
  is( $XML->tree->{root}{'/nodes'}{foo}, undef ) ;
  
  $XML->{root}{foo}->set_cdata(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,1,' )   ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT} , 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_node(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,1,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT},  'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_binary(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,1,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_binary(0) ;

  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,0,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_auto_node ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 1 ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_cdata(0) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,0,1'   ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;
  
  $XML->{root}{foo}->set_binary(0) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,0,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;

  cmp_ok( ref( $XML->tree->{root}{foo} ), 'eq', 'HASH' ) ; 
  $XML->{root}{foo}->set_auto ;

t/base_tests_for_mem_leak.t  view on Meta::CPAN


subtest 'Default Parser CDATA and Bin data tests' => sub {

  my $XML = new XML::Smart ;
  $$XML->{ DEV_DEBUG } = 1 ;
  $XML->{root}{foo} = "bla bla bla <tag> bla bla";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[bla bla bla <tag> bla bla]]></foo></root>' ) ;

  $XML->{root}{foo}->set_cdata(0) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo>bla bla bla &lt;tag&gt; bla bla</foo></root>' ) ;
  
  $XML->{root}{foo}->set_binary(1) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok ($data, 'eq', '<root><foo dt:dt="binary.base64">YmxhIGJsYSBibGEgPHRhZz4gYmxhIGJsYQ==</foo></root>' ) ;

  done_testing() ;

t/base_tests_for_mem_leak.t  view on Meta::CPAN

subtest 'Default Parser CDATA test' => sub {


  my $XML = new XML::Smart ;
  $$XML->{ DEV_DEBUG } = 1 ;
  $XML->{root}{foo} = "simple";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root foo="simple"/>' ) ;
  
  $XML->{root}{foo}->set_cdata(1) ;

  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[simple]]></foo></root>' ) ;
  
  done_testing() ;

} ;
#########################


t/base_tests_for_mem_leak.t  view on Meta::CPAN


subtest 'Default Parser CDATA and funny chars' => sub {

  my $XML = new XML::Smart ;
  $$XML->{ DEV_DEBUG } = 1 ;
  $XML->{root}{foo} = "<words>foo bar baz</words>";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[<words>foo bar baz</words>]]></foo></root>' ) ;
  
  $XML->{root}{foo}->set_cdata(0) ;

  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo>&lt;words&gt;foo bar baz&lt;/words&gt;</foo></root>' ) ;  

  done_testing() ;

} ;
#########################


t/base_tests_for_mem_leak.t  view on Meta::CPAN

  isnt( $dtd->elem_exists('br') , undef ) ;  
  
  isnt( $dtd->is_elem_req('requisito') , undef ) ;
  isnt( $dtd->is_elem_uniq('requisito') , undef ) ;
  
  isnt( $dtd->is_elem_opt('curriculo') , undef ) ;
  isnt( !$dtd->is_elem_req('curriculo') , undef ) ;
  
  isnt( $dtd->is_elem_multi('professor') , undef ) ;
  
  isnt( $dtd->is_elem_pcdata('professor') , undef ) ;
  isnt( $dtd->is_elem_empty('br') , undef ) ;

  isnt( $dtd->attr_exists('curso','centro') , undef ) ;
  isnt( $dtd->attr_exists('curso','nome') , undef ) ;
  
  isnt( $dtd->attr_exists('curso','centro','nome') , undef ) ;
  
  is( $dtd->attr_exists('curso','centro','nomes'), undef ) ;
  
  my @attrs = $dtd->get_attrs('curso', undef ) ;

t/base_tests_for_objcopy.t  view on Meta::CPAN

  

  cmp_ok( ref $XML->tree->{ root }{ foo }, 'eq', 'HASH' ) ;

  $XML->{root}{foo}->set_node(0) ;

  cmp_ok( ref $XML->tree->{ root }{ foo }, 'eq', '' ) ;
  is( $XML->tree->{root}{'/nodes'}{foo}, undef ) ;
  

  ## Cannot copy object between set_cdata( 1 ), set_node( 1 ), set_binary( 1 ) and unset of same.
  $XML->{root}{foo}->set_cdata(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,1,' )   ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT} , 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_node(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,1,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT},  'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_binary(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,1,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_binary(0) ;

  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,0,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_auto_node ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 1 ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_cdata(0) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,0,1'   ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;
  
  $XML->{root}{foo}->set_binary(0) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,0,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;

  cmp_ok( ref( $XML->tree->{root}{foo} ), 'eq', 'HASH' ) ; 
  $XML->{root}{foo}->set_auto ;

t/base_tests_for_objcopy.t  view on Meta::CPAN

subtest 'Default Parser CDATA and Bin data tests' => sub {

  my $XML = new XML::Smart ;
  $XML = $XML->copy() ;
  $XML->{root}{foo} = "bla bla bla <tag> bla bla";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[bla bla bla <tag> bla bla]]></foo></root>' ) ;


  ## Cannot copy object between set_cdata( 1 ), set_node( 1 ), set_binary( 1 ) and unset of same.
  $XML->{root}{foo}->set_cdata(0) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo>bla bla bla &lt;tag&gt; bla bla</foo></root>' ) ;
  
  $XML->{root}{foo}->set_binary(1) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok ($data, 'eq', '<root><foo dt:dt="binary.base64">YmxhIGJsYSBibGEgPHRhZz4gYmxhIGJsYQ==</foo></root>' ) ;

  done_testing() ;

t/base_tests_for_objcopy.t  view on Meta::CPAN



  my $XML = new XML::Smart ;
  $XML = $XML->copy() ;
  $XML->{root}{foo} = "<h1>test \x03</h1>";
  $XML = $XML->copy() ;

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo dt:dt="binary.base64">PGgxPnRlc3QgAzwvaDE+</foo></root>' ) ;

  ## Cannot copy object between set_cdata( 1 ), set_node( 1 ), set_binary( 1 ) and unset of same.

  $XML->{root}{foo}->set_binary(0) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', "<root><foo>&lt;h1&gt;test \x03\&lt;/h1&gt;</foo></root>") ;
  
  $XML->{root}{foo}->set_binary(1) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo dt:dt="binary.base64">PGgxPnRlc3QgAzwvaDE+</foo></root>' ) ;

t/base_tests_for_objcopy.t  view on Meta::CPAN

subtest 'Default Parser CDATA test' => sub {


  my $XML = new XML::Smart ;
  $XML = $XML->copy() ;
  $XML->{root}{foo} = "simple";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root foo="simple"/>' ) ;
  
  $XML->{root}{foo}->set_cdata(1) ;

  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[simple]]></foo></root>' ) ;
  
  done_testing() ;

} ;
#########################


t/base_tests_for_objcopy.t  view on Meta::CPAN

subtest 'Default Parser CDATA and funny chars' => sub {


  my $XML = new XML::Smart ;
  $XML->{root}{foo} = "<words>foo bar baz</words>";
  $XML = $XML->copy() ;

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[<words>foo bar baz</words>]]></foo></root>' ) ;

  ## Cannot copy object between set_cdata( 1 ), set_node( 1 ), set_binary( 1 ) and unset of same.  
  $XML->{root}{foo}->set_cdata(0) ;

  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo>&lt;words&gt;foo bar baz&lt;/words&gt;</foo></root>' ) ;  

  done_testing() ;

} ;
#########################


t/base_tests_for_objcopy.t  view on Meta::CPAN

  isnt( $dtd->elem_exists('br') , undef ) ;  
  
  isnt( $dtd->is_elem_req('requisito') , undef ) ;
  isnt( $dtd->is_elem_uniq('requisito') , undef ) ;
  
  isnt( $dtd->is_elem_opt('curriculo') , undef ) ;
  isnt( !$dtd->is_elem_req('curriculo') , undef ) ;
  
  isnt( $dtd->is_elem_multi('professor') , undef ) ;
  
  isnt( $dtd->is_elem_pcdata('professor') , undef ) ;
  isnt( $dtd->is_elem_empty('br') , undef ) ;

  isnt( $dtd->attr_exists('curso','centro') , undef ) ;
  isnt( $dtd->attr_exists('curso','nome') , undef ) ;
  
  isnt( $dtd->attr_exists('curso','centro','nome') , undef ) ;
  
  is( $dtd->attr_exists('curso','centro','nomes'), undef ) ;
  
  my @attrs = $dtd->get_attrs('curso', undef ) ;

t/base_tests_multi_obj.t  view on Meta::CPAN

  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  

  cmp_ok( ref $XML->tree->{ root }{ foo }, 'eq', 'HASH' ) ;

  $XML->{root}{foo}->set_node(0) ;

  cmp_ok( ref $XML->tree->{ root }{ foo }, 'eq', '' ) ;
  is( $XML->tree->{root}{'/nodes'}{foo}, undef ) ;
  
  $XML->{root}{foo}->set_cdata(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,1,' )   ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT} , 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_node(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,1,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT},  'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_binary(1) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,1,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_binary(0) ;

  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,0,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_auto_node ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 1 ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;  
  
  $XML->{root}{foo}->set_cdata(0) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'cdata,0,1'   ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;
  
  $XML->{root}{foo}->set_binary(0) ;
  
  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', 'binary,0,1' ) ;
  cmp_ok( $XML->tree->{root}{foo}{CONTENT}, 'eq', "bla bla bla" ) ;

  cmp_ok( ref( $XML->tree->{root}{foo} ), 'eq', 'HASH' ) ; 
  $XML->{root}{foo}->set_auto ;

t/base_tests_multi_obj.t  view on Meta::CPAN



subtest 'Default Parser CDATA and Bin data tests' => sub {

  my $XML = new XML::Smart ;
  $XML->{root}{foo} = "bla bla bla <tag> bla bla";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[bla bla bla <tag> bla bla]]></foo></root>' ) ;

  $XML->{root}{foo}->set_cdata(0) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo>bla bla bla &lt;tag&gt; bla bla</foo></root>' ) ;
  
  $XML->{root}{foo}->set_binary(1) ;
  
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok ($data, 'eq', '<root><foo dt:dt="binary.base64">YmxhIGJsYSBibGEgPHRhZz4gYmxhIGJsYQ==</foo></root>' ) ;

  done_testing() ;

t/base_tests_multi_obj.t  view on Meta::CPAN


subtest 'Default Parser CDATA test' => sub {


  my $XML = new XML::Smart ;
  $XML->{root}{foo} = "simple";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root foo="simple"/>' ) ;
  
  $XML->{root}{foo}->set_cdata(1) ;

  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[simple]]></foo></root>' ) ;
  
  done_testing() ;

} ;
#########################


t/base_tests_multi_obj.t  view on Meta::CPAN



subtest 'Default Parser CDATA and funny chars' => sub {

  my $XML = new XML::Smart ;
  $XML->{root}{foo} = "<words>foo bar baz</words>";

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo><![CDATA[<words>foo bar baz</words>]]></foo></root>' ) ;
  
  $XML->{root}{foo}->set_cdata(0) ;

  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', '<root><foo>&lt;words&gt;foo bar baz&lt;/words&gt;</foo></root>' ) ;  

  done_testing() ;

} ;
#########################


t/base_tests_multi_obj.t  view on Meta::CPAN

  isnt( $dtd->elem_exists('br') , undef ) ;  
  
  isnt( $dtd->is_elem_req('requisito') , undef ) ;
  isnt( $dtd->is_elem_uniq('requisito') , undef ) ;
  
  isnt( $dtd->is_elem_opt('curriculo') , undef ) ;
  isnt( !$dtd->is_elem_req('curriculo') , undef ) ;
  
  isnt( $dtd->is_elem_multi('professor') , undef ) ;
  
  isnt( $dtd->is_elem_pcdata('professor') , undef ) ;
  isnt( $dtd->is_elem_empty('br') , undef ) ;

  isnt( $dtd->attr_exists('curso','centro') , undef ) ;
  isnt( $dtd->attr_exists('curso','nome') , undef ) ;
  
  isnt( $dtd->attr_exists('curso','centro','nome') , undef ) ;
  
  is( $dtd->attr_exists('curso','centro','nomes'), undef ) ;
  
  my @attrs = $dtd->get_attrs('curso', undef ) ;



( run in 0.647 second using v1.01-cache-2.11-cpan-454fe037f31 )