view release on metacpan or  search on metacpan

t/base_tests_for_objcopy.t  view on Meta::CPAN

  
  my $XML = XML::Smart->new() ;
  $XML = $XML->copy() ;
  
  $XML->{menu}{arg2} = 456 ;
  $XML->{menu}{arg1} = 123 ;
  $XML = $XML->copy() ;
  
  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', q`<menu arg2="456" arg1="123"/>` ) ;

  # Cannot copy object between set_node and set_node( 0 )
  $XML->{menu}{arg2}->set_node ;
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', q`<menu arg1="123"><arg2>456</arg2></menu>` ) ;

  $XML->{menu}{arg2}->set_node(0) ;
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', q`<menu arg2="456" arg1="123"/>` ) ;
  
  $XML->{menu}->set_order('arg1' , 'arg2') ;
  $XML = $XML->copy() ;
  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', q`<menu arg1="123" arg2="456"/>` ) ;
  
  delete $XML->{menu}{arg2}[0] ;

  $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', q`<menu arg1="123"/>` ) ;

  done_testing() ;

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




subtest 'Default Parser XML Structure verification' => sub {


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

  $XML->{root}{foo}->set_node(1) ;
  $XML = $XML->copy() ;

  cmp_ok( $XML->tree->{root}{'/nodes'}{foo}, 'eq', '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_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 ;

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

  done_testing() ;

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






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() ;

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





subtest 'Default Parser Funny Chars, Hex and Bin data Test' => sub {


  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>' ) ;

  done_testing() ;

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





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() ;

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





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() ;

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






subtest 'Default Parser' => sub {
  
  my $XML = XML::Smart->new(q`<?xml version="1.0"?>
  <root>
    <entry><b>here's</b> a <i>test</i></entry>
  </root>
  `, 'XML::Parser');
  $XML = $XML->copy() ;

  my $data = $XML->data(nospace => 1 , noheader => 1 ) ;
  cmp_ok( $data, 'eq', "<root><entry><b>here's</b> a <i>test</i></entry></root>") ;  

  done_testing() ;

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





subtest 'XML::Smart::Parser Path and XPath Tests' => sub {


  my $XML = XML::Smart->new($DATA , 'XML::Smart::Parser') ;
  $XML = $XML->copy() ;
  $XML = $XML->{hosts} ;
  
  my $addr = $XML->{'server'}('type','eq','suse'){'address'} ;
  
  cmp_ok( $addr->path, 'eq', '/hosts/server[1]/address' ) ;
  
  my $addr0 = $XML->{'server'}('type','eq','suse'){'address'}[0] ;
  
  cmp_ok( $addr0->path , 'eq',  '/hosts/server[1]/address[0]') ;
  cmp_ok( $addr0->path_as_xpath , 'eq',  '/hosts/server[2]/address') ;
  
  my $addr1 = $XML->{'server'}('type','eq','suse'){'address'}[1] ;
  
  my $type = $XML->{'server'}('version','>=','9'){'type'} ;

  cmp_ok($type->path , 'eq',  '/hosts/server[2]/type') ;
  
  $addr = $XML->{'server'}('version','>=','9'){'address'} ;

  cmp_ok($addr->path , 'eq',  '/hosts/server[2]/address') ;

t/base_tests_for_objcopy.t  view on Meta::CPAN

  
  delete $XML->{hosts}{tmp} ;
  $XML = $XML->copy() ;
  
  my $data = $XML->XPath->findnodes_as_string('/') ;
  
  cmp_ok( $data, 'eq', q`<hosts><server os="linux" type="redhat" version="8.0"><address>192.168.0.1</address><address>192.168.0.2</address></server><server os="linux" type="suse" version="7.0"><address>192.168.1.10</address><address>192.168.1.20</add...

  done_testing() ;

} ;

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



subtest 'XML::Smart::DTD Tests' => sub {

  use XML::Smart::DTD ;

  my $dtd = XML::Smart::DTD->new(q`
<!DOCTYPE curso [
<!ELEMENT curso (objetivo|descricao , curriculo? , aluno+ , professor+)>
<!ATTLIST curso
          centro  CDATA #REQUIRED
          nome    (a|b|c|"a simple | test",d) #REQUIRED "a"
          age    CDATA
>
<!ELEMENT objetivo (#PCDATA)>
<!ELEMENT curriculo (disciplina+)>
<!ELEMENT disciplina (requisito , professor+)>
<!ATTLIST disciplina
          codigo     CDATA #REQUIRED
          ementa     CDATA #REQUIRED
>
<!ELEMENT descricao (#PCDATA)>
<!ELEMENT requisito (#PCDATA)>
<!ELEMENT professor (#PCDATA)>
<!ELEMENT br EMPTY>
]>
  `) ;
  

  isnt( $dtd->elem_exists('curso') , undef ) ;
  isnt( $dtd->elem_exists('objetivo') , undef ) ;
  isnt( $dtd->elem_exists('curriculo') , undef ) ;
  isnt( $dtd->elem_exists('disciplina') , undef ) ;
  isnt( $dtd->elem_exists('descricao') , undef ) ;
  isnt( $dtd->elem_exists('requisito') , undef ) ;  
  isnt( $dtd->elem_exists('professor') , undef ) ;  
  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 ) ;
  cmp_ok( join(" ",@attrs), 'eq', 'centro nome age' ) ;
  
  @attrs = $dtd->get_attrs_req('curso') ;
  cmp_ok( join(" ",@attrs) , 'eq', 'centro nome') ;

  done_testing() ;
  
} ;
#########################






subtest 'Default Parser cds Tests' => sub {

  my $xml = XML::Smart->new()->{cds} ;
  $xml = $xml->copy() ;
  

  # Cannot copy object and expect previous state to remain ! 
  $xml->{album}[0] = {
      title => 'foo' ,
      artist => 'the foos' ,
      tracks => 8 ,
  } ;
  
  $xml->{album}[1] = {
      title => 'bar' ,
      artist => 'the barss' ,
      tracks => [qw(6 7)] ,
      time => [qw(60 70)] ,
      type => 'b' ,
  } ;

  $xml->{album}[2] = {
      title => 'baz' ,
      artist => undef ,
      tracks => 10 ,
      type => '' ,
      br => 123 ,
  } ;
  
  $xml->{creator} = 'Joe' ;
  $xml->{date} = '2000-01-01' ;
  $xml->{type} = 'a' ;
  
  $xml->{album}[0]{title}->set_node(1);