├── test_uri ├── t ├── test_new_features_3_22.xml ├── test_with_lwp.xml ├── test4.t ├── test_with_lwp_not_wf.xml ├── test_xml_split │ ├── test_xml_split_expected-1-01.xml │ ├── test_xml_split_expected-1-02.xml │ ├── test_xml_split_expected-1-03.xml │ ├── test_xml_split_expected-10-01.xml │ ├── test_xml_split_expected-10-02.xml │ ├── test_xml_split_expected-10-03.xml │ ├── test_xml_split_expected-2-01.xml │ ├── test_xml_split_expected-2-02.xml │ ├── test_xml_split_expected-2-03.xml │ ├── test_xml_split_expected-3-01.xml │ ├── test_xml_split_expected-3-02.xml │ ├── test_xml_split_expected-3-03.xml │ ├── test_xml_split_expected-3-04.xml │ ├── test_xml_split_expected-3-05.xml │ ├── test_xml_split_expected-3-06.xml │ ├── test_xml_split_expected-3-07.xml │ ├── test_xml_split_expected-3-08.xml │ ├── test_xml_split_expected-3-09.xml │ ├── test_xml_split_expected-4-01.xml │ ├── test_xml_split_expected-4-02.xml │ ├── test_xml_split_expected-4-03.xml │ ├── test_xml_split_expected-4-04.xml │ ├── test_xml_split_expected-4-05.xml │ ├── test_xml_split_expected-4-06.xml │ ├── test_xml_split_expected-4-07.xml │ ├── test_xml_split_expected-4-08.xml │ ├── test_xml_split_expected-4-09.xml │ ├── test_xml_split_expected-9-01.xml │ ├── test_xml_split_expected-9-02.xml │ ├── test_xml_split_expected-9-03.xml │ ├── test_xml_split_expected-13-01.xml │ ├── test_xml_split_expected-13-02.xml │ ├── test_xml_split_expected-14-02.xml │ ├── test_xml_split_expected-15-01.xml │ ├── test_xml_split_expected-15-02.xml │ ├── test_xml_split_expected-16-01.xml │ ├── test_xml_split_expected-16-02.xml │ ├── test_xml_split_expected-16-03.xml │ ├── test_xml_split_expected-17-01.xml │ ├── test_xml_split_expected-17-02.xml │ ├── test_xml_split_expected-17-03.xml │ ├── test_xml_split_expected-17-04.xml │ ├── test_xml_split_expected-17-05.xml │ ├── test_xml_split_expected-17-06.xml │ ├── test_xml_split_expected-17-07.xml │ ├── test_xml_split_expected-17-08.xml │ ├── test_xml_split_expected-17-09.xml │ ├── test_xml_split_expected-19-01.xml │ ├── test_xml_split_expected-19-02.xml │ ├── test_xml_split_expected-19-03.xml │ ├── test_xml_split_expected-7-02.xml │ ├── test_xml_split_expected-8-02.xml │ ├── test_xml_split_expected-7-00.xml │ ├── test_xml_split_expected-8-00.xml │ ├── test_xml_split_expected-1-04.xml │ ├── test_xml_split_expected-10-04.xml │ ├── test_xml_split_expected-11-00.xml │ ├── test_xml_split_expected-12-00.xml │ ├── test_xml_split_expected-2-04.xml │ ├── test_xml_split_expected-5-01.xml │ ├── test_xml_split_expected-6-01.xml │ ├── test_xml_split_expected-9-04.xml │ ├── test_xml_split_expected-14-00.xml │ ├── test_xml_split_expected-5-02.xml │ ├── test_xml_split_expected-6-02.xml │ ├── test_xml_split_expected-20-00.xml │ ├── test_xml_split_expected-16-04.xml │ ├── test_xml_split_expected-19-04.xml │ ├── test_xml_split_expected-21-03.xml │ ├── test_xml_split_expected-6-03.xml │ ├── test_xml_split_expected-13-00.xml │ ├── test_xml_split_expected-15-00.xml │ ├── test_xml_split_expected-5-03.xml │ ├── test_xml_split_expected-18-01.xml │ ├── test_xml_split_expected-21-01.xml │ ├── test_xml_split_expected-1-05.xml │ ├── test_xml_split_expected-14-01.xml │ ├── test_xml_split_expected-2-05.xml │ ├── test_xml_split_expected-9-05.xml │ ├── test_xml_split_expected-10-05.xml │ ├── test_xml_split_expected-16-05.xml │ ├── test_xml_split_expected-19-05.xml │ ├── test_xml_split_expected-18-02.xml │ ├── test_xml_split_expected-18-00.xml │ ├── test_xml_split_expected-21-02.xml │ ├── test_xml_split_expected-5-00.xml │ ├── test_xml_split_expected-6-00.xml │ ├── test_xml_split_expected-18-03.xml │ ├── test_xml_split_expected-2-00.xml │ ├── test_xml_split_expected-1-00.xml │ ├── test_xml_split_expected-10-00.xml │ ├── test_xml_split_expected-9-00.xml │ ├── test_xml_split_expected-16-00.xml │ ├── test_xml_split_expected-19-00.xml │ ├── test_xml_split_expected-21-00.xml │ ├── test_xml_split_expected-11-01.xml │ ├── test_xml_split_expected-12-01.xml │ ├── test_xml_split_expected-7-01.xml │ ├── test_xml_split_expected-8-01.xml │ ├── test_xml_split_expected-20-01.xml │ ├── test_xml_split_expected-4-00.xml │ ├── test_xml_split_expected-3-00.xml │ └── test_xml_split_expected-17-00.xml ├── latin1_accented_char.iso-8859-1 ├── test_new_features_3_22.html ├── test_expand_external_entities.xml ├── test_expand_external_entities.dtd ├── test_xml_split_entities.xml ├── test_meta_json.t ├── test_changes.t ├── dummy.dtd ├── test_3_48.t ├── pod.t ├── test_xml_split.xml ├── pod_coverage.t ├── test_xml_split_w_decl.xml ├── xmlxpath_tools.pm ├── test2_2.dtd ├── test_kwalitee.t ├── test_even_more_coverage.t ├── xmlxpath_04pos.t ├── xmlxpath_02descendant.t ├── xmlxpath_22name_select.t ├── xmlxpath_13axisparent.t ├── xmlxpath_25scope.t ├── xmlxpath_29desc_with_predicate.t ├── xmlxpath_30lang.t ├── xmlxpath_26predicate.t ├── xmlxpath_19axisd_or_s.t ├── xmlxpath_20axisa_or_s.t ├── xmlxpath_06attrib_val.t ├── test_new_features_3_15.t ├── xmlxpath_03star.t ├── xmlxpath_05attrib.t ├── test_error_with_unicode_layer ├── xmlxpath_01basic.t ├── xmlxpath_14axisancestor.t ├── xmlxpath_08name.t ├── xmlxpath_09string_length.t ├── xmlxpath_10pipe.t ├── xmlxpath_15axisfol_sib.t ├── xmlxpath_07count.t ├── xmlxpath_12axisdescendant.t ├── xmlxpath_09a_string_length.t ├── test2_3.res ├── xmlxpath_18axispreceding.t ├── xmlxpath_17axisfollowing.t ├── test_3_32.t ├── xmlxpath_23func.t ├── test_3_42.t ├── test2_2.xml ├── xmlxpath_16axisprec_sib.t ├── test_drop_comments.t ├── tests_3_23.t ├── test2_2.res ├── test2_1.res ├── test2_1.exp ├── test2_2.exp ├── test_autoencoding_conversion.t ├── xmlxpath_28ancestor2.t ├── test_need_3_args_open.t ├── test_spaces.t ├── test_3_47.t ├── test2_1.xml ├── test_variables.t ├── xmlxpath_nav.t ├── test_attregexp_cond.t ├── xmlxpath_21allnodes.t ├── test_expand_external_entities.t ├── is_field.t ├── test_pos.t ├── test_class_selector.t ├── test_need_use_bytes.t ├── test_cdata.t ├── test_safe_encode.t ├── test_pi_handler.t ├── xmlxpath_test_with_handlers.t ├── test_3_55.t ├── test_comment_handler.t ├── test_erase.t ├── test_unique_xpath.t ├── test_class_methods.t ├── test_xml_split_g.t ├── test_mark.t ├── test2.t ├── test_keep_atts_order.t ├── test_3_35.t ├── test_with_lwp.t ├── test_ignore_elts.t ├── test_3_39.t ├── xmlxpath_xpath_cond.t ├── test_wrapped.t ├── test_xpath_cond.t ├── test_3_24.t ├── test_3_45.t ├── zz_dump_config.t ├── test_3_50.t ├── test_3_38.t ├── test3.t ├── xmlxpath_31vars.t ├── test_bugs_3_21.t ├── test_bugs_3_19.t └── test_memory.t ├── Changes ├── doc_utf8.xml ├── doc_latin1.xml ├── tmp_file ├── list_deps ├── filter_for_5.005 ├── html2xml ├── cover_twig ├── check_optional_modules ├── upd_changes ├── parse_random_files ├── README ├── speedup.pl └── tools └── xml_merge └── xml_merge /test_uri: -------------------------------------------------------------------------------- 1 | ok -------------------------------------------------------------------------------- /t/test_new_features_3_22.xml: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mirod/xmltwig/HEAD/Changes -------------------------------------------------------------------------------- /t/test_with_lwp.xml: -------------------------------------------------------------------------------- 1 | 2 | text 3 | 4 | -------------------------------------------------------------------------------- /t/test4.t: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mirod/xmltwig/HEAD/t/test4.t -------------------------------------------------------------------------------- /t/test_with_lwp_not_wf.xml: -------------------------------------------------------------------------------- 1 | 2 | text 3 | 4 | -------------------------------------------------------------------------------- /doc_utf8.xml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mirod/xmltwig/HEAD/doc_utf8.xml -------------------------------------------------------------------------------- /doc_latin1.xml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mirod/xmltwig/HEAD/doc_latin1.xml -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-1-01.xml: -------------------------------------------------------------------------------- 1 | elt1 content 1 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-1-02.xml: -------------------------------------------------------------------------------- 1 | elt1 content 2 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-1-03.xml: -------------------------------------------------------------------------------- 1 | elt1 content 3 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-10-01.xml: -------------------------------------------------------------------------------- 1 | elt1 content 1 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-10-02.xml: -------------------------------------------------------------------------------- 1 | elt1 content 2 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-10-03.xml: -------------------------------------------------------------------------------- 1 | elt1 content 3 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-2-01.xml: -------------------------------------------------------------------------------- 1 | elt1 content 1 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-2-02.xml: -------------------------------------------------------------------------------- 1 | elt1 content 2 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-2-03.xml: -------------------------------------------------------------------------------- 1 | elt1 content 3 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-01.xml: -------------------------------------------------------------------------------- 1 | elt1 content 1 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-02.xml: -------------------------------------------------------------------------------- 1 | elt1 content 2 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-03.xml: -------------------------------------------------------------------------------- 1 | elt1 content 3 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-04.xml: -------------------------------------------------------------------------------- 1 | elt1 content 4 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-05.xml: -------------------------------------------------------------------------------- 1 | elt1 content 5 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-06.xml: -------------------------------------------------------------------------------- 1 | elt1 content 6 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-07.xml: -------------------------------------------------------------------------------- 1 | elt1 content 7 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-08.xml: -------------------------------------------------------------------------------- 1 | elt1 content 8 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-09.xml: -------------------------------------------------------------------------------- 1 | elt1 content 9 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-01.xml: -------------------------------------------------------------------------------- 1 | elt1 content 1 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-02.xml: -------------------------------------------------------------------------------- 1 | elt1 content 2 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-03.xml: -------------------------------------------------------------------------------- 1 | elt1 content 3 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-04.xml: -------------------------------------------------------------------------------- 1 | elt1 content 4 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-05.xml: -------------------------------------------------------------------------------- 1 | elt1 content 5 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-06.xml: -------------------------------------------------------------------------------- 1 | elt1 content 6 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-07.xml: -------------------------------------------------------------------------------- 1 | elt1 content 7 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-08.xml: -------------------------------------------------------------------------------- 1 | elt1 content 8 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-09.xml: -------------------------------------------------------------------------------- 1 | elt1 content 9 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-9-01.xml: -------------------------------------------------------------------------------- 1 | elt1 content 1 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-9-02.xml: -------------------------------------------------------------------------------- 1 | elt1 content 2 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-9-03.xml: -------------------------------------------------------------------------------- 1 | elt1 content 3 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-13-01.xml: -------------------------------------------------------------------------------- 1 | text with < > & and ' -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-13-02.xml: -------------------------------------------------------------------------------- 1 | & and ']]> -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-14-02.xml: -------------------------------------------------------------------------------- 1 | & and ']]> -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-15-01.xml: -------------------------------------------------------------------------------- 1 | text with < > & and ' -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-15-02.xml: -------------------------------------------------------------------------------- 1 | & and ']]> -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-16-01.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-16-02.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 2 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-16-03.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 3 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-01.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-02.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 2 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-03.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 3 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-04.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 4 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-05.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 5 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-06.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 6 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-07.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 7 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-08.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 8 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-09.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 9 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-19-01.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-19-02.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 2 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-19-03.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 3 -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-7-02.xml: -------------------------------------------------------------------------------- 1 | & and ']]> 2 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-8-02.xml: -------------------------------------------------------------------------------- 1 | & and ']]> 2 | -------------------------------------------------------------------------------- /t/latin1_accented_char.iso-8859-1: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mirod/xmltwig/HEAD/t/latin1_accented_char.iso-8859-1 -------------------------------------------------------------------------------- /t/test_new_features_3_22.html: -------------------------------------------------------------------------------- 1 | Tt
t2

t3 -------------------------------------------------------------------------------- /tmp_file: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | fi4 7 | 8 | 9 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-7-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-8-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-1-04.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 4 3 | elt1 content 5 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-10-04.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 4 3 | elt1 content 5 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-11-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-12-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-2-04.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 4 3 | elt1 content 5 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-5-01.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 4 3 | elt1 content 5 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-6-01.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 4 3 | elt1 content 5 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-9-04.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 4 3 | elt1 content 5 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-14-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-5-02.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 6 3 | elt1 content 7 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-6-02.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 6 3 | elt1 content 7 4 | -------------------------------------------------------------------------------- /list_deps: -------------------------------------------------------------------------------- 1 | perl -MCPAN::ReverseDependencies -E'$,="\n"; $r= CPAN::ReverseDependencies->new; my @l= $r->get_reverse_dependencies( "XML-Twig"); say @l' 2 | -------------------------------------------------------------------------------- /t/test_expand_external_entities.xml: -------------------------------------------------------------------------------- 1 | 2 |

&ent1;

&ent2;

more &ent1;

3 | -------------------------------------------------------------------------------- /t/test_expand_external_entities.dtd: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | ent2 text

"> 5 | 6 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-20-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | -------------------------------------------------------------------------------- /t/test_xml_split_entities.xml: -------------------------------------------------------------------------------- 1 | 2 | text with < > & and ' 3 | & and ']]> 4 | 5 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-16-04.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 4 4 | elt1 content 5 5 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-19-04.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 4 4 | elt1 content 5 5 | -------------------------------------------------------------------------------- /t/test_meta_json.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval "use Test::CPAN::Meta::JSON"; 3 | plan skip_all => "Test::CPAN::Meta::JSON required for testing META.json" if $@; 4 | meta_json_ok(); 5 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-21-03.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 9 4 | 5 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-6-03.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 8 4 | elt1 content 9 5 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-13-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-15-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-5-03.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 8 4 | elt1 content 9 5 | -------------------------------------------------------------------------------- /filter_for_5.005: -------------------------------------------------------------------------------- 1 | # $Id: /xmltwig/trunk/filter_for_5.005 4 2007-03-16T12:16:25.259192Z mrodrigu $ 2 | if( $] < 5.006) { s{^(\s*)no warnings;}{$1# no warnings;}; } 3 | else { s{^(\s*)# no warnings; }{$1no warnings;}; } 4 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-18-01.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 1 4 | elt1 content 2 5 | 6 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-21-01.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 4 4 | elt1 content 5 5 | 6 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-1-05.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 6 4 | elt1 content 7 5 | 6 | elt1 content 8 7 | elt1 content 9 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-14-01.xml: -------------------------------------------------------------------------------- 1 | 2 | text with < > & and ' 3 | & and ']]> 4 | 5 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-2-05.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 6 4 | elt1 content 7 5 | 6 | elt1 content 8 7 | elt1 content 9 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-9-05.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 6 4 | elt1 content 7 5 | 6 | elt1 content 8 7 | elt1 content 9 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-10-05.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 6 4 | elt1 content 7 5 | 6 | elt1 content 8 7 | elt1 content 9 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-16-05.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | elt1 content 6 5 | elt1 content 7 6 | 7 | elt1 content 8 8 | elt1 content 9 9 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-19-05.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | elt1 content 6 5 | elt1 content 7 6 | 7 | elt1 content 8 8 | elt1 content 9 9 | -------------------------------------------------------------------------------- /t/test_changes.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use Test::More; 4 | eval 'use Test::CPAN::Changes'; 5 | plan skip_all => 'Test::CPAN::Changes required for this test' if $@; 6 | plan skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.' if ! $ENV{TEST_AUTHOR}; 7 | changes_ok(); 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-18-02.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 3 4 | 5 | elt1 content 4 6 | elt1 content 5 7 | 8 | 9 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-18-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-21-02.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | elt1 content 6 5 | elt1 content 7 6 | 7 | elt1 content 8 8 | 9 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-5-00.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 3 | elt1 content 2 4 | elt1 content 3 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-6-00.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 3 | elt1 content 2 4 | elt1 content 3 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /t/dummy.dtd: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /t/test_3_48.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use XML::Twig; 7 | use Test::More tests => 1; 8 | 9 | use utf8; 10 | 11 | { 12 | XML::Twig::_disallow_use( 'Tie::IxHash'); 13 | my $t; 14 | eval { $t= XML::Twig->new( keep_atts_order => 0); }; 15 | ok( $t, 'keep_atts_order => 0'); 16 | } 17 | 18 | 19 | exit; 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-18-03.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | elt1 content 6 6 | elt1 content 7 7 | 8 | elt1 content 8 9 | elt1 content 9 10 | 11 | 12 | -------------------------------------------------------------------------------- /t/pod.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | if( ! $ENV{TEST_AUTHOR} ) { print "1..1\nok 1\n"; warn "Author test. Set \$ENV{TEST_AUTHOR} to a true value to run.\n"; exit; } 6 | 7 | eval "use Test::Pod 1.00"; 8 | if( $@) { print "1..1\nok 1\n"; warn "skipping, Test::Pod required\n"; } 9 | else { all_pod_files_ok( ); } 10 | 11 | 12 | exit 0; 13 | 14 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-2-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-1-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-10-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-9-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-16-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-19-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /t/test_xml_split.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 3 | elt1 content 2 4 | elt1 content 3 5 | 6 | elt1 content 4 7 | elt1 content 5 8 | 9 | 10 | 11 | elt1 content 6 12 | elt1 content 7 13 | 14 | elt1 content 8 15 | elt1 content 9 16 | 17 | 18 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-21-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 1 4 | elt1 content 2 5 | elt1 content 3 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /t/pod_coverage.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | if( ! $ENV{TEST_AUTHOR} ) { print "1..1\nok 1\n"; warn "Author test. Set \$ENV{TEST_AUTHOR} to a true value to run.\n"; exit; } 6 | 7 | eval "use Test::Pod::Coverage 1.00 tests => 1"; 8 | if( $@) 9 | { print "1..1\nok 1\n"; 10 | warn "Test::Pod::Coverage 1.00 required for testing POD coverage"; 11 | exit; 12 | } 13 | 14 | pod_coverage_ok( "XML::Twig", { trustme => [ 'isa' ] }); 15 | -------------------------------------------------------------------------------- /t/test_xml_split_w_decl.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 1 4 | elt1 content 2 5 | elt1 content 3 6 | 7 | elt1 content 4 8 | elt1 content 5 9 | 10 | 11 | 12 | elt1 content 6 13 | elt1 content 7 14 | 15 | elt1 content 8 16 | elt1 content 9 17 | 18 | 19 | -------------------------------------------------------------------------------- /t/xmlxpath_tools.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Config; 3 | 4 | BEGIN 5 | { if( eval( 'require XML::Twig::XPath')) 6 | { import XML::Twig::XPath; } 7 | elsif( $@ =~ m{^cannot use XML::Twig::XPath}) 8 | { print "1..1\nok 1\n"; $@=~s{ at.*}{}s; warn "$@\n"; 9 | exit; 10 | } 11 | else 12 | { die $@; } 13 | } 14 | 15 | 1; 16 | 17 | __END__ 18 | 19 | =head1 SYNOPSYS 20 | 21 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 22 | 23 | -------------------------------------------------------------------------------- /t/test2_2.dtd: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /t/test_kwalitee.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | if( ! $ENV{TEST_AUTHOR} ) { print "1..1\nok 1\n"; warn "Author test. Set \$ENV{TEST_AUTHOR} to a true value to run.\n"; exit; } 6 | 7 | eval { require Test::More; Test::More->import(); }; 8 | if( $@) { print "1..1\nok 1\n"; warn "need test::More installed for this test\n"; exit; } 9 | 10 | eval { require Test::Kwalitee; Test::Kwalitee->import() }; 11 | plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@; 12 | 13 | 14 | -------------------------------------------------------------------------------- /t/test_even_more_coverage.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | 4 | # test designed to improve coverage of the module 5 | 6 | use strict; 7 | use Carp; 8 | 9 | use File::Spec; 10 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 11 | use tools; 12 | 13 | #$|=1; 14 | my $DEBUG=0; 15 | 16 | use XML::Twig; 17 | 18 | my $TMAX=1; 19 | 20 | print "1..$TMAX\n"; 21 | 22 | { my $t= XML::Twig->new( parse_start_tag => sub { return 'a'; })->parse( 'c'); 23 | is( $t->sprint, 'c', "dummy parse_start_tag"); 24 | } 25 | exit 0; 26 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-11-01.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 3 | elt1 content 2 4 | elt1 content 3 5 | 6 | elt1 content 4 7 | elt1 content 5 8 | 9 | 10 | 11 | elt1 content 6 12 | elt1 content 7 13 | 14 | elt1 content 8 15 | elt1 content 9 16 | 17 | 18 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-12-01.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 3 | elt1 content 2 4 | elt1 content 3 5 | 6 | elt1 content 4 7 | elt1 content 5 8 | 9 | 10 | 11 | elt1 content 6 12 | elt1 content 7 13 | 14 | elt1 content 8 15 | elt1 content 9 16 | 17 | 18 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-7-01.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 3 | elt1 content 2 4 | elt1 content 3 5 | 6 | elt1 content 4 7 | elt1 content 5 8 | 9 | 10 | 11 | elt1 content 6 12 | elt1 content 7 13 | 14 | elt1 content 8 15 | elt1 content 9 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-8-01.xml: -------------------------------------------------------------------------------- 1 | 2 | elt1 content 1 3 | elt1 content 2 4 | elt1 content 3 5 | 6 | elt1 content 4 7 | elt1 content 5 8 | 9 | 10 | 11 | elt1 content 6 12 | elt1 content 7 13 | 14 | elt1 content 8 15 | elt1 content 9 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /t/xmlxpath_04pos.t: -------------------------------------------------------------------------------- 1 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 2 | use Test; 3 | plan( tests => 4); 4 | 5 | 6 | use XML::Twig::XPath; 7 | ok(1); 8 | 9 | my $t= XML::Twig::XPath->new->parse( \*DATA); 10 | 11 | ok( $t); 12 | 13 | my $first = $t->findvalue( '/AAA/BBB[1]/@id'); 14 | ok($first, "first"); 15 | 16 | my $last = $t->findvalue( '/AAA/BBB[last()]/@id'); 17 | ok($last, "last"); 18 | 19 | exit 0; 20 | 21 | __DATA__ 22 | 23 | 24 | 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /t/xmlxpath_02descendant.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 5 | 6 | use Test; 7 | plan( tests => 4); 8 | 9 | ok(1); 10 | 11 | my $t= XML::Twig::XPath->new->parse( \*DATA); 12 | ok($t); 13 | 14 | my @bbb = $t->findnodes('//BBB'); 15 | ok(@bbb, 5); 16 | 17 | my @subbbb = $t->findnodes('//DDD/BBB'); 18 | ok(@subbbb, 3); 19 | 20 | exit 0; 21 | 22 | __DATA__ 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-20-01.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | elt1 content 1 4 | elt1 content 2 5 | elt1 content 3 6 | 7 | elt1 content 4 8 | elt1 content 5 9 | 10 | 11 | 12 | elt1 content 6 13 | elt1 content 7 14 | 15 | elt1 content 8 16 | elt1 content 9 17 | 18 | 19 | 20 | -------------------------------------------------------------------------------- /t/xmlxpath_22name_select.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 4); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '//*[name() = /AAA/SELECT]'); 20 | ok(@nodes, 2); 21 | ok($nodes[0]->getName, "BBB"); 22 | 23 | exit 0; 24 | 25 | __DATA__ 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | -------------------------------------------------------------------------------- /t/xmlxpath_13axisparent.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 4); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '//DDD/parent::*'); 20 | ok(@nodes, 4); 21 | ok($nodes[3]->getName, "EEE"); 22 | 23 | exit 0; 24 | 25 | __DATA__ 26 | 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /t/xmlxpath_25scope.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | 6 | use strict; 7 | 8 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 9 | 10 | use Test; 11 | plan( tests => 4); 12 | 13 | 14 | use XML::Twig::XPath; 15 | ok(1); 16 | 17 | eval 18 | { 19 | # Removing the 'my' makes this work?!? 20 | my $t= XML::Twig::XPath->new->parse( ''); 21 | ok( $t); 22 | 23 | $t->findnodes( '/test'); 24 | 25 | ok(1); 26 | 27 | die "This should be caught\n"; 28 | 29 | }; 30 | 31 | if ($@) 32 | { 33 | ok(1); 34 | } 35 | else { 36 | ok(0); 37 | } 38 | 39 | exit 0; 40 | -------------------------------------------------------------------------------- /t/xmlxpath_29desc_with_predicate.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 4); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @bbb = $t->findnodes( '/descendant::BBB[1]'); 19 | ok(@bbb, 1); 20 | ok($bbb[0]->string_value, "OK"); 21 | 22 | exit 0; 23 | 24 | __DATA__ 25 | 26 | OK 27 | 28 | 29 | 30 | NOT OK 31 | 32 | -------------------------------------------------------------------------------- /t/xmlxpath_30lang.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 4); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new( keep_spaces => 1)->parse( \*DATA); 15 | ok( $t); 16 | 17 | my @en = $t->findnodes( '//*[lang("en")]'); 18 | ok(@en, 2); 19 | 20 | my @de = $t->findnodes( '//content[lang("de")]'); 21 | ok(@de, 1); 22 | 23 | exit 0; 24 | 25 | __DATA__ 26 | 27 | Here we go... 28 | und hier deutschsprachiger Text :-) 29 | 30 | -------------------------------------------------------------------------------- /t/xmlxpath_26predicate.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 4); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @bbb = $t->findnodes( '//a/b[2]'); 19 | ok(@bbb, 2); 20 | 21 | @bbb = $t->findnodes( '(//a/b)[2]'); 22 | ok(@bbb, 1); 23 | 24 | exit 0; 25 | 26 | __DATA__ 27 | 28 | 29 | some 1 30 | value 1 31 | 32 | 33 | some 2 34 | value 2 35 | 36 | 37 | -------------------------------------------------------------------------------- /t/xmlxpath_19axisd_or_s.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 4); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '/AAA/XXX/descendant-or-self::*'); 20 | ok(@nodes, 8); 21 | 22 | @nodes = $t->findnodes( '//CCC/descendant-or-self::*'); 23 | ok(@nodes, 4); 24 | 25 | exit 0; 26 | 27 | __DATA__ 28 | 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /t/xmlxpath_20axisa_or_s.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 4); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '/AAA/XXX/DDD/EEE/ancestor-or-self::*'); 20 | ok(@nodes, 4); 21 | 22 | @nodes = $t->findnodes( '//GGG/ancestor-or-self::*'); 23 | ok(@nodes, 5); 24 | 25 | exit 0; 26 | 27 | __DATA__ 28 | 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /t/xmlxpath_06attrib_val.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 5); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '//BBB[@id = "b1"]'); 20 | ok(@nodes, 1); 21 | 22 | @nodes = $t->findnodes( '//BBB[@name = "bbb"]'); 23 | ok(@nodes, 1); 24 | 25 | @nodes = $t->findnodes( '//BBB[normalize-space(@name) = "bbb"]'); 26 | ok(@nodes, 2); 27 | 28 | exit 0; 29 | 30 | __DATA__ 31 | 32 | 33 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /t/test_new_features_3_15.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | # test designed to improve coverage of the module 6 | 7 | use strict; 8 | use Carp; 9 | 10 | use File::Spec; 11 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 12 | use tools; 13 | 14 | #$|=1; 15 | my $DEBUG=0; 16 | 17 | use XML::Twig; 18 | 19 | my $TMAX=1; 20 | print "1..$TMAX\n"; 21 | 22 | { my $indented="\n \n\n"; 23 | (my $straight=$indented)=~ s{\s}{}g; 24 | is( XML::Twig->new( pretty_print => 'indented')->parse( $indented)->sprint, 25 | $indented, "pretty printed doc"); exit; 26 | is( XML::Twig->new()->parse( $indented)->sprint, 27 | $straight, "non pretty printed doc"); 28 | } 29 | 30 | -------------------------------------------------------------------------------- /t/xmlxpath_03star.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 4 | 5 | use Test; 6 | plan( tests => 5); 7 | 8 | 9 | use XML::Twig::XPath; 10 | ok(1); 11 | 12 | my $t= XML::Twig::XPath->new->parse( \*DATA); 13 | 14 | ok( $t); 15 | 16 | my @nodes; 17 | 18 | @nodes = $t->findnodes( '/AAA/CCC/DDD/*'); 19 | ok(@nodes, 4); 20 | 21 | @nodes = $t->findnodes( '/*/*/*/BBB'); 22 | ok(@nodes, 5); 23 | 24 | @nodes = $t->findnodes( '//*'); 25 | ok(@nodes, 17); 26 | 27 | exit 0; 28 | 29 | __DATA__ 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /t/xmlxpath_05attrib.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use Test; 4 | plan( tests => 6); 5 | 6 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 7 | 8 | use XML::Twig::XPath; 9 | ok(1); 10 | 11 | my $t= XML::Twig::XPath->new->parse( \*DATA); 12 | 13 | ok( $t); 14 | 15 | my @ids = $t->findnodes( '//BBB[@id]'); 16 | ok(@ids, 2); 17 | 18 | my @names = $t->findnodes( '//BBB[@name]'); 19 | ok(@names, 1); 20 | 21 | my @attribs = $t->findnodes( '//BBB[@*]'); 22 | ok(@attribs, 3); 23 | 24 | my @noattribs = $t->findnodes( '//BBB[not(@*)]'); 25 | ok(@noattribs, 1); 26 | 27 | exit 0; 28 | 29 | __DATA__ 30 | 31 | 32 | 33 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /t/test_error_with_unicode_layer: -------------------------------------------------------------------------------- 1 | use XML::Twig; 2 | 3 | use strict; 4 | use Config; 5 | 6 | my( $infile)= @ARGV; 7 | 8 | my $perl= used_perl(); 9 | open( FH, "$perl -p -e1 $infile |") or die $!; 10 | XML::Twig->nparse( \*FH); 11 | die "OK\n"; 12 | 13 | 14 | sub used_perl 15 | { my $perl; 16 | if( $^O eq 'VMS') { $perl= $Config{perlpath}; } # apparently $^X does not work on VMS 17 | else { $perl= $^X; } # but $Config{perlpath} does not work in 5.005 18 | if ($^O ne 'VMS' && $Config{_exe} && $perl !~ m{$Config{_exe}$}i) { $perl .= $Config{_exe}; } 19 | $perl .= " -Iblib/lib"; 20 | if( $ENV{TEST_COVER}) { $perl .= " -MDevel::Cover"; } 21 | return $perl; 22 | } 23 | 24 | -------------------------------------------------------------------------------- /t/xmlxpath_01basic.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 5 | 6 | use Test; 7 | plan( tests => 5); 8 | 9 | ok(1); 10 | my $t= XML::Twig::XPath->new->parse( \*DATA); 11 | ok($t); 12 | 13 | my @root = $t->findnodes('/AAA'); 14 | ok(@root, 1); 15 | 16 | my @ccc = $t->findnodes('/AAA/CCC'); 17 | ok(@ccc, 3); 18 | 19 | my @bbb = $t->findnodes('/AAA/DDD/BBB'); 20 | ok(@bbb, 2); 21 | 22 | exit 0; 23 | 24 | __DATA__ 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | Text 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /t/xmlxpath_14axisancestor.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 5); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '/AAA/BBB/DDD/CCC/EEE/ancestor::*'); 20 | ok(@nodes, 4); 21 | ok($nodes[1]->getName, "BBB"); # test document order 22 | 23 | @nodes = $t->findnodes( '//FFF/ancestor::*'); 24 | ok(@nodes, 5); 25 | 26 | exit 0; 27 | 28 | __DATA__ 29 | 30 | 31 | 32 | 33 | -------------------------------------------------------------------------------- /t/xmlxpath_08name.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 5); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '//*[name() = "BBB"]'); 20 | ok(@nodes, 5); 21 | 22 | @nodes = $t->findnodes( '//*[starts-with(name(), "B")]'); 23 | ok(@nodes, 7); 24 | 25 | @nodes = $t->findnodes( '//*[contains(name(), "C")]'); 26 | ok(@nodes, 3); 27 | 28 | exit 0; 29 | 30 | __DATA__ 31 | 32 | 33 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /t/xmlxpath_09string_length.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 5); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '//*[string-length(name()) = 3]'); 20 | ok(@nodes, 2); 21 | 22 | @nodes = $t->findnodes( '//*[string-length(name()) < 3]'); 23 | ok(@nodes, 2); 24 | 25 | @nodes = $t->findnodes( '//*[string-length(name()) > 3]'); 26 | ok(@nodes, 3); 27 | 28 | exit 0; 29 | 30 | __DATA__ 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /t/xmlxpath_10pipe.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 6); 9 | 10 | use XML::Twig::XPath; 11 | ok(1); 12 | 13 | my $t= XML::Twig::XPath->new->parse( \*DATA); 14 | 15 | ok( $t); 16 | 17 | my @nodes; 18 | @nodes = $t->findnodes( '//CCC | //BBB'); 19 | ok(@nodes, 3); 20 | ok($nodes[0]->getName, "BBB"); # test document order 21 | 22 | @nodes = $t->findnodes( '/AAA/EEE | //BBB'); 23 | ok(@nodes, 2); 24 | 25 | @nodes = $t->findnodes( '/AAA/EEE | //DDD/CCC | /AAA | //BBB'); 26 | ok(@nodes, 4); 27 | 28 | exit 0; 29 | 30 | __DATA__ 31 | 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-4-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | -------------------------------------------------------------------------------- /t/xmlxpath_15axisfol_sib.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 6); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '/AAA/BBB/following-sibling::*'); 20 | ok(@nodes, 2); 21 | ok($nodes[1]->getName, "CCC"); # test document order 22 | 23 | @nodes = $t->findnodes( '//CCC/following-sibling::*'); 24 | ok(@nodes, 3); 25 | ok($nodes[1]->getName, "FFF"); 26 | 27 | exit 0; 28 | 29 | __DATA__ 30 | 31 | 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /t/xmlxpath_07count.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 7); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '//*[count(BBB) = 2]'); 20 | ok($nodes[0]->getName, "DDD"); 21 | 22 | @nodes = $t->findnodes( '//*[count(*) = 2]'); 23 | ok(@nodes, 2); 24 | 25 | @nodes = $t->findnodes( '//*[count(*) = 3]'); 26 | ok(@nodes, 2); 27 | ok($nodes[0]->getName, "AAA"); 28 | ok($nodes[1]->getName, "CCC"); 29 | 30 | exit 0; 31 | 32 | __DATA__ 33 | 34 | 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-3-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | -------------------------------------------------------------------------------- /html2xml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use warnings; 3 | use strict; 4 | 5 | use XML::Twig; 6 | 7 | sub _chose_html_string 8 | { if( _use( 'XML::LibXML')) 9 | { $html2xml 10 | 11 | sub parsefile_html 12 | { my( $twig, $file)= @_; 13 | my $fh; 14 | 15 | open( $fh, "tidy -asxml -quiet 2>/dev/null '$file' |") 16 | or open( $fh, "xmllint -html '$file' |") 17 | or open( $fh, "$^X -MXML::LibXML -e'print XML::LibXML->new->parse_html_file( \'$file\')->toString' |") 18 | or carp "cannot convert HTML to XML (needs tidy, xmllint or XML::LibXML)"; 19 | $twig->parse( $fh); 20 | } 21 | 22 | 23 | sub _use 24 | { my( $module, @args)= @_; 25 | if( eval "require $module") { import $module, @args; } 26 | else { return; } 27 | } 28 | 29 | -------------------------------------------------------------------------------- /t/xmlxpath_12axisdescendant.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 6); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '/descendant::*'); 20 | ok(@nodes, 11); 21 | 22 | @nodes = $t->findnodes( '/AAA/BBB/descendant::*'); 23 | ok(@nodes, 4); 24 | 25 | @nodes = $t->findnodes( '//CCC/descendant::*'); 26 | ok(@nodes, 6); 27 | 28 | @nodes = $t->findnodes( '//CCC/descendant::DDD'); 29 | ok(@nodes, 3); 30 | 31 | exit 0; 32 | 33 | __DATA__ 34 | 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /t/test_xml_split/test_xml_split_expected-17-00.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /t/xmlxpath_09a_string_length.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 5); 9 | 10 | 11 | use XML::Twig::XPath; 12 | 13 | my $doc_one = qq|para one|; 14 | 15 | my $t= XML::Twig::XPath->new( keep_spaces => 1); 16 | $t->parse( $doc_one); 17 | ok( $t); 18 | 19 | my $doc_one_chars = $t->find( 'string-length(/doc/text())'); 20 | ok($doc_one_chars == 0, 1); 21 | 22 | my $doc_two = qq| 23 | 24 | para one has bold text 25 | 26 | |; 27 | 28 | $t->parse( $doc_two); 29 | ok( $t); 30 | 31 | my $doc_two_chars = $t->find( 'string-length(/doc/text())'); 32 | ok($doc_two_chars == 3, 1); 33 | 34 | my $doc_two_para_chars = $t->find( 'string-length(/doc/para/text())'); 35 | ok($doc_two_para_chars == 13, 1); 36 | 37 | exit 0; 38 | 39 | -------------------------------------------------------------------------------- /t/test2_3.res: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | ]> 6 |
S1 I1S1 I2S1 TitleS1 P1S2 P2Note P1S1 para 3
S2 introS2 TitleS2 P1S2 P2S2 P3
Annex TitleAnnex P1Annex P2 -------------------------------------------------------------------------------- /t/xmlxpath_18axispreceding.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 4); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '/AAA/XXX/preceding::*'); 20 | ok(@nodes, 4); 21 | 22 | @nodes = $t->findnodes( '//GGG/preceding::*'); 23 | ok(@nodes, 8); 24 | 25 | exit 0; 26 | 27 | __DATA__ 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | -------------------------------------------------------------------------------- /t/xmlxpath_17axisfollowing.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 4); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '/AAA/XXX/following::*'); 20 | ok(@nodes, 2); 21 | 22 | @nodes = $t->findnodes( '//ZZZ/following::*'); 23 | ok(@nodes, 12); 24 | 25 | exit 0; 26 | 27 | __DATA__ 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | -------------------------------------------------------------------------------- /t/test_3_32.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use strict; 5 | use Carp; 6 | use File::Spec; 7 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 8 | use tools; 9 | 10 | $|=1; 11 | my $DEBUG=0; 12 | 13 | use XML::Twig; 14 | 15 | my $TMAX=1; 16 | print "1..$TMAX\n"; 17 | 18 | if( $] >= 5.008) 19 | { # test non ascii letters at the beginning of an element name in a selector 20 | # can't use non ascii chars in script, so the tag name needs to come from the doc! 21 | my $doc=q{étésummerestate}; 22 | my $t= XML::Twig->parse( $doc); 23 | my $tag= $t->root->first_child( 'tag')->text; 24 | foreach ($t->root->children( 'elt')) { $_->set_tag( $tag); } 25 | is( $t->root->first_child( $tag)->text, 'summer', 'non ascii letter to start a name in a condition'); 26 | } 27 | else 28 | { skip( 1, "known bug in perl $]: tags starting with a non ascii letter cannot be used in expressions"); } 29 | 30 | exit; 31 | 1; 32 | -------------------------------------------------------------------------------- /cover_twig: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Getopt::Std; 6 | my %opt; 7 | getopts( 'ivrh', \%opt); 8 | 9 | my $run=< cover_report.txt 13 | RUN 14 | 15 | if( ! $opt{i} && ! @ARGV) 16 | { system "cover -delete; $run"; exit; } 17 | 18 | if( @ARGV) 19 | { foreach my $test (@ARGV) 20 | { system "TEST_AUTHOR=1 TEST_COVER=1 $^X -MDevel::Cover $test"; } 21 | } 22 | else 23 | { system "TEST_AUTHOR=1 TEST_COVER=1 HARNESS_PERL_SWITCHES=-MDevel::Cover make test"; } 24 | 25 | system "cover && cover -report text > cover_report.txt"; 26 | 27 | __END__ 28 | =head1 NAME 29 | 30 | cover_twig -- generates test coverage for XML::Twig 31 | 32 | =head1 OPTIONS 33 | 34 | -r reset (delete) the coverage DB ¡DEFAULT! 35 | -i incremental: do not delete the coverage db 36 | 37 | =head1 EXAMPLES 38 | 39 | ./cover_twig 40 | ./cover_twig -r 41 | ./cover_twig t/test_3_36.t 42 | 43 | -------------------------------------------------------------------------------- /t/xmlxpath_23func.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 5); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '//BBB[position() mod 2 = 0 ]'); 20 | ok(@nodes, 4); 21 | 22 | @nodes = $t->findnodes('//BBB 23 | [ position() = floor(last() div 2 + 0.5) 24 | or 25 | position() = ceiling(last() div 2 + 0.5) ]'); 26 | 27 | ok(@nodes, 2); 28 | 29 | @nodes = $t->findnodes('//CCC 30 | [ position() = floor(last() div 2 + 0.5) 31 | or 32 | position() = ceiling(last() div 2 + 0.5) ]'); 33 | 34 | ok(@nodes, 1); 35 | 36 | exit 0; 37 | 38 | __DATA__ 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | -------------------------------------------------------------------------------- /t/test_3_42.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use XML::Twig; 7 | use Test::More tests => 3; 8 | 9 | 10 | { my $t= XML::Twig->new( twig_handlers => { e => sub { XML::Twig::Elt->parse( '')->paste( before => $_); } }) 11 | ->parse(''); 12 | is( $t->sprint, '', 'elements created with parse are still available once parsing is done'); 13 | } 14 | 15 | import myElt; 16 | 17 | { my $doc='fooe1e2foo'; 18 | my $t= XML::Twig->new( elt_class => 'myElt', 19 | field_accessors => { e => 'e' }, 20 | elt_accessors => { ee => 'e', ef => 'f', }, 21 | ) 22 | ->parse( $doc); 23 | 24 | is( join( ':', map { $_->e } $t->root->ef), 'e1:e2', 'elt_accessors with elt_class'); 25 | is( join( ':', map { $_->ee->text } $t->root->children( 'f')), 'e1:e2', 'field_accessors with elt_class'); 26 | } 27 | 28 | package myElt; 29 | use base 'XML::Twig::Elt'; 30 | 1; 31 | 32 | -------------------------------------------------------------------------------- /check_optional_modules: -------------------------------------------------------------------------------- 1 | #!/bin/perl -w 2 | 3 | # $Id: /xmltwig/trunk/check_optional_modules 4 2007-03-16T12:16:25.259192Z mrodrigu $ 4 | 5 | use strict; 6 | 7 | exit if( $] >= 5.008); 8 | 9 | if( $] >= 5.0060) 10 | { unless( eval 'require Scalar::Util' or eval 'require WeakRef' ) 11 | { warn "Neither Scalar::Util nor WeakRef is installed. ", 12 | "Installing one of these modules would improve ", 13 | "XML::Twig memory management and eliminate memory ", 14 | "leaks when re-using twigs.\n"; 15 | } 16 | else 17 | { warn "weaken is available\n"; } 18 | } 19 | 20 | unless( eval 'require Text::Iconv') 21 | { my $version= `iconv -V` || ''; 22 | if($version) 23 | { warn "The iconv library was found on your system ", 24 | "but the Text::Iconv module is not installed. ", 25 | "Installing Text::Iconv would make character ", 26 | "encoding translations fast and efficient.\n"; 27 | } 28 | else 29 | { warn "Did not find iconv\n"; } 30 | } 31 | else 32 | { warn "Text::Iconv is installed\n"; } 33 | 34 | -------------------------------------------------------------------------------- /t/test2_2.xml: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | ]> 6 | 7 |
8 | 9 | S1 I1 10 | S1 I2 11 | 12 | S1 Title 13 | S1 P1 14 | S2 P2 15 | 16 | Note P1 17 | 18 | S1 para 3 19 |
20 |
21 | 22 | S2 intro 23 | 24 | S2 Title 25 | S2 P1 26 | S2 P2 27 | S2 P3 28 |
29 | 30 | Annex Title 31 | Annex P1 32 | Annex P2 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /t/xmlxpath_16axisprec_sib.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 7); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '/AAA/XXX/preceding-sibling::*'); 20 | ok(@nodes, 1); 21 | ok($nodes[0]->getName, "BBB"); 22 | 23 | @nodes = $t->findnodes( '//CCC/preceding-sibling::*'); 24 | ok(@nodes, 4); 25 | 26 | @nodes = $t->findnodes( '/AAA/CCC/preceding-sibling::*[1]'); 27 | ok($nodes[0]->getName, "XXX"); 28 | 29 | @nodes = $t->findnodes( '/AAA/CCC/preceding-sibling::*[2]'); 30 | ok($nodes[0]->getName, "BBB"); 31 | 32 | exit 0; 33 | 34 | __DATA__ 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | -------------------------------------------------------------------------------- /t/test_drop_comments.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use File::Spec; 5 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 6 | use tools; 7 | 8 | use XML::Twig; 9 | 10 | print "1..3\n"; 11 | 12 | my $xml = < 14 | 15 | value 16 | 17 | XML_TEST 18 | 19 | { 20 | my $twig1 = XML::Twig->new(comments => 'keep', keep_spaces => 1); 21 | $twig1->parse($xml); 22 | ok ($twig1->sprint() =~ //s, 'keep comments'); 23 | #print $twig1->sprint, "\n", '-'x80, "\n"; # keeps comments ok 24 | $twig1->dispose; 25 | } 26 | 27 | { 28 | my $twig2 = XML::Twig->new(comments => 'drop', keep_spaces => 1); 29 | $twig2->parse($xml); 30 | ok ($twig2->sprint() !~ //s, 'drop comments'); 31 | #print $twig2->sprint, "\n", '-'x80, "\n"; # drops comments ok 32 | $twig2->dispose; 33 | } 34 | 35 | { 36 | my $twig3 = XML::Twig->new(comments => 'keep', keep_spaces => 1); 37 | $twig3->parse($xml); 38 | ok ($twig3->sprint() =~ //s, 'keep comments'); 39 | #print $twig3->sprint, "\n", '-'x80, "\n"; # drops comments!! 40 | $twig3->dispose; 41 | } 42 | exit 0; 43 | -------------------------------------------------------------------------------- /t/tests_3_23.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use Carp; 5 | 6 | use XML::Twig; 7 | 8 | use File::Spec; 9 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 10 | use tools; 11 | 12 | my $DEBUG=0; 13 | print "1..6\n"; 14 | 15 | if( _use( 'XML::XPathEngine') || _use( 'XML::XPath') ) 16 | { _use( 'XML::Twig::XPath'); 17 | my $t= XML::Twig::XPath->nparse( q{ 18 | foobar 19 | bazfoobar 20 | }); 21 | is( $t->findvalue( '//e[.="foo"]/@a'), "ea1", 'xpath on attributes'); 22 | is( $t->findvalue( '//s[./e="foo"]/@a'), "sa1", 'xpath with elt content test'); 23 | is( $t->findvalue( '/d/s[e="foo"]/@a'), "sa1", 'xpath with elt content test (short form)'); 24 | } 25 | else 26 | { skip( 3); } 27 | 28 | { my $t= XML::Twig->nparse( ''); 29 | my @xpath_result= $t->get_xpath( '/'); 30 | is( ref( $xpath_result[0]), 'XML::Twig', "get_xpath( '/')"); 31 | @xpath_result= $t->get_xpath( '/doc[1]'); 32 | is( $xpath_result[0]->tag, 'doc', "get_xpath( '/doc[1]')"); 33 | @xpath_result= $t->get_xpath( '/notdoc[1]'); 34 | is( scalar( @xpath_result), 0, "get_xpath( '/notdoc[1]')"); 35 | } 36 | 37 | 38 | -------------------------------------------------------------------------------- /t/test2_2.res: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | ]> 17 |
S1 I1S1 I2S1 TitleS1 P1S2 P2Note P1S1 para 3
S2 introS2 TitleS2 P1S2 P2S2 P3
Annex TitleAnnex P1Annex P2 -------------------------------------------------------------------------------- /t/test2_1.res: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | ]> 19 |
S1 I1S1 I2S1 TitleS1 P1S2 P2Note P1S1 para 3
S2 introS2 TitleS2 P1S2 P2S2 P3
Annex TitleAnnex P1Annex P2 -------------------------------------------------------------------------------- /t/test2_1.exp: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | ]> 20 |
S1 I1S1 I2S1 TitleS1 P1S2 P2Note P1S1 para 3
S2 introS2 TitleS2 P1S2 P2S2 P3
Annex TitleAnnex P1Annex P2 21 | -------------------------------------------------------------------------------- /t/test2_2.exp: -------------------------------------------------------------------------------- 1 | 2 | 4 | 7 | 8 | 11 | 12 | 15 | 16 | 19 | 20 | 23 | 24 | 27 | 28 | ]> 29 |
S1 I1S1 I2S1 TitleS1 P1S2 P2Note P1S1 para 3
S2 introS2 TitleS2 P1S2 P2S2 P3
Annex TitleAnnex P1Annex P2 30 | -------------------------------------------------------------------------------- /t/test_autoencoding_conversion.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # 3 | use strict; 4 | 5 | use File::Spec; 6 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 7 | use tools; 8 | 9 | print "1..2\n"; 10 | 11 | if( $] < 5.008) 12 | { skip( 2, "needs perl 5.8 or above to test auto conversion"); } 13 | elsif( $ENV{PERL_UNICODE} && ($ENV{PERL_UNICODE}=~ m{S} && $ENV{PERL_UNICODE}=~ m{A})) 14 | { skip( 2, 'auto conversion does not happen when $PERL_UNICODE set to SA'); } 15 | else 16 | { _use( 'Encode'); 17 | 18 | my $char_utf8 = qq{\x{e9}}; 19 | my $char_latin1 = encode("iso-8859-1", $char_utf8); 20 | my $doc_utf8 = qq{$char_utf8}; 21 | my $doc_latin1 = qq{$char_latin1}; 22 | 23 | my $file_utf8 = "doc_utf8.xml"; 24 | spit( $file_utf8, $doc_utf8); 25 | my $file_latin1 = "doc_latin1.xml"; 26 | spit( $file_latin1, $doc_latin1); 27 | 28 | my( $q, $q2) = ( ($^O eq "MSWin32") || ($^O eq 'VMS') ) ? ('"', "'") : ("'", '"'); 29 | my $lib= File::Spec->catfile( 'blib', 'lib'); 30 | my $run_it=qq{$^X -I $lib -MXML::Twig -e$q print XML::Twig->parse( $q2$file_latin1$q2)->root->text$q}; 31 | my $parsed= `$run_it`; 32 | is( $parsed, $char_utf8, 'testing auto transcoding of latin1 output'); 33 | is( $parsed, $char_latin1, 'testing auto transcoding of latin1 output'); 34 | } 35 | -------------------------------------------------------------------------------- /t/xmlxpath_28ancestor2.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 5); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '//Footnote'); 20 | ok(@nodes, 1); 21 | 22 | my $footnote = $nodes[0]; 23 | 24 | #@nodes = $footnote->findnodes('ancestor::*', $t); 25 | @nodes = $footnote->findnodes( 'ancestor::*'); 26 | ok(@nodes, 3); 27 | 28 | @nodes = $footnote->findnodes('ancestor::text:footnote', $t); 29 | ok(@nodes, 1); 30 | 31 | exit 0; 32 | 33 | __DATA__ 34 | 35 | 36 | 2 37 | 38 | AxKit 40 | is very flexible in how it lets you transform the XML on the 41 | server, and there are many modules you can plug in to AxKit to 42 | allow you to do these transformations. For this reason, the AxKit 43 | installation does not mandate any particular modules to use, 44 | instead it will simply suggest modules that might help when you 45 | install AxKit. 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /t/test_need_3_args_open.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use Carp; 5 | 6 | use File::Spec; 7 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 8 | use tools; 9 | 10 | 11 | $|=1; 12 | 13 | use XML::Twig; 14 | 15 | # abort (before compiling so the 3 arg open doesn't cause a crash) unless perl 5.8+ 16 | BEGIN 17 | { if( $] < 5.008) { print "1..1\nok 1\n"; warn "skipping tests that require 3 args open\n"; exit 0; } } 18 | 19 | my $TMAX=4; 20 | print "1..$TMAX\n"; 21 | 22 | { my $out=''; 23 | open( my $fh, '>', \$out); 24 | my $doc=q{foobar}; 25 | my $t= XML::Twig->new( twig_handlers => { elt => sub { $_->flush( $fh) } }); 26 | $t->parse( $doc); 27 | is( $out, $doc, "flush to a scalar (with autoflush)"); 28 | $t->flush( $fh); 29 | is( $out, $doc, "double flush"); 30 | $t->flush(); 31 | is( $out, $doc, "triple flush"); 32 | } 33 | 34 | { 35 | my $out= ''; 36 | my $twig = XML::Twig->new( output_encoding => 'utf-8',); 37 | $twig->parse( ""); 38 | my $greet = $twig->root->insert_new_elt( last_child => 'g'); 39 | $greet->set_text("Gr\x{00FC}\x{00DF}"); 40 | open(my $fh, '>:utf8', \$out); 41 | $twig->print(\*$fh); 42 | print {*$fh} "Copyright \x{00A9} 2008 Me"; 43 | close($fh); 44 | is( $out, qq{GrüßCopyright © 2008 Me}, 45 | '$t->print and regular print mixed, with utf-8 encoding' 46 | ); 47 | } 48 | 49 | -------------------------------------------------------------------------------- /t/test_spaces.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use XML::Twig; 4 | 5 | $/="\n\n"; 6 | 7 | print "1..3\n"; 8 | 9 | my $twig=XML::Twig->new( keep_spaces_in => [ 'e']); 10 | test( $twig, 1); 11 | $twig=XML::Twig->new( keep_spaces_in => [ 'e', 'sub1']); 12 | test( $twig, 2); 13 | $twig=XML::Twig->new( keep_spaces => 1); 14 | test( $twig, 3); 15 | 16 | sub test 17 | { my( $twig, $test_nb)= @_; 18 | my $doc= ; chomp $doc; 19 | my $expected_res= ; chomp $expected_res; 20 | 21 | 22 | $twig->parse( $doc); 23 | 24 | my $res= $twig->sprint; 25 | $res=~ s/\n+$//; 26 | 27 | if( $res eq $expected_res) 28 | { print "ok $test_nb\n"; } 29 | else 30 | { print "not ok $test_nb\n"; 31 | warn " expected: \n$expected_res\n result: \n$res\n"; 32 | } 33 | } 34 | 35 | exit 0; 36 | 37 | __DATA__ 38 | 39 | &c;b 40 | 41 | 42 | &c;b 43 | 44 | 45 | &c;b 46 | 47 | &c; 48 | 49 | 50 | 51 | 52 | &c;b 53 | 54 | &c; 55 | 56 | 57 | 58 | 59 | &c;b 60 | 61 | &c; 62 | 63 | 64 | 65 | 66 | &c;b 67 | 68 | &c; 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /t/test_3_47.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use XML::Twig; 7 | use Test::More tests => 3; 8 | 9 | use utf8; 10 | 11 | # test CDATA sections in HTML escaping https://rt.cpan.org/Ticket/Display.html?id=86773 12 | 13 | # module => XML::Twig->new options 14 | my %html_conv= ( 'HTML::TreeBuilder' => {}, 15 | 'HTML::Tidy' => { use_tidy => 1 }, 16 | ); 17 | foreach my $module ( sort keys %html_conv) 18 | { SKIP: 19 | { eval "use $module"; 20 | skip "$module not available", 1 if 1 ; 21 | 22 | my $in = q{

Here&there v&r;

marco&company; and marco&company £ £ £ £

}; 23 | my $expected= q{

Here&there v&r;

marco&company; and marco&company £ £ £ £

}; 24 | 25 | my $parser= XML::Twig->new( %{$html_conv{$module}}); 26 | my $t = $parser->safe_parse_html($in); 27 | print $@ if $@; 28 | 29 | like $t->sprint, qr{\Q$expected\E}, "In and out are the same ($module)"; 30 | 31 | } 32 | } 33 | 34 | { # test RT #94295 https://rt.cpan.org/Public/Bug/Display.html?id=94295 35 | # in twig_handlers, '=' in regexps on attributes are turned into 'eq' 36 | my $xml= 'e1e2'; 37 | my $r; 38 | my $t= XML::Twig->new( twig_handlers => { 'e[@dn =~ /host=0/]' => sub { $r.= $_->text } }) 39 | ->parse( $xml); 40 | is( $r, 'e1', 'regexp on attribute, including an = sign'); 41 | } 42 | exit; 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /t/test2_1.xml: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | ]> 20 | 21 |
22 | 23 | S1 I1 24 | S1 I2 25 | 26 | S1 Title 27 | S1 P1 28 | S2 P2 29 | 30 | Note P1 31 | 32 | S1 para 3 33 |
34 |
35 | 36 | S2 intro 37 | 38 | S2 Title 39 | S2 P1 40 | S2 P2 41 | S2 P3 42 |
43 | 44 | Annex Title 45 | Annex P1 46 | Annex P2 47 | 48 | 49 | 50 | 51 | -------------------------------------------------------------------------------- /t/test_variables.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use XML::Twig; 4 | 5 | $|=1; 6 | 7 | print "1..6\n"; 8 | #warn "\n\n### warnings are normal here ###\n\n"; 9 | 10 | my $t= XML::Twig->new->parse( \*DATA); 11 | 12 | # intercept warnings 13 | $SIG{__WARN__} = sub { print STDERR @_ if( $_[0]=~ /^test/); }; 14 | 15 | 16 | my $s= $t->simplify( var_attr => 'var', variables => { 'v2' => 'elt2'}); 17 | if( $s->{elt2} eq 'elt using elt1') { print "ok 1\n" } 18 | else { print "not ok 1\n"; warn "test 1: /$s->{elt2}/ instead of 'elt using elt1'\n"; } 19 | if( $s->{elt3} eq 'elt using elt1') { print "ok 2\n" } 20 | else { print "not ok 2\n"; warn "test 2: /$s->{elt3}/ instead of 'elt using elt1'\n"; } 21 | if( $s->{elt4} eq 'elt using elt2') { print "ok 3\n"; warn "\n"; } 22 | else { print "not ok 3\n"; warn "test 3: /$s->{elt4}/ instead of 'elt using elt2'\n"; } 23 | if( $s->{elt5}->{att1} eq 'att with elt1') { print "ok 4\n" } 24 | else { print "not ok 4\n"; warn "test 4: /$s->{elt5}->{att1}/ instead of 'att with elt1'\n"; } 25 | 26 | 27 | $s= $t->simplify( variables => { 'v2' => 'elt2'}); 28 | if( $s->{elt2} eq 'elt using $v1') { print "ok 5\n" } 29 | else { print "not ok 5\n"; warn "test 5: /$s->{elt2}/ instead of 'elt using \$v1'\n"; } 30 | if( $s->{elt4} eq 'elt using elt2') { print "ok 6\n" } 31 | else { print "not ok 6\n"; warn "test 6: /$s->{elt4}/ instead of 'elt using elt2'\n"; } 32 | 33 | exit 0; 34 | 35 | __DATA__ 36 | 37 | elt1 38 | elt using $v1 39 | elt using ${v1} 40 | elt using $v2 41 | 42 | 43 | -------------------------------------------------------------------------------- /t/xmlxpath_nav.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | $|=1; 8 | 9 | my $t= XML::Twig::XPath->new; 10 | $t->parse( 11 | ' 12 | elt 1 13 | elt 2 14 | 15 | elt 3 16 | 17 | 18 | 2 19 | 3 20 | 21 | elt 3 22 | '); 23 | 24 | my @data= grep { !/^##/ && m{\S} } ; 25 | 26 | my @exp; 27 | my %result; 28 | 29 | foreach( @data) 30 | { chomp; 31 | my ($exp, $id_list) = split /\s*=>\s*/ ; 32 | $result{$exp}= $id_list; 33 | push @exp, $exp; 34 | } 35 | 36 | my $nb_tests= keys %result; 37 | print "1..$nb_tests\n"; 38 | 39 | my $i=1; 40 | 41 | foreach my $exp ( @exp) 42 | { my $expected_result= $result{$exp}; 43 | my $result_elt= $t->root->first_child( $exp); 44 | my $result= $result_elt ? $result_elt->att( 'id') : 'none'; 45 | 46 | if( $result eq $expected_result) 47 | { print "ok $i\n"; } 48 | else 49 | { print "nok $i\n"; 50 | print STDERR "$exp: expected $expected_result - real $result\n"; 51 | } 52 | $i++; 53 | } 54 | 55 | exit 0; 56 | 57 | __DATA__ 58 | elt => elt-1 59 | elt[@id="elt-4"] => elt-4 60 | elt[@id="elt-3"] => none 61 | *[@att > 1] => elt-2 62 | elt2[2] => elt2-2 63 | ##elt2[./elt2] => elt2-2 64 | elt3 => none 65 | -------------------------------------------------------------------------------- /t/test_attregexp_cond.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use XML::Twig; 5 | 6 | $|=1; 7 | 8 | my $i=0; 9 | my $failed=0; 10 | 11 | my $TMAX=4; # do not forget to update! 12 | 13 | print "1..$TMAX\n"; 14 | 15 | $i++; 16 | print "ok $i\n"; # loading 17 | 18 | my $t= XML::Twig->new( 19 | twig_handlers => 20 | { 'elt[@att=~/^v/]' => sub { $i++; 21 | if( $_->att( 'ok') eq "ok") 22 | { print "ok $i\n"; 23 | } 24 | else 25 | { print "NOK $i\n"; 26 | # print STDERR "id: ", $_->att( 'id'), "\n"; 27 | } 28 | }, 29 | 'elt[@change=~/^now$/]' => sub { $_[0]->setTwigHandler( 30 | 'elt[@att=~/^new/]' => 31 | sub { $i++; 32 | if( $_->att( 'ok') eq "ok") 33 | { print "ok $i\n"; } 34 | else 35 | { print "NOK $i\n"; 36 | # print STDERR "id: ", $_->att( 'id'), "\n"; 37 | } 38 | }); 39 | }, 40 | }, 41 | ); 42 | $t->parse( \*DATA); 43 | 44 | exit 0; 45 | 46 | __DATA__ 47 | 48 | foo 49 | 50 | q 51 | 52 | 53 | 54 | 55 | -------------------------------------------------------------------------------- /t/xmlxpath_21allnodes.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test; 8 | plan( tests => 13); 9 | 10 | 11 | use XML::Twig::XPath; 12 | ok(1); 13 | 14 | my $t= XML::Twig::XPath->new->parse( \*DATA); 15 | 16 | ok( $t); 17 | 18 | my @nodes; 19 | @nodes = $t->findnodes( '//GGG/ancestor::*'); 20 | ok(@nodes, 4); 21 | 22 | @nodes = $t->findnodes( '//GGG/descendant::*'); 23 | ok(@nodes, 3); 24 | 25 | @nodes = $t->findnodes( '//GGG/following::*'); 26 | ok(@nodes, 3); 27 | ok($nodes[0]->getName, "VVV"); 28 | ok($nodes[1]->getName, "CCC"); 29 | ok($nodes[2]->getName, "DDD"); 30 | 31 | @nodes = $t->findnodes( '//GGG/preceding::*'); 32 | ok(@nodes, 5); 33 | ok($nodes[0]->getName, "BBB"); # document order, not HHH 34 | 35 | @nodes = $t->findnodes( '//GGG/self::*'); 36 | ok(@nodes, 1); 37 | ok($nodes[0]->getName, "GGG"); 38 | 39 | @nodes = $t->findnodes( '//GGG/ancestor::* | //GGG/descendant::* | //GGG/following::* | //GGG/preceding::* | //GGG/self::*'); 40 | ok(@nodes, 16); 41 | 42 | exit 0; 43 | 44 | __DATA__ 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | -------------------------------------------------------------------------------- /t/test_expand_external_entities.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use Carp; 5 | 6 | use File::Spec; 7 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 8 | use tools; 9 | 10 | $|=1; 11 | 12 | use XML::Twig; 13 | 14 | my $TMAX=3; 15 | 16 | print "1..$TMAX\n"; 17 | 18 | my $xml_file= File::Spec->catfile( "t", "test_expand_external_entities.xml"); 19 | my $dtd_file= File::Spec->catfile( "t", "test_expand_external_entities.dtd"); 20 | 21 | my( $xml, $dtd, $xml_expanded, %ent); 22 | { local undef $/; 23 | open XML, "<$xml_file" or die "cannot open $xml_file: $!"; 24 | $xml= ; 25 | close XML; 26 | open DTD, "<$dtd_file" or die "cannot open $dtd_file: $!"; 27 | $dtd= ; 28 | close DTD; 29 | } 30 | 31 | # extract entities 32 | while( $dtd=~ m{}gx) { $ent{$1}= $2; } #" 33 | # replace in xml 34 | ($xml_expanded= $xml)=~ s{&(\w+);}{$ent{$1}}g; 35 | 36 | { 37 | my $t= XML::Twig->new( load_DTD => 1); 38 | $t->set_expand_external_entities; 39 | $t->parsefile( $xml_file); 40 | is( normalize_xml( $t->sprint), normalize_xml( $xml_expanded), "expanded document"); 41 | } 42 | 43 | { 44 | my $t= XML::Twig->new( load_DTD => 1, expand_external_ents => 1); 45 | $t->parsefile( $xml_file); 46 | is( normalize_xml( $t->sprint), normalize_xml( $xml_expanded), "expanded document"); 47 | } 48 | 49 | { 50 | (my $xml_no_dtd= $xml_expanded)=~ s{^}{}s; 51 | my $t= XML::Twig->new( load_DTD => 1, expand_external_ents => 1, do_not_output_DTD => 1); 52 | $t->parsefile( $xml_file); 53 | is( normalize_xml( $t->sprint), normalize_xml( $xml_no_dtd), "expanded document"); 54 | } 55 | 56 | exit 0; 57 | -------------------------------------------------------------------------------- /t/is_field.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use XML::Twig; 5 | 6 | $|=1; 7 | 8 | my $i=1; 9 | 10 | my $TMAX=43; # do not forget to update! 11 | 12 | print "1..$TMAX\n"; 13 | 14 | print "ok $i\n"; # loading 15 | $i++; 16 | 17 | my $t= XML::Twig->new(); 18 | $t->parse( \*DATA); 19 | 20 | 21 | foreach my $elt ($t->descendants) 22 | { if( ($elt->tag eq 'field') && !$elt->is_field) 23 | { print "not ok $i "; 24 | warn $elt->id, " not recognized as field\n"; 25 | } 26 | elsif( ($elt->tag ne 'field') && $elt->is_field) 27 | { print "not ok $i "; 28 | my $elt_id= $elt->id || $elt->text; 29 | warn " $elt_id recognized as field\n"; 30 | } 31 | else 32 | { print "ok $i\n"; } 33 | $i++; 34 | } 35 | 36 | exit 0; 37 | 38 | 39 | __DATA__ 40 | 41 | field 1 42 | 43 | text 1 text 2 44 | text 3 field 2 text 4 45 | text 5field 46 | field 3 47 | field 4 48 | field 5field 6 49 | 50 | field 7 51 | field 8 52 | 53 | field 9 54 | 0 55 | 56 | a field 10 57 | 58 | 59 | -------------------------------------------------------------------------------- /t/test_pos.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use Carp; 4 | 5 | $|=1; 6 | 7 | # test for the various conditions in navigation methods 8 | 9 | use XML::Twig; 10 | 11 | 12 | my $t= XML::Twig->new; 13 | $t->parse( 14 | ' 15 | an element 16 | an element 17 | an element 18 | an element 19 | an element 20 | an element 21 | an element 22 | '); 23 | 24 | my @data=; 25 | my @data_without_comments= grep { !m{^\s*(#.*)?$} } @data; 26 | my @test= map { s{\#.*$}{}; $_ } @data_without_comments; 27 | 28 | #my @test= map { s{#.*$}{}; $_ } grep { !m{^\s*(#.*)?$} } ; 29 | 30 | my $nb_test= @test; 31 | print "1..$nb_test\n"; 32 | 33 | my $i=1; 34 | foreach my $test (@test) 35 | { my( $id, $exp, $expected_pos)= split /\t+/, $test; 36 | chomp $expected_pos; 37 | $exp= '' if( $exp eq '_'); 38 | test( $i++, $id, $exp, $expected_pos); 39 | } 40 | 41 | 42 | sub test 43 | { my( $i, $id, $exp, $expected_pos)= @_; 44 | my $elt= $t->elt_id( $id); 45 | my $pos= $elt->pos( $exp); 46 | 47 | if( $pos == $expected_pos) 48 | { print "ok $i\n"; } 49 | else 50 | { print "not ok $i\n"; 51 | my $filter= $exp ? " filter: $exp" : ''; 52 | warn "test $i: $id $filter - expected $expected_pos, actual $pos\n"; 53 | } 54 | } 55 | 56 | exit 0; 57 | 58 | __DATA__ 59 | #id exp expected 60 | doc _ 1 61 | doc elt1 0 62 | doc toto 0 63 | elt1_1 _ 1 64 | elt1_1 elt1 1 65 | elt1_1 toto 0 66 | elt1_2 _ 2 67 | elt1_2 elt1 2 68 | elt1_2 toto 0 69 | elt2_1 _ 4 70 | elt2_1 elt1 0 71 | elt2_1 elt2 1 72 | elt2_1 toto 0 73 | elt2_2 _ 6 74 | elt2_2 elt1 0 75 | elt2_2 elt2 2 76 | elt2_2 toto 0 77 | -------------------------------------------------------------------------------- /t/test_class_selector.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use XML::Twig; 7 | 8 | use File::Spec; 9 | use lib File::Spec->catdir(File::Spec->curdir,'t'); 10 | use tools; 11 | 12 | my @DATA; 13 | while( ) { chomp; my( $cond, $expected)= split /\s*=>\s*/; push @DATA, [$cond, $expected]; } 14 | 15 | my $TMAX= 20; 16 | 17 | print "1..$TMAX\n"; 18 | 19 | my $doc=q{e1e2e3}; 20 | my $doc_dot=q{wrong e1wrong e2wrong e3e1e2e3}; 21 | 22 | my $t= XML::Twig->parse( $doc); 23 | 24 | foreach my $test (@DATA) 25 | { my( $cond, $expected)= @$test; 26 | my $got= join '', map { $_->text } $t->root->children( $cond); 27 | is( $got, $expected, "navigation: $cond" ); 28 | } 29 | 30 | if( $] > 5.008) 31 | { 32 | foreach my $test (@DATA) 33 | { my( $cond, $expected)= @$test; 34 | my $got=''; 35 | XML::Twig->new( twig_handlers => { $cond => sub { $got.= $_->text } }, 36 | css_sel => 1, 37 | ) 38 | ->parse( $doc); 39 | is( $got, $expected, "handlers (css_sel enabled): $cond" ); 40 | } 41 | 42 | foreach my $test (@DATA) 43 | { my( $cond, $expected)= @$test; 44 | next if $cond !~ m{^e}; 45 | my $got=''; 46 | XML::Twig->new( twig_handlers => { $cond => sub { $got.= $_->text } },) 47 | ->parse( $doc_dot); 48 | is( $got, $expected, "handlers (css_sel NOT enabled): $cond" ); 49 | } 50 | } 51 | else 52 | { skip( 12, 'not tested under perl < 5.8'); } 53 | 54 | 55 | 56 | 57 | __DATA__ 58 | e.c1 => e1e2 59 | e.c1[@a="v1"] => e2 60 | e.c1[@a] => e2 61 | e.c1[@a="v2"] => 62 | *.c1[@a="v1"] => e2 63 | *.c1[@a="v2" or @a="v1"] => e2 64 | .c1[@a="v1"] => e2 65 | .c1[@a="v2" or @a="v1"] => e2 66 | -------------------------------------------------------------------------------- /upd_changes: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use DDP; 7 | use Perl6::Slurp; 8 | 9 | my %date= map { split /\s+/ } ; 10 | 11 | my $changes= slurp 'Changes'; 12 | 13 | my @types= qw( added fixed improved changed removed 14 | 15 | for ($changes) 16 | { s{\nversion\s*(\d\.\d\d)\s*date\s*:\s*([\d-]*)\s*#\s*(.*)} 17 | { my $d= $2 || $date{$1}; 18 | my $c= $3 ? " - $3" : ""; 19 | "\n$1 - $d$c"; 20 | }eg; 21 | 22 | s{Changes in (\d.\d\d)} 23 | { $1 - $date{$1} }g; 24 | } 25 | 26 | open( my $out, '>', 'new_changes') or die "cannot create new_changes: $!"; 27 | print {$out} $changes; 28 | 29 | __DATA__ 30 | 1.6 1999-10-05 31 | 1.7 1999-12-07 32 | 1.8 1999-12-17 33 | 1.9 2000-02-17 34 | 1.10 2000-03-24 35 | 2.00 2000-06-05 36 | 2.01 2000-08-18 37 | 2.02 2001-01-16 38 | 3.00 2002-01-09 39 | 3.01 2002-01-09 40 | 3.02 2002-01-16 41 | 3.03 2002-03-26 42 | 3.04 2002-04-01 43 | 3.05 2002-07-09 44 | 3.06 2002-09-17 45 | 3.07 2002-09-17 46 | 3.08 2002-09-17 47 | 3.09 2002-11-10 48 | 3.10 2003-06-09 49 | 3.11 2003-08-28 50 | 3.12 2004-01-29 51 | 3.13 2004-03-16 52 | 3.14 2004-03-17 53 | 3.15 2004-04-05 54 | 3.16 2005-02-11 55 | 3.17 2005-03-16 56 | 3.18 2005-08-08 57 | 3.19 2005-08-10 58 | 3.20 2005-08-11 59 | 3.21 2005-08-12 60 | 3.22 2005-10-14 61 | 3.23 2006-01-23 62 | 3.24 2006-05-09 63 | 3.25 2006-05-10 64 | 3.26 2006-07-01 65 | 3.28 2007-01-05 66 | 3.29 2007-01-22 67 | 3.30 2007-11-06 68 | 3.31 2007-11-07 69 | 3.32 2007-11-13 70 | 3.33 2010-01-15 71 | 3.34 2010-01-18 72 | 3.35 2010-05-15 73 | 3.36 2010-10-07 74 | 3.37 2010-10-09 75 | 3.38 2011-02-26 76 | 3.39 2011-09-21 77 | 3.40 2012-05-10 78 | 3.41 2012-08-08 79 | 3.42 2012-11-08 80 | 3.43 2013-05-12 81 | 3.44 2013-05-13 82 | 83 | -------------------------------------------------------------------------------- /t/test_need_use_bytes.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | 4 | # tests that require IO::Scalar to run 5 | use strict; 6 | use Carp; 7 | 8 | use File::Spec; 9 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 10 | use tools; 11 | 12 | #$|=1; 13 | my $DEBUG=0; 14 | 15 | use XML::Twig; 16 | 17 | BEGIN 18 | { eval "use bytes"; 19 | if( $@) 20 | { print "1..1\nok 1\n"; 21 | warn "skipping, need to be able to use bytes\n"; 22 | exit; 23 | } 24 | } 25 | 26 | print "1..2\n"; 27 | 28 | my $text= "été"; 29 | my $text_safe= "été"; 30 | my $text_safe_hex= "été"; 31 | my $doc=qq{\n$text}; 32 | my $doc_safe=qq{\n$text_safe}; 33 | my $doc_safe_hex=qq{\n$text_safe_hex}; 34 | 35 | my $t= XML::Twig->new()->parse( $doc); 36 | 37 | if( $] == 5.008) 38 | { skip( 2); } 39 | else 40 | { $t->set_output_text_filter( sub { my $text= shift; 41 | use bytes; 42 | $text=~ s{([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)} 43 | {XML::Twig::_XmlUtf8Decode($1)}egs; 44 | return $text; 45 | } 46 | ); 47 | is( $t->sprint, $doc_safe, 'safe with _XmlUtf8Decode'); # test 338 48 | $t->set_output_text_filter( sub { my $text= shift; 49 | use bytes; 50 | $text=~ s{([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)} 51 | {XML::Twig::_XmlUtf8Decode($1, 1)}egs; 52 | return $text; 53 | } 54 | ); 55 | is( $t->sprint, $doc_safe_hex, 'safe_hex with _XmlUtf8Decode'); # test 339 56 | } 57 | 58 | 59 | exit 0; 60 | -------------------------------------------------------------------------------- /t/test_cdata.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use XML::Twig; 6 | 7 | $|=1; 8 | 9 | $/= "\n\n"; 10 | my $xml= ; 11 | 12 | print "1..4\n"; 13 | 14 | my( $t, $result, $expected_result); 15 | 16 | $t= XML::Twig->new( twig_handlers => { 'ehtml/#CDATA' => sub { $_->set_asis; } }); 17 | $t->parse( $xml); 18 | $result= $t->sprint; 19 | ($expected_result=)=~ s{\n*$}{}s; 20 | if( $result eq $expected_result) { print "ok 1\n"; } 21 | else { print "not ok 1\n"; warn "expected: $expected_result\n result : $result"; } 22 | 23 | $t= XML::Twig->new( twig_handlers => { 'ehtml/#CDATA' => sub { $_->remove_cdata; } }); 24 | $t->parse( $xml); 25 | $result= $t->sprint; 26 | ($expected_result=)=~ s{\n*$}{}s; 27 | if( $result eq $expected_result) { print "ok 2\n"; } 28 | else { print "not ok 2\n"; warn "expected: $expected_result\n result : $result"; } 29 | 30 | $t= XML::Twig->new( keep_encoding => 1, twig_handlers => { 'ehtml/#CDATA' => sub { $_->set_asis; } }); 31 | $t->parse( $xml); 32 | $result= $t->sprint; 33 | ($expected_result=)=~ s{\n*$}{}s; 34 | if( $result eq $expected_result) { print "ok 3\n"; } 35 | else { print "not ok 3\n"; warn "test keep_encoding / asis\n expected: $expected_result\n result : $result"; } 36 | 37 | $t= XML::Twig->new( keep_encoding => 1, twig_handlers => { 'ehtml/#CDATA' => sub { $_->remove_cdata; } }); 38 | $t->parse( $xml); 39 | $result= $t->sprint; 40 | ($expected_result=)=~ s{\n*$}{}s; 41 | if( $result eq $expected_result) { print "ok 4\n"; } 42 | else { print "not ok 4\n"; warn "test keep_encoding / remove_cdata\n expected: $expected_result\n result : $result"; } 43 | 44 | exit 0; 45 | 46 | __DATA__ 47 | 48 | text 49 | world & all]]> 50 | 51 | 52 | texthello
world & all 53 | 54 | texthello<br>world & all 55 | 56 | texthello
world & all 57 | 58 | texthello<br>world & all 59 | 60 | -------------------------------------------------------------------------------- /t/test_safe_encode.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use File::Spec; 6 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 7 | use tools; 8 | 9 | use XML::Twig; 10 | 11 | my $DEBUG=0; 12 | 13 | print "1..8\n"; 14 | 15 | if( $] >= 5.006) { eval "use utf8;"; } 16 | 17 | # suitable for perl 5.6.* 18 | my $doc=q{<élément att="été">été}; 19 | (my $safe_xml_doc= $doc)=~ s{é}{é}g; 20 | (my $safe_hex_doc= $doc)=~ s{é}{é}g; 21 | (my $text_safe_xml_doc= $doc)=~ s{été}{ét&233;}g; 22 | (my $text_safe_hex_doc= $doc)=~ s{é}{ét&xe9;}g; 23 | 24 | is( XML::Twig->new( output_filter => 'safe')->parse( $doc)->sprint, $safe_xml_doc, "output_filter => 'safe'"); 25 | is( XML::Twig->new( output_filter => 'safe_hex')->parse( $doc)->sprint, $safe_hex_doc, "output_filter => 'safe_hex'"); 26 | is( XML::Twig->new( output_text_filter => 'safe')->parse( $doc)->sprint, $safe_xml_doc, "output_text_filter => 'safe'"); 27 | is( XML::Twig->new( output_text_filter => 'safe_hex')->parse( $doc)->sprint, $safe_hex_doc, "output_text_filter => 'safe_hex'"); 28 | 29 | # suitable for 5.8.* and above (you can't have utf-8 hash keys before that) 30 | 31 | if( $] < 5.008) 32 | { skip( 4 => "cannot process utf-8 attribute names with a perl before 5.8"); } 33 | else 34 | { 35 | my $doc='<élément atté="été">été'; 36 | (my $safe_xml_doc= $doc)=~ s{é}{é}g; 37 | (my $safe_hex_doc= $doc)=~ s{é}{é}g; 38 | (my $text_safe_xml_doc= $doc)=~ s{été}{ét&233;}g; 39 | (my $text_safe_hex_doc= $doc)=~ s{é}{ét&xe9;}g; 40 | 41 | is( XML::Twig->new( output_filter => 'safe')->parse( $doc)->sprint, $safe_xml_doc, "output_filter => 'safe'"); 42 | is( XML::Twig->new( output_filter => 'safe_hex')->parse( $doc)->sprint, $safe_hex_doc, "output_filter => 'safe_hex'"); 43 | is( XML::Twig->new( output_text_filter => 'safe')->parse( $doc)->sprint, $safe_xml_doc, "output_text_filter => 'safe'"); 44 | is( XML::Twig->new( output_text_filter => 'safe_hex')->parse( $doc)->sprint, $safe_hex_doc, "output_text_filter => 'safe_hex'"); 45 | } 46 | -------------------------------------------------------------------------------- /t/test_pi_handler.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use Carp; 4 | 5 | # test for the various conditions in navigation methods 6 | 7 | $|=1; 8 | 9 | use XML::Twig; 10 | 11 | if( $] < 5.008) 12 | { warn "skipped, not tested under perl < 5.8\n"; print "1..1\nok 1\n"; exit 0; } 13 | 14 | my $nb_tests=4; 15 | print "1..$nb_tests\n"; 16 | 17 | my $result; 18 | my $t= XML::Twig->new( pi => 'process', 19 | twig_handlers => { '?pi' => sub { $result .=$_->text; } }, 20 | ); 21 | $t->parse( q{}); 22 | my $expected= ''; 23 | if( $result eq $expected) 24 | { print "ok 1\n"; } 25 | else 26 | { print "not ok 1\n"; 27 | warn "expected: $expected\nfound : $result\n"; 28 | } 29 | 30 | $result=''; 31 | $t= XML::Twig->new( pi => 'process', 32 | twig_handlers => { '?pi' => sub { $result .=$_->text; } }, 33 | ); 34 | $t->parse( q{}); 35 | $expected= ''; 36 | if( $result eq $expected) 37 | { print "ok 2\n"; } 38 | else 39 | { print "not ok 2\n"; 40 | warn "expected: $expected\nfound : $result\n"; 41 | } 42 | 43 | $result=''; 44 | $t= XML::Twig->new( twig_handlers => { 'doc' => sub { $result= $_->{extra_data}; } },); 45 | $t->parse( q{}); 46 | $expected= ''; 47 | if( $result eq $expected) 48 | { print "ok 3\n"; } 49 | else 50 | { print "not ok 3\n"; 51 | warn "expected: $expected\nfound : $result\n"; 52 | } 53 | 54 | 55 | $result=''; 56 | $t= XML::Twig->new( pi => 'process', 57 | twig_roots => { '?pi' => sub { $result= $_->target . "/" . $_->data; }, 58 | elt => sub { }, 59 | }); 60 | $t->parse( q{}); 61 | $expected= 'pi/pi in doc '; 62 | if( $result eq $expected) 63 | { print "ok 4\n"; } 64 | else 65 | { print "not ok 4\n"; 66 | warn "expected: /$expected/\nfound : /$result/\n"; 67 | } 68 | 69 | exit 0; 70 | -------------------------------------------------------------------------------- /t/xmlxpath_test_with_handlers.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 3 | 4 | use Test; 5 | plan( tests => 7); 6 | 7 | use XML::Twig::XPath; 8 | 9 | $|=1; 10 | 11 | my $doc= 12 | ' 13 | elt 1 14 | elt 2 15 | 16 | elt 3 17 | 18 | 19 | 2 20 | 3 21 | 22 | 23 | 24 | 2 25 | 3 26 | 27 | 28 | 2 29 | 3 30 | 31 | in_elt6-1 32 | in_elt7-1 33 | in_elt7-2 34 | 35 | <:elt id=":elt">yep, that is a valid name 36 | ' 37 | ; 38 | 39 | my $t= XML::Twig::XPath->new( twig_handlers => 40 | { elt5 => sub { my @res1= $_->findnodes( './elt3/elt4[@att_int="3"] | elt3'); 41 | ok( ids( @res1), "elt3-1 - elt4-2 - elt3-2 - elt4-4"); # 1 42 | ok( $_->field( 'elt7[@id="elt7-2"]'), "in_elt7-2"); # 2 43 | ok( $_->findvalue( 'elt7[@id="elt7-2"]'), "in_elt7-2"); # 3 44 | ok( $_->findvalue( 'elt7[preceding-sibling::*[1][self::elt6]]'), "in_elt7-1"); # 4 45 | ok( $_->findvalue( 'elt7[preceding-sibling::elt6]'), "in_elt7-1in_elt7-2"); # 5 46 | ok( $_->findvalue( "elt7"), "in_elt7-1in_elt7-2"); # 6 47 | }, 48 | }, 49 | ); 50 | $t->parse( $doc); 51 | ok( ids( $t->findnodes( '//elt3/elt4[@att_int="3"] | //elt3') ), "elt3-1 - elt4-2 - elt3-2 - elt4-4"); # 7 52 | 53 | exit 0; 54 | 55 | sub ids 56 | { return join( " - ", map { $_->id } @_); } 57 | -------------------------------------------------------------------------------- /t/test_3_55.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use XML::Twig; 7 | 8 | use File::Spec; 9 | use lib File::Spec->catdir( File::Spec->curdir, "t" ); 10 | use tools; 11 | 12 | my $TMAX = 28; 13 | print "1..$TMAX\n"; 14 | 15 | # fixing holes in test coverage (and bugs in the code) 16 | { 17 | my $doc = ' 18 | 0 19 | 1 20 | 1 21 | 0 22 | foo 23 | '; 24 | my ( $res_e0, $res_e1, $res_c0, $res_c1, $res_efoo, $res_cfoo ); 25 | my %tests = ( 26 | 'c[string()=0]' => 'e1e4', 27 | 'c[string()=0.0]' => 'e1e4', 28 | 'c[string()=1]' => 'e2e3', 29 | 'c[string()=1.0]' => 'e2e3', 30 | 'c[string()="foo"]' => 'e5', 31 | 'c[string() >= 1]' => 'e2e3', 32 | 'c[string() >= 0]' => 'e1e2e3e4', 33 | 'c[string() != 0]' => 'e2e3', 34 | 'c[string() < 1]' => 'e1e4', 35 | 'c[string() <= 1]' => 'e1e2e3e4', 36 | 'c[string() <= 0]' => 'e1e4', 37 | 'c[string() < 0]' => '', 38 | 'c[string() > 1]' => '', 39 | 'c[string() =~ /^1$/]' => 'e2e3', 40 | ); 41 | my $handlers = {}; 42 | my $res={}; 43 | foreach my $sel ( keys %tests ) { 44 | $handlers->{$sel} = sub { add_parent_id( $res, $sel ); }; 45 | my $esel = esel($sel); 46 | $handlers->{$esel} = sub { add_id( $res, $esel ); }; 47 | } 48 | 49 | XML::Twig->new( twig_handlers => $handlers )->parse($doc); 50 | 51 | foreach my $sel ( keys %tests ) { 52 | is( $res->{$sel}, $tests{$sel}, "testing twig_handlers trigger $sel" ); 53 | my $esel = esel($sel); 54 | is( $res->{$esel}, $tests{$sel}, "testing twig_handlers trigger $esel" ); 55 | } 56 | 57 | } 58 | 59 | sub esel { 60 | my ($sel) = @_; 61 | return $sel =~ s{\Qc[string()}{e[string(c)}r; 62 | } 63 | 64 | sub add_id { 65 | my ( $res, $key ) = @_; 66 | $res->{$key} .= $_->id; 67 | 1; 68 | } 69 | 70 | sub add_parent_id { 71 | my ( $res, $key ) = @_; 72 | $res->{$key} .= $_->parent->id; 73 | 1; 74 | } 75 | 76 | exit; 77 | 78 | -------------------------------------------------------------------------------- /t/test_comment_handler.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use Carp; 4 | 5 | # test for the various conditions in navigation methods 6 | 7 | use XML::Twig; 8 | 9 | if( $] < 5.008) 10 | { warn "skipped, not tested under perl < 5.8\n"; print "1..1\nok 1\n"; exit 0; } 11 | 12 | my $nb_tests=4; 13 | print "1..$nb_tests\n"; 14 | 15 | { 16 | my $result; 17 | my $t= XML::Twig->new( comments => 'process', 18 | twig_handlers => { '#COMMENT' => sub { $result .=$_->text; } }, 19 | ); 20 | $t->parse( q{}); 21 | my $expected= ' comment in doc '; 22 | if( $result eq $expected) 23 | { print "ok 1\n"; } 24 | else 25 | { print "not ok 1\n"; 26 | warn "expected: $expected\nfound : $result\n"; 27 | } 28 | } 29 | 30 | { 31 | my $result=''; 32 | my $t= XML::Twig->new( comments => 'process', 33 | twig_handlers => { '#COMMENT' => sub { $result .=$_->text; } }, 34 | ); 35 | $t->parse( q{}); 36 | my $expected= ' comment in doc '; 37 | if( $result eq $expected) 38 | { print "ok 2\n"; } 39 | else 40 | { print "not ok 2\n"; 41 | warn "expected: $expected\nfound : $result\n"; 42 | } 43 | } 44 | 45 | { 46 | my $result=''; 47 | my $t= XML::Twig->new( twig_handlers => { 'doc' => sub { $result= $_->{extra_data}; } },); 48 | $t->parse( q{}); 49 | my $expected= ''; 50 | if( $result eq $expected) 51 | { print "ok 3\n"; } 52 | else 53 | { print "not ok 3\n"; 54 | warn "expected: $expected\nfound : $result\n"; 55 | } 56 | } 57 | 58 | { 59 | my $result=''; 60 | my $t= XML::Twig->new( comments => 'process', 61 | twig_roots => { '/#COMMENT' => sub { $result= $_->{extra_data}; }, 62 | elt => sub { }, 63 | }); 64 | $t->parse( q{}); 65 | my $expected= ''; # This is a bug! 66 | if( $result eq $expected) 67 | { print "ok 4\n"; } 68 | else 69 | { print "not ok 4\n"; 70 | warn "expected: $expected\nfound : $result\n"; 71 | } 72 | } 73 | 74 | exit 0; 75 | 76 | -------------------------------------------------------------------------------- /t/test_erase.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use XML::Twig; 5 | 6 | $|=1; 7 | 8 | my $TMAX=1; # do not forget to update! 9 | print "1..$TMAX\n"; 10 | 11 | undef $/; 12 | my $doc=; 13 | 14 | my $t= XML::Twig->new(keep_spaces => 1); 15 | $t->parse( $doc); 16 | foreach my $erase ($t->descendants( 'erase')) 17 | { $erase->erase; } 18 | my $result=$t->sprint; 19 | $result=~ s{\s*$}{}s; # remove trailing spaces (and \n) 20 | 21 | my $expected_result= $doc; 22 | $expected_result=~ s{}{}g; 23 | $expected_result=~ s{\s*$}{}s; # remove trailing spaces (and \n) 24 | 25 | if( $result eq $expected_result) 26 | { print "ok 1\n"; } 27 | else 28 | { print "not ok 1\n"; 29 | print STDERR "expected: \n$expected_result\n", 30 | "real: \n$result\n"; 31 | } 32 | 33 | exit 0; 34 | 35 | 36 | __DATA__ 37 | 38 | 39 | 40 | 41 | text 42 | text (1) 43 | text text (2) 44 | 45 | 46 | 47 | 48 | 49 | 50 | text (3) 51 | text text (4) 52 | text (5) text (6) 53 | text (7)text (8) text (9) 54 | text (10) 55 | text (11) 56 | text 57 | 58 | 59 | 60 | text (12) 61 | text (13)text (14) 62 | text (15) text (16) 63 | text (17)text (18) text (19) 64 | text (20)child/> 65 | text (21)child/> 66 | text (22) 67 | 68 | 69 | -------------------------------------------------------------------------------- /t/test_unique_xpath.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use File::Spec; 6 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 7 | use tools; 8 | 9 | use XML::Twig; 10 | print "1..65\n"; 11 | 12 | my $t= XML::Twig->new->parse( \*DATA); 13 | 14 | foreach my $c ($t->descendants( 'c')) 15 | { is( $c->xpath, $c->text, "xpath"); 16 | is( $t->findvalue( $c->text), $c->text, "findvalue (>0)"); 17 | } 18 | foreach my $d ($t->descendants( 'd')) 19 | { is( $t->findvalue( $d->text), $d->text, "findvalue (<0)"); } 20 | 21 | foreach( 1..4) 22 | { is( $_, $t->root->first_child( "[$_]")->att( 'pos'), "first_child[$_]"); 23 | is( 5-$_, $t->root->first_child( "[-$_]")->att( 'pos'), "first_child[-$_]"); 24 | is( $_, $t->root->first_child( "b[$_]")->att( 'pos'), "first_child b[$_]"); 25 | is( 5-$_, $t->root->first_child( "b[-$_]")->att( 'pos'), "first_child b[-$_]"); 26 | } 27 | 28 | my $e= $t->get_xpath( '/a/b[-1]/e', 0); 29 | foreach( 1..4) 30 | { is( $_, $e->first_child( "f[$_]")->att( 'fpos'), "first_child f[$_]"); 31 | is( 5-$_, $e->first_child( "f[-$_]")->att( 'fpos'), "first_child f[-$_]"); 32 | is( $_, $e->first_child( "g[$_]")->att( 'gpos'), "first_child g[$_]"); 33 | is( 5-$_, $e->first_child( "g[-$_]")->att( 'gpos'), "first_child g[-$_]"); 34 | } 35 | 36 | foreach( 1..8) 37 | { is( $_, $e->first_child( "[$_]")->att( 'pos'), "first_child [$_]"); 38 | is( 9-$_, $e->first_child( "[-$_]")->att( 'pos'), "first_child [-$_]"); 39 | } 40 | 41 | 42 | exit 0; 43 | 44 | __DATA__ 45 | 46 | 47 | /a/b[1]/c[1] 48 | /a/b[1]/c[2] 49 | /a/b[-4]/d[-2] 50 | /a/b[-4]/d[-1] 51 | 52 | 53 | /a/b[2]/c[1] 54 | /a/b[-3]/d[-2] 55 | /a/b[-3]/d[-1] 56 | tata 57 | /a/b[2]/c[2] 58 | 59 | 60 | /a/b[3]/c 61 | 62 | 63 | titi 64 | /a/b[4]/c 65 | /a/b[4]/d[-1] 66 | tutu 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | -------------------------------------------------------------------------------- /t/test_class_methods.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | 4 | # testing methods on class attribute: 5 | # class set_class add_to_class att_to_class add_att_to_class move_att_to_class 6 | # tag_to_class add_tag_to_class set_tag_class in_class 7 | 8 | use strict; 9 | use Carp; 10 | 11 | use File::Spec; 12 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 13 | use tools; 14 | 15 | use XML::Twig; 16 | 17 | my $DEBUG=0; 18 | 19 | my $TMAX=26; 20 | 21 | print "1..$TMAX\n"; 22 | 23 | { 24 | my $root= XML::Twig->new->parse( q{})->root; 25 | nok( $root->class, "no class"); 26 | $root->set_class( 'foo'); 27 | is( $root->class, 'foo', 'set_class'); 28 | $root->set_class( 'bar'); 29 | is( $root->class, 'bar', 'set_class'); 30 | ok( $root->in_class( 'bar'), 'in_class (ok)'); 31 | nok( $root->in_class( 'foo'), 'in_class (nok)'); 32 | $root->add_to_class( 'foo'); 33 | ok( $root->in_class( 'bar'), 'in_class (ok)'); 34 | ok( $root->in_class( 'foo'), 'in_class (ok)'); 35 | nok( $root->in_class( 'baz'), 'in_class (nok)'); 36 | $root->tag_to_class; 37 | is( $root->class, 'doc', 'tag_to__class'); 38 | ok( $root->in_class( 'doc'), 'in_class (ok)'); 39 | nok( $root->in_class( 'foo'), 'in_class (nok)'); 40 | $root->tag_to_class; 41 | is( $root->class, 'doc', 'tag_to_class (with existing class)'); 42 | $root->add_tag_to_class; 43 | is( $root->class, 'doc', 'add_tag_to_class'); 44 | $root->att_to_class( 'att1'); 45 | is( $root->class, 'val1', 'att_to_class'); 46 | $root->att_to_class( 'att1'); 47 | is( $root->class, 'val1', 'att_to_class (with existing class)'); 48 | $root->add_att_to_class( 'att'); 49 | is( $root->class, 'val1', 'att_to_class (non existing att)'); 50 | $root->add_att_to_class( 'att2'); 51 | is( $root->class, 'val1 val2', 'att_to_class (2 classes now)'); 52 | ok( $root->in_class( 'val1'), 'in_class'); 53 | ok( $root->in_class( 'val2'), 'in_class'); 54 | nok( $root->in_class( 'val'), 'in_class (nok)'); 55 | $root->set_tag_class( 'new'); 56 | is( $root->sprint, '', 'set_tag_class'); 57 | $root->move_att_to_class( 'att2'); 58 | is( $root->sprint, '', 'set_tag_class'); 59 | 60 | ok( $root->matches( '.doc'), 'match on class (first)'); 61 | ok( $root->matches( '.val1'), 'match on class (middle)'); 62 | ok( $root->matches( '.val2'), 'match on class (last)'); 63 | nok( $root->matches( '.val'), 'match on class (not good)'); 64 | 65 | } 66 | 67 | 68 | exit 0; 69 | -------------------------------------------------------------------------------- /t/test_xml_split_g.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use Carp; 5 | 6 | use File::Spec; 7 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 8 | use tools; 9 | use Config; 10 | my $devnull = File::Spec->devnull; 11 | my $DEBUG=1; 12 | 13 | # be cautious: run this only on systems I have tested it on 14 | my %os_ok=( linux => 1, solaris => 1, darwin => 1, MSWin32 => 1); 15 | if( !$os_ok{$^O}) { print "1..1\nok 1\n"; warn "skipping, test runs only on some OSs\n"; exit; } 16 | 17 | if( $] < 5.006) { print "1..1\nok 1\n"; warn "skipping, xml_merge runs only on perl 5.6 and later\n"; exit; } 18 | 19 | print "1..13\n"; 20 | 21 | my $perl = used_perl(); 22 | my $xml_split = File::Spec->catfile( "tools", "xml_split", "xml_split"); 23 | my $xml_merge = File::Spec->catfile( "tools", "xml_merge", "xml_merge"); 24 | 25 | sys_ok( "$perl -c $xml_split", "xml_split compilation"); 26 | sys_ok( "$perl -c $xml_merge", "xml_merge compilation"); 27 | 28 | my $xml= q{} . join( "\n ", map { elt( $_) } (1..10)) . qq{\n}; 29 | my $xml_file= "test_xml_split_g.xml"; 30 | spit( $xml_file => $xml); 31 | 32 | systemq( "$perl $xml_split -g 3 -n 3 $xml_file"); 33 | my $main_file= "test_xml_split_g-000.xml"; 34 | my @files= map { sprintf( "test_xml_split_g-%03d.xml", $_) } (1..4); 35 | foreach ( $main_file, @files) { ok( -f $_, "created $_"); } 36 | 37 | is_like( slurp( "test_xml_split_g-000.xml"), q{} . join( '', map { ""} @files) . q{}, 38 | "main file content"); 39 | 40 | is_like( slurp( "test_xml_split_g-001.xml"), sub_file( 1..3), "test_xml_split_g-001.xml content"); 41 | is_like( slurp( "test_xml_split_g-002.xml"), sub_file( 4..6), "test_xml_split_g-002.xml content"); 42 | is_like( slurp( "test_xml_split_g-003.xml"), sub_file( 7..9), "test_xml_split_g-003.xml content"); 43 | is_like( slurp( "test_xml_split_g-004.xml"), sub_file( 10), "test_xml_split_g-004.xml content"); 44 | 45 | unlink $xml_file; 46 | 47 | systemq( "$perl $xml_merge $main_file > $xml_file"); 48 | 49 | is_like( slurp( $xml_file), $xml, "merge result"); 50 | 51 | unlink $xml_file, $main_file, @files; 52 | 53 | sub sub_file 54 | { my @elt_nb= @_; 55 | return q{} 56 | . join( '', map { elt( $_)} @elt_nb) 57 | . q{}; 58 | } 59 | 60 | sub elt 61 | { my( $nb)= @_; 62 | return qq{element $nb}; 63 | } 64 | 65 | sub systemq 66 | { warn "$_[0]\n" if( !$DEBUG); 67 | system $_[0]; 68 | } 69 | 70 | 71 | -------------------------------------------------------------------------------- /parse_random_files: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Bug in XML::Twig? 4 | # 5 | 6 | 7 | use strict; 8 | use warnings; 9 | 10 | use lib "lib"; 11 | use XML::Twig::XPath; 12 | 13 | use Getopt::Std; 14 | my %opt; 15 | getopts( 'dn:s:S:', \%opt); # -d uses dispose 16 | # -n number of iterations (default 5) 17 | # -s set the rng seed 18 | # -S 1-10 size of the individual size default 8 19 | 20 | my $f_xml = "to_parse.xml"; 21 | my $prog = $0; 22 | 23 | my $nb= $opt{n} || 5; 24 | srand( $opt{s}) if $opt{s}; 25 | 26 | my $fsize= $opt{S} || 8; 27 | if( $fsize < 1 || $fsize > 10) { die "out-of-bounds value for -S option, must be 1-10\n"; } 28 | 29 | sub mem 30 | { 31 | my $ps = ($^O eq "cygwin") ? "procps" : "ps"; ## "procps" in cygwin 32 | my $size= `$ps aux | grep $prog | grep -v grep | grep -v gvim | perl -l -n -a -e'print \$F[5]'`; 33 | return formated( $size); 34 | } 35 | 36 | sub say 37 | { 38 | print scalar localtime(), ' | ', sprintf( "%-45s", @_), " : ", mem(), "\n"; 39 | } 40 | 41 | 42 | say "start"; 43 | 44 | foreach (1..$nb) 45 | { my $size= gen_random_files( $f_xml, $fsize); 46 | my $atwig = XML::Twig::XPath->new(); 47 | $atwig->safe_parsefile($f_xml) 48 | or die "can't load xml"; 49 | # use XPath searches to check for leakage 50 | my @hits_att = $atwig->findnodes( '/doc/line/hit[@att="abar"]'); 51 | my @hits_text = $atwig->findnodes( 'doc/line/hit[text()="efoo"]'); 52 | 53 | say sprintf( "run %3d (%s l) (hits: %6d - %6d)", $_, $size, scalar( @hits_att), scalar( @hits_text)); 54 | 55 | if( $opt{d}) 56 | { 57 | $atwig->dispose(); 58 | #say "dispose"; 59 | } 60 | } 61 | 62 | say "end"; 63 | 64 | 65 | sub gen_random_files 66 | { my( $file)= @_; 67 | my $size= int( 2**(rand($fsize+5)+5) + rand( 1000)) ; 68 | open( my $out, '>', $file) or die "cannot create $file: $!"; 69 | print {$out} "\n"; 70 | foreach my $l (1..$size) 71 | { print {$out} qq{ lorem ipsus whatever (clever latin stuff) no $l}; 72 | foreach my $m ( qw(foo bar baz)) { print {$out} qq{$m $le$m} if rand(2) > 1; } 73 | print {$out} qq{\n}; 74 | } 75 | print {$out} qq{\n}; 76 | close $out; 77 | return formated( $size); 78 | } 79 | 80 | sub formated 81 | { my( $nb)= shift; 82 | chomp $nb; 83 | $nb=~ s{(\d?\d?\d)(\d\d\d)(\d\d\d)$}{$1 $2 $3}; 84 | $nb=~ s{(\d?\d?\d)(\d\d\d)$}{$1 $2}; 85 | $nb= sprintf "%9s", $nb; 86 | return $nb; 87 | } 88 | 89 | -------------------------------------------------------------------------------- /t/test_mark.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | 4 | # test the mark method 5 | 6 | use strict; 7 | use Carp; 8 | 9 | use File::Spec; 10 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 11 | use tools; 12 | 13 | #$|=1; 14 | my $DEBUG=0; 15 | 16 | use XML::Twig; 17 | 18 | my $perl= $]; 19 | 20 | my @data= map { chomp; [split /\t+/] } ; 21 | 22 | my $TMAX= 2 * @data; 23 | print "1..$TMAX\n"; 24 | 25 | foreach my $test (@data) 26 | { my( $doc, $regexp, $elts, $hits, $result)= @$test; 27 | (my $quoted_elts= $elts)=~ s{(\w+)}{'$1'}g; 28 | my @elts= eval( "($quoted_elts)"); 29 | my $t= XML::Twig->new->parse( $doc); 30 | my $root= $t->root; 31 | my @hits= $root->mark( $regexp, @elts); 32 | is( $t->sprint, $result, "mark( /$regexp/, $quoted_elts) on $doc"); 33 | is( scalar @hits, $hits, 'nb hits'); 34 | } 35 | 36 | 37 | exit 0; 38 | 39 | # doc regexp elts hits result 40 | __DATA__ 41 | text X (X) s 1 text X 42 | text X X s 1 text 43 | text X s 0 text 44 | text (X) s 0 text 45 | text X X s 1 text 46 | text X (X) s 1 text X 47 | text X \s*X\s* s 1 text 48 | text X \s*(X)\s* s 1 textX 49 | text X (\s*X\s*) s 1 text X 50 | text X text X s 1 text text 51 | text X text (X) s 1 text X text 52 | text X text \s*X\s* s 1 texttext 53 | text X text \s*(X)\s* s 1 textXtext 54 | text X text (\s*X\s*) s 1 text X text 55 | text XX X s 2 text 56 | text XX (X) s 2 text XX 57 | text X X X s 2 text 58 | text X X (X) s 2 text X X 59 | text XX text X s 2 text text 60 | text XX text (X) s 2 text XX text 61 | text XY text Y text X ([XY]+) s 3 text XY text Y text X 62 | text X X s, {a => 1} 1 text 63 | text X (X) s, {a => 1, b => 2} 1 text X 64 | text X1Y2 text X0 Y0X3Y4 text X X(\d)Y(\d) s 4 text 12 text X0 Y034 text X 65 | -------------------------------------------------------------------------------- /t/test2.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use File::Spec; 6 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 7 | use tools; 8 | 9 | # This tests the doctype and DTD access functions 10 | 11 | $|=1; 12 | 13 | use XML::Twig; 14 | use Cwd; 15 | 16 | $0 =~ s!\\!/!g; 17 | my ($DIR,$PROG) = $0 =~ m=^(.*/)?([^/]+)$=; 18 | $DIR =~ s=/$== || chop($DIR = cwd()); 19 | 20 | chdir $DIR; 21 | 22 | my $i=0; 23 | my $failed=0; 24 | 25 | my $TMAX=15; # don't forget to update! 26 | 27 | print "1..$TMAX\n"; 28 | 29 | # test twig creation 30 | my $t= new XML::Twig(); 31 | ok( $t, 'twig creation'); 32 | 33 | # first test an internal DTD 34 | 35 | my $in_file= "test2_1.xml"; 36 | 37 | my $res_file= "test2_1.res"; 38 | my $exp_file= "test2_1.exp"; 39 | 40 | # test parse no dtd info required 41 | $t->parsefile( $in_file, ErrorContext=>2); 42 | ok( $t, 'parse'); 43 | 44 | open( RES, ">$res_file") or die "cannot open $res_file:$!"; 45 | $t->print( \*RES); 46 | close RES; 47 | ok( $res_file, $exp_file, "flush"); 48 | 49 | $res_file= 'test2_2.res'; 50 | $exp_file= 'test2_2.exp'; 51 | open( RES, ">$res_file") or die "cannot open $res_file:$!"; 52 | $t->print( \*RES, Update_DTD => 1); 53 | close RES; 54 | ok( $res_file, $exp_file, "flush"); 55 | 56 | $t= new XML::Twig(); 57 | ok( $t, 'twig creation'); 58 | 59 | $in_file= "test2_2.xml"; 60 | $res_file= "test2_3.res"; 61 | $exp_file= "test2_3.exp"; 62 | 63 | $t->parsefile( $in_file, ErrorContext=>2); 64 | ok( $t, 'parse'); 65 | open( RES, ">$res_file") or die "cannot open $res_file:$!"; 66 | 67 | my $e2=new XML::Twig::Entity( 'e2', 'entity2'); 68 | my $entity_list= $t->entity_list; 69 | $entity_list->add( $e2); 70 | 71 | my $e3=new XML::Twig::Entity( 'e3', undef, 'pic.jpeg', 'JPEG'); 72 | $entity_list= $t->entity_list; 73 | $entity_list->add( $e3); 74 | 75 | $t->print( \*RES, Update_DTD => 1); 76 | close RES; 77 | 78 | ok( $res_file, $exp_file, "flush"); 79 | 80 | my $dtd= $t->dtd; 81 | ok( !$dtd, 'dtd exits'); 82 | 83 | $t= new XML::Twig(LoadDTD=>1); 84 | ok( $t, 'twig creation'); 85 | $t->parsefile( $in_file, ErrorContext=>2, ); 86 | 87 | $dtd= $t->dtd; 88 | ok( $dtd, 'dtd not found'); 89 | 90 | my @model= sort keys %{$dtd->{model}}; 91 | stest( stringify( @model), 'doc:intro:note:para:section:title', 'element list'); 92 | 93 | stest( $t->model( 'title'), '(#PCDATA)', 'title model'); 94 | mtest( $t->model( 'section'), '\(intro\?,\s*title,\s*\(para|note\)+\)', 'section model'); 95 | stest( $t->dtd->{att}->{section}->{id}->{type}, 'ID', 'section id type'); 96 | stest( $t->dtd->{att}->{section}->{id}->{default}, '#IMPLIED', 'section id default'); 97 | exit 0; 98 | 99 | 100 | -------------------------------------------------------------------------------- /t/test_keep_atts_order.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use File::Spec; 5 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 6 | use tools; 7 | 8 | 9 | use XML::Twig; 10 | 11 | 12 | { 13 | if( eval 'require Tie::IxHash') 14 | { import Tie::IxHash; 15 | print "1..7\n"; 16 | } 17 | else 18 | { warn( "Tie::IxHash not available, option keep_atts_order not allowed\n"); 19 | print "1..1\nok 1\n"; 20 | exit 0; 21 | } 22 | 23 | my $nb_elt=10; 24 | my $doc= gen_doc( $nb_elt); 25 | 26 | my $result= XML::Twig->new( pretty_print => 'indented')->parse( $doc)->sprint; 27 | isnt( $result, $doc, "keep_atts_order => 0 (first try)"); 28 | 29 | $result= XML::Twig->new( keep_atts_order => 1, pretty_print => 'indented')->parse( $doc)->sprint; 30 | is( $result, $doc, "keep_atts_order => 1 (first try)"); 31 | 32 | $result= XML::Twig->new( pretty_print => 'indented')->parse( $doc)->sprint; 33 | isnt( $result, $doc, "keep_atts_order => 0 (second try)"); 34 | 35 | $result= XML::Twig->new( keep_atts_order => 1, pretty_print => 'indented')->parse( $doc)->sprint; 36 | is( $result, $doc, "keep_atts_order => 1 (second try)"); 37 | 38 | $result= XML::Twig->new( keep_atts_order => 1, keep_encoding => 1, pretty_print => 'indented') 39 | ->parse( $doc)->sprint; 40 | is( $result, $doc, "keep_atts_order => 1, keep_encoding => 1 (first time)"); 41 | 42 | $result= XML::Twig->new( keep_encoding => 1, pretty_print => 'indented'); 43 | 44 | $result= XML::Twig->new( keep_atts_order => 1, keep_encoding => 1, pretty_print => 'indented') 45 | ->parse( $doc)->sprint; 46 | is( $result, $doc, "keep_atts_order => 1, keep_encoding => 1 (second time)"); 47 | 48 | $result= XML::Twig->new( keep_encoding => 1, pretty_print => 'indented') 49 | ->parse( $doc)->sprint; 50 | isnt( $result, $doc, " keep_encoding => 1 (second time)"); 51 | 52 | }; 53 | 54 | exit 0; 55 | 56 | sub gen_doc 57 | { my( $nb_elt)= @_; 58 | my $doc= "\n"; 59 | 60 | foreach (1..$nb_elt) 61 | { $doc .= " $_ + 1 } (0..4) ; 67 | 68 | while( my( $att, $value)= each %atts) 69 | { $doc .= qq{ $att="$value"}; } 70 | 71 | $doc .= "/>\n"; 72 | } 73 | $doc .= "\n"; 74 | return $doc; 75 | } 76 | 77 | sub randomize 78 | { my @list= @_; 79 | my $n= @list; 80 | foreach (1..10) 81 | { my $i= int rand( $n); 82 | my $j= int rand( $n); 83 | ($list[$i], $list[$j])=($list[$j], $list[$i]) 84 | } 85 | return @list; 86 | } 87 | -------------------------------------------------------------------------------- /t/test_3_35.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use Carp; 6 | use File::Spec; 7 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 8 | use tools; 9 | 10 | $|=1; 11 | my $DEBUG=0; 12 | 13 | use XML::Twig; 14 | 15 | my $TMAX=11; 16 | print "1..$TMAX\n"; 17 | 18 | # escape_gt option 19 | { 20 | is( XML::Twig->parse( '')->root->insert_new_elt( '#COMMENT' => '- -- -')->twig->sprint, 21 | '', 'comment escaping'); 22 | } 23 | 24 | { my $t= XML::Twig->parse( 'foobarbazfoobarbaz2foobar2'); 25 | $t->root->cut_descendants( 'e[@a="c"]'); 26 | is( $t->sprint, 'bazfoobarbaz2', 'cut_descendants'); 27 | } 28 | 29 | { my $t=XML::Twig->new( pretty_print => 'none')->parse( ''); 30 | is( $t->root->_pretty_print, 0, '_pretty_print'); 31 | $t->set_pretty_print( 'indented'); 32 | is( $t->root->_pretty_print, 3, '_pretty_print'); 33 | } 34 | 35 | # additional tests to increase coverage 36 | { is( XML::Twig->parse( no_expand => 1, q{]>&foo;})->root->sprint, "&foo;\n", 'external entities with no_expand'); 37 | } 38 | 39 | { my $doc= q{fi4}; 40 | my $tmp = 'tmp-t35'; 41 | open( my $fh, '>', $tmp ); 42 | my $t= XML::Twig->new( twig_handlers => { e => sub { $_->flush( $fh); }, 43 | g => sub { is( $_[0]->elt_id( 'i4')->text, 'fi4', 'elt_id, id exists'); 44 | nok( $_[0]->elt_id( 'i3'), 'elt_id, id flushed'); 45 | }, 46 | }, 47 | ) 48 | ->parse( $doc); 49 | close $fh; 50 | is(slurp_trimmed( $tmp ), $doc, 'flush on element still outputs the entire document'); 51 | } 52 | 53 | { my $xpath=''; 54 | XML::Twig->parse( map_xmlns => { "http://foo.com" => 'bar' }, 55 | twig_handlers => { "bar:e" => sub { $xpath= $_[0]->path( $_->gi);}, }, 56 | q{} 57 | ); 58 | is( $xpath, '/bar:d/bar:e'); 59 | XML::Twig->parse( map_xmlns => { "http://foo.com" => 'bar' }, 60 | twig_handlers => { "bar:e" => sub { $xpath= $_[0]->path( $_->local_name);}, }, 61 | q{} 62 | ); 63 | is( $xpath, '/bar:d/bar:e'); 64 | } 65 | 66 | { my $t=XML::Twig->parse( pretty_print => 'none', ''); 67 | $t->first_elt( 'e3')->replace( $t->first_elt( 'e1')); 68 | is( $t->sprint, '', 'replace called on an element that has not been cut yet'); 69 | } 70 | 1; 71 | -------------------------------------------------------------------------------- /t/test_with_lwp.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use Carp; 5 | 6 | use File::Spec; 7 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 8 | use tools; 9 | 10 | 11 | $|=1; 12 | 13 | use XML::Twig; 14 | 15 | eval { require LWP; }; 16 | if( $@) { import LWP; print "1..1\nok 1\n"; warn "skipping, LWP not available\n"; exit } 17 | 18 | # skip on Win32, it looks like we have a problem there (named pipes?) 19 | if( ($^O eq "MSWin32") && ($]<5.008) ) { print "1..1\nok 1\n"; warn "skipping, *parseurl methods not available on Windows with perl < 5.8.0\n"; exit } 20 | 21 | if( perl_io_layer_used()) 22 | { print "1..1\nok 1\n"; 23 | warn "cannot test parseurl when UTF8 perIO layer used (due to PERL_UNICODE or -C option used)\n"; 24 | exit; 25 | } 26 | 27 | my $TMAX=13; 28 | 29 | chdir 't'; 30 | 31 | print "1..$TMAX\n"; 32 | 33 | { my $t= XML::Twig->new->parseurl( 'file:test_with_lwp.xml', LWP::UserAgent->new); 34 | is( $t->sprint, 'text', "parseurl"); 35 | } 36 | 37 | { 38 | my $t= XML::Twig->new->parseurl( 'file:test_with_lwp.xml'); 39 | is( $t->sprint, 'text', "parseurl"); 40 | } 41 | 42 | { 43 | my $t= XML::Twig->new->safe_parseurl( 'file:test_with_lwp.xml'); 44 | is( $t->sprint, 'text', "parseurl"); 45 | } 46 | 47 | { 48 | warn "\n\n### warning is normal here ###\n\n"; 49 | my $t=0; 50 | if ($^O ne 'VMS') 51 | { # On VMS we get '%SYSTEM-F-ABORT, abort' and an exit when a file does not exist 52 | # Behaviour is probably different on VMS due to it not having 'fork' to do the 53 | # LWP::UserAgent request and (safe) parse of that request not happening in a child process. 54 | $t = XML::Twig->new->safe_parseurl( 'file:test_with_lwp_no_file.xml'); 55 | ok( !$t, "no file"); 56 | matches( $@, '^\s*(no element found|Ran out of memory for input buffer)', "no file, error message"); 57 | } 58 | else 59 | { skip( 2 => "running on VMS, cannot test error message for non-existing file"); } 60 | } 61 | 62 | { 63 | my $t= XML::Twig->new->safe_parseurl( 'file:test_with_lwp_not_wf.xml'); 64 | ok( !$t, "not well-formed"); 65 | matches( $@, '^\s*mismatched tag', "not well-formed, error message"); 66 | } 67 | 68 | { 69 | my $t= XML::Twig->new->parsefile( 'test_with_lwp.xml'); 70 | is( $t->sprint, 'text', "parseurl"); 71 | } 72 | 73 | { 74 | my $t= XML::Twig->new->safe_parsefile( 'test_with_lwp.xml'); 75 | is( $t->sprint, 'text', "parseurl"); 76 | } 77 | 78 | { 79 | my $t= XML::Twig->new->safe_parsefile( 'test_with_lwp_no_file.xml'); 80 | ok( !$t, "no file"); 81 | matches( $@, '^\s*Couldn', "no file, error message"); 82 | } 83 | 84 | { 85 | my $t= XML::Twig->new->safe_parsefile( 'test_with_lwp_not_wf.xml'); 86 | ok( !$t, "not well-formed"); 87 | matches( $@, '^\s*mismatched tag', "not well-formed, error message"); 88 | } 89 | 90 | exit 0; 91 | 92 | -------------------------------------------------------------------------------- /t/test_ignore_elts.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use XML::Twig; 5 | 6 | $|=1; 7 | 8 | my $TMAX=1; # do not forget to update! 9 | print "1..$TMAX\n"; 10 | 11 | my $doc= read_data(); 12 | 13 | my $t= XML::Twig->new( ignore_elts => { ignore => 1 }, 14 | keep_spaces => 1, 15 | ); 16 | my $result_file= "test_ignore_elt.res1"; 17 | open( RESULT, ">$result_file") or die "cannot create $result_file: $!"; 18 | select RESULT; 19 | $t->parse( $doc); 20 | $t->print; 21 | select STDOUT; 22 | close RESULT; 23 | check_result( $result_file, 1); 24 | 25 | exit 0; 26 | 27 | # Not yet implemented 28 | 29 | # test 2 30 | $doc= read_data(); 31 | 32 | $t= XML::Twig->new( ignore_elts => { ignore => 'print' }, 33 | twig_handlers => { elt => sub { $_->print; } }, 34 | keep_spaces => 1, 35 | ); 36 | $result_file= "test_ignore_elt.res2"; 37 | open( RESULT, ">$result_file") or die "cannot create $result_file: $!"; 38 | select RESULT; 39 | $t->parse( $doc); 40 | $t->print; 41 | select STDOUT; 42 | close RESULT; 43 | check_result( $result_file, 2); 44 | 45 | 46 | 47 | sub read_data 48 | { local $/="\n\n"; 49 | my $data= ; 50 | $data=~ s{^\s*#.*\n}{}m; # get rid of comments 51 | $data=~ s{\s*$}{}s; # remove trailing spaces (and \n) 52 | $data=~ s{(^|\n)\s*(\n|$)}{}g; # remove empty lines 53 | return $data; 54 | }; 55 | 56 | 57 | sub check_result 58 | { my( $result_file, $test_no)= @_; 59 | # now check result 60 | my $expected_result= read_data(); 61 | my $result= read_result( $result_file); 62 | if( $result eq $expected_result) 63 | { print "ok $test_no\n"; } 64 | else 65 | { print "not ok $test_no\n"; 66 | print STDERR "\ntest $test_no:\n", 67 | "expected: \n$expected_result\n", 68 | "real: \n$result\n"; 69 | } 70 | } 71 | 72 | 73 | sub read_result 74 | { my $file= shift; 75 | local $/="\n"; 76 | open( RESULT, "<$file") or die "cannot read $file: $!"; 77 | my @result= grep {m/\S/} ; 78 | close RESULT; 79 | unlink $file; 80 | return join '', @result; 81 | } 82 | 83 | 84 | 85 | __DATA__ 86 | # doc 1 87 | 88 | text 89 | 90 | 91 | text 92 | 93 | 94 | 95 | # expected result 1 96 | 97 | 98 | 99 | 100 | 101 | 102 | #doc 2 103 | 104 | text 105 | 106 | 107 | 108 | text 109 | 110 | 111 | # expected result 2 112 | text 113 | 114 | 115 | 116 | text 117 | -------------------------------------------------------------------------------- /t/test_3_39.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use Carp; 6 | use File::Spec; 7 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 8 | use tools; 9 | 10 | $|=1; 11 | my $DEBUG=0; 12 | 13 | use XML::Twig; 14 | 15 | my $TMAX=12; 16 | print "1..$TMAX\n"; 17 | 18 | { 19 | my $doc='foo bar fooo baz'; 20 | 21 | my $t= XML::Twig->parse( $doc); 22 | $t->root->split( '(fo+)', e => { att => '$1' } ); 23 | is( $t->sprint, 'foo bar fooo baz', 'split, with $1 on attribute value'); 24 | 25 | $t= XML::Twig->parse( $doc); 26 | $t->root->split( '(fo+)', e => { '$1' => 'v$1' } ); 27 | is( $t->sprint, 'foo bar fooo baz', 'split, with $1 on attribute name and value'); 28 | 29 | $t= XML::Twig->parse( $doc); 30 | $t->root->split( '(fo+)', '$1' ); 31 | is( $t->sprint, 'foo bar fooo baz', 'split, with $1 on tag name'); 32 | 33 | 34 | $t= XML::Twig->parse( $doc); 35 | $t->root->split( '(foo+)', '$1', '' ); 36 | is( $t->sprint, 'foo bar fooo baz', 'split, with $1 on tag name'); 37 | 38 | $t= XML::Twig->parse( $doc); 39 | $t->root->split( '(fo+)(.*?)(a[rz])', x => { class => 'f' }, '', a => { class => 'x' }); 40 | is( $t->sprint, 'foo bar fooo baz', 'split, checking that it works with non capturing grouping'); 41 | 42 | $t= XML::Twig->parse( $doc); 43 | $t->root->split( '(fo+)(.*?)(a[rz])', x => { class => '$1' }, '', a => { class => '$3' }); 44 | is( $t->sprint, 'foo bar fooo baz', 'split, with $1 and $3 on att value'); 45 | 46 | } 47 | 48 | { my $t= XML::Twig->parse( 'e1e2'); 49 | is( join( '-', $t->findvalues( '//e')), 'e1-e2', 'findvalues'); 50 | } 51 | 52 | { my $html='

boo

'; 53 | 54 | my $well_formed = qq{$html}; 55 | my $short_doctype = qq{$html}; 56 | 57 | my $t= XML::Twig->new->parse( $well_formed); 58 | is_like( $t->sprint, $well_formed, 'valid xhtml'); 59 | if( _use( 'HTML::TreeBuilder')) 60 | { my $th= XML::Twig->new->parse_html( $well_formed); 61 | is_like( $t->sprint, $well_formed, 'valid xhtml (parsed as html)'); 62 | 63 | my $t3= XML::Twig->new->parse_html( $short_doctype); 64 | is_like( $t3->sprint, $html, 'xhtml without SYSTEM in DOCTYPE (parsed as html, no DOCTYPE output)'); 65 | 66 | my $t4= XML::Twig->new( output_html_doctype => 1)->parse_html( $short_doctype); 67 | is_like( $t4->sprint, $well_formed, 'xhtml without SYSTEM in DOCTYPE (parsed as html, with proper DOCTYPE output)'); 68 | } 69 | else 70 | { skip( 3); } 71 | 72 | my $t2= XML::Twig->new->safe_parse( $short_doctype); 73 | nok( $t2, 'xhtml without SYSTEM in DOCTYPE'); 74 | 75 | 76 | } 77 | 78 | 79 | -------------------------------------------------------------------------------- /t/xmlxpath_xpath_cond.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use File::Spec; 5 | use lib File::Spec->catdir(File::Spec->curdir,'t'); 6 | use tools; 7 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 8 | 9 | 10 | $|=1; 11 | 12 | my $t= XML::Twig::XPath->new; 13 | $t->parse( 14 | ' 15 | elt 1 16 | elt 2 17 | 18 | elt 3 19 | 20 | 21 | 2 22 | 3 23 | 24 | '); 25 | 26 | my @data= grep { !/^##/ && m{\S} } ; 27 | 28 | my @exp; 29 | my %result; 30 | 31 | foreach( @data) 32 | { chomp; 33 | my ($exp, $id_list) = split /\s*=>\s*/ ; 34 | $result{$exp}= $id_list; 35 | push @exp, $exp; 36 | } 37 | 38 | my $nb_tests= 2 + keys %result; 39 | print "1..$nb_tests\n"; 40 | 41 | my $i=1; 42 | 43 | foreach my $exp ( @exp) 44 | { my $expected_result= $result{$exp}; 45 | my @result= $t->findnodes( $exp); 46 | my $result; 47 | if( @result) 48 | { $result= join ' ', map { $_->id } @result; } 49 | else 50 | { $result= 'none'; } 51 | 52 | if( $result eq $expected_result) 53 | { print "ok $i\n"; } 54 | else 55 | { print "nok $i\n"; 56 | print STDERR "$exp: expected $expected_result - real $result\n"; 57 | } 58 | $i++; 59 | } 60 | 61 | my $exp= '//* |//@* | /'; 62 | my @result= $t->findnodes( $exp); 63 | my @elts= $t->descendants( '#ELT'); 64 | 65 | # first check the number of results 66 | my $result= @result; 67 | my $nb_atts=0; 68 | foreach (@elts) { $nb_atts+= $_->att_nb; } 69 | my $expected_result= scalar @elts + $nb_atts + 1; 70 | 71 | if( $result == $expected_result) 72 | { print "ok $i\n"; } 73 | else 74 | { print "nok $i\n"; 75 | print STDERR "$exp: expected $expected_result - real $result\n"; 76 | } 77 | $i++; 78 | 79 | # then check the results (to make sure they are in hte right order) 80 | my @expected_results; 81 | push @expected_results, "XML::Twig::XPath '" . $t->sprint ."'"; 82 | foreach my $elt (@elts) 83 | { push @expected_results, ref( $elt) . " '" . $elt->sprint . "'" ; 84 | foreach my $att ($elt->att_names) 85 | { push @expected_results, qq{XML::Twig::XPath::Attribute '$att="} . $elt->att( $att) . q{"'} ; } 86 | } 87 | $expected_result= join( "\n ", @expected_results); 88 | $result= join( "\n ", map { ref( $_) . " '" . $_->toString ."'" } @result); 89 | if( $result eq $expected_result) 90 | { print "ok $i\n"; } 91 | else 92 | { print "nok $i\n"; 93 | print STDERR "$exp:\nexpected: $expected_result\n\nreal : $result\n"; 94 | } 95 | $i++; 96 | 97 | exit 0; 98 | 99 | __DATA__ 100 | /elt => none 101 | //elt => elt-1 elt-2 elt-3 102 | /doc/elt => elt-1 elt-2 103 | /doc/elt[ last()] => elt-2 104 | //elt[@id='elt-1'] => elt-1 105 | //elt[@id="elt-1"] | //elt[@id="elt-2"] | //elt[@id="elt-3"] => elt-1 elt-2 elt-3 106 | //elt[@id="elt-1" or @id="elt-2" or @id="elt-3"] => elt-1 elt-2 elt-3 107 | //elt2[@att_int > 2] => elt2-4 108 | /doc/elt2[ last()]/* => elt2-3 elt2-4 109 | //*[@id="elt2-2"] => elt2-2 110 | /doc/elt2[./elt[@id="elt-3"]] => elt2-1 111 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | NAME 2 | 3 | XML::Twig - Tree interface to XML documents allowing processing chunk 4 | by chunk of huge documents. 5 | 6 | 7 | SUMMARY (see perldoc XML::Twig for full details) 8 | 9 | XML::Twig is (yet another!) XML transformation module. 10 | 11 | Its strong points: can be used to process huge documents while still 12 | being in tree mode; not bound by DOM or SAX, so it is very perlish and 13 | offers a very comprehensive set of methods; simple to use; DWIMs as 14 | much as possible 15 | 16 | What it doesn't offer: full SAX support (it can export SAX, but only 17 | reads XML), full XPath support (unless you use XML::Twig::XPath), nor 18 | DOM support. 19 | 20 | Other drawbacks: it is a big module, and with over 500 methods available 21 | it can be a bit overwhelming. A good starting point is the tutorial at 22 | http://xmltwig.org/xmltwig/tutorial/index.html. In fact the whole 23 | XML::Twig page at http://xmltwig.org/xmltwig/ has plenty of information 24 | to get you started with XML::Twig 25 | 26 | TOOLS 27 | 28 | XML::Twig comes with a few tools built on top of it: 29 | 30 | xml_pp XML pretty printer 31 | xml_grep XML grep - grep XML files using XML::Twig's subset of XPath 32 | xml_split split big XML files 33 | xml_merge merge back files created by xml_split 34 | xml_spellcheck spellcheck XML files skipping tags 35 | 36 | Running perl Makefile.PL will prompt you for each tool installation. 37 | perl Makefile.PL -y will install all of the tools without prompt 38 | perl Makefile.PL -n will skip the installation of the tools 39 | 40 | 41 | SYNOPSYS 42 | 43 | single-tree mode 44 | my $t= XML::Twig->new(); 45 | $t->parsefile( 'doc.xml'); 46 | $t->print; 47 | 48 | chunk mode 49 | # print the document, at most one full section is loaded in memory 50 | my $t= XML::Twig->new( twig_handlers => { section => \&flush}); 51 | $t->parsefile( 'doc.xml'); 52 | $t->flush; 53 | sub flush { (my $twig, $section)= @_; $twig->flush; } 54 | 55 | sub-tree mode 56 | # print all section title's in the document, 57 | # all other elements are ignored (and not stored) 58 | my $t= XML::Twig->new( 59 | twig_roots => { 'section/title' => sub { $_->print, "\n" } } 60 | ); 61 | $t->parsefile( 'doc.xml'); 62 | 63 | INSTALLATION 64 | 65 | perl Makefile.PL 66 | make 67 | make test 68 | make install 69 | 70 | DEPENDENCIES 71 | 72 | XML::Twig needs XML::Parser (and the expat library) installed 73 | 74 | Modules that can enhance XML::Twig are: 75 | 76 | Scalar::Util or WeakRef 77 | to avoid memory leaks 78 | Tie::IxHash 79 | to use the keep_atts_order option 80 | XML::XPathEngine 81 | to use XML::Twig::XPath 82 | LWP 83 | to use parseurl 84 | HTML::Entities 85 | to use the html_encode filter 86 | HTML::TreeBuilder 87 | to process HTML instead of XML 88 | 89 | CHANGES 90 | 91 | See the Changes file 92 | 93 | AUTHOR 94 | 95 | Michel Rodriguez (mirod@cpan.org) 96 | The Twig page is at http://www.xmltwig.org/xmltwig 97 | git project repository: http://github.com/mirod/xmltwig 98 | See the XML::Twig tutorial at http://www.xmltwig.org/xmltwig/tutorial/index.html 99 | 100 | COPYRIGHT 101 | 102 | Copyright (c) 1999-2025, Michel Rodriguez. All Rights Reserved. 103 | This library is free software; you can redistribute it and/or modify 104 | it under the same terms as Perl itself. 105 | -------------------------------------------------------------------------------- /t/test_wrapped.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use strict; 6 | use Carp; 7 | use File::Spec; 8 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 9 | use tools; 10 | 11 | $|=1; 12 | my $DEBUG=0; 13 | 14 | use XML::Twig; 15 | 16 | 17 | my $TMAX=13; 18 | print "1..$TMAX\n"; 19 | 20 | unless( XML::Twig::_use( 'Text::Wrap')) { print "1..1\nok 1\n"; warn "skipping: Text::Wrap not available\n"; exit; } 21 | 22 | while( my $doc= get_doc()) 23 | { my $result= XML::Twig->nparse( pretty_print => 'wrapped', $doc)->sprint; 24 | my $expected= get_doc(); 25 | foreach ($result, $expected) { s{ }{.}g; } 26 | is( $result, $expected, ''); 27 | } 28 | 29 | XML::Twig::Elt->set_wrap(0); 30 | is( XML::Twig::Elt->set_wrap(1), 0, "set_wrap - 1"); 31 | is( XML::Twig::Elt->set_wrap(1), 1, "set_wrap - 2"); 32 | is( XML::Twig::Elt->set_wrap(0), 1, "set_wrap - 3"); 33 | is( XML::Twig::Elt->set_wrap(0), 0, "set_wrap - 4"); 34 | 35 | is( XML::Twig::Elt::set_wrap(1), 0, "set_wrap - 5"); 36 | is( XML::Twig::Elt::set_wrap(1), 1, "set_wrap - 6"); 37 | is( XML::Twig::Elt::set_wrap(0), 1, "set_wrap - 7"); 38 | is( XML::Twig::Elt::set_wrap(0), 0, "set_wrap - 8"); 39 | 40 | sub get_doc 41 | { local $/="\n\n"; 42 | my $doc= ; 43 | if( $doc) 44 | { $doc=~ s{\n\n}{\n}; 45 | $doc=~ s/\{([^}]*)\}/$1/eeg; 46 | } 47 | return $doc; 48 | } 49 | 50 | 51 | __DATA__ 52 | {"foo" x 40} 53 | 54 | 55 | foofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoo 56 | foofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoo 57 | 58 | 59 | {"foo" x 80} 60 | 61 | 62 | foofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoo 63 | foofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofo 64 | ofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoof 65 | oofoofoofoofoofoofoofoofoofoofoo 66 | 67 | 68 |
{"foo" x 40}
 69 | 70 | 71 |
72 | foofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoof 73 | oofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoofoo 74 |
75 | 76 | 77 | 78 | {"foo " x 40} 79 | {"bar " x 40} 80 | 81 | 82 | 83 | foo foo foo foo foo foo foo foo foo foo foo foo foo foo 84 | foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo 85 | foo foo foo foo foo foo foo foo 86 | bar bar bar bar bar bar bar bar bar bar bar bar bar bar 87 | bar bar bar bar bar bar bar bar bar bar bar bar bar bar bar bar bar bar 88 | bar bar bar bar bar bar bar bar 89 | 90 | 91 | 92 | {"foo " x 40}{ "aaa" x 60}{ "foo "x20 } 93 | {"bar " x 40} 94 | 95 | 96 | 97 | foo foo foo foo foo foo foo foo foo foo foo foo foo foo 98 | foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo foo 99 | foo foo foo foo foo foo foo foo 100 | aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa 101 | aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa 102 | aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaafoo foo foo foo foo foo foo foo 103 | foo foo foo foo foo foo foo foo foo foo foo foo 104 | bar bar bar bar bar bar bar bar bar bar bar bar bar bar 105 | bar bar bar bar bar bar bar bar bar bar bar bar bar bar bar bar bar bar 106 | bar bar bar bar bar bar bar bar 107 | 108 | -------------------------------------------------------------------------------- /t/test_xpath_cond.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use XML::Twig; 5 | 6 | $|=1; 7 | 8 | my $t= XML::Twig->new; 9 | $t->parse( 10 | ' 11 | elt 1 12 | elt 2 13 | 14 | elt 3 15 | 16 | 17 | 2 18 | 3 19 | 20 | <:elt id=":elt">yep, that is a valid name 21 | '); 22 | 23 | my @data= grep { !/^##/ && m{\S} } ; 24 | 25 | my @exp; 26 | my %result; 27 | 28 | foreach( @data) 29 | { chomp; 30 | my ($exp, $id_list) = split /\s*=>\s*/ ; 31 | $id_list=~ s{\s+$}{}; 32 | $result{$exp}= $id_list; 33 | push @exp, $exp; 34 | } 35 | 36 | my $nb_tests= keys %result; 37 | print "1..$nb_tests\n"; 38 | 39 | my $i=1; 40 | 41 | foreach my $exp ( @exp) 42 | { my $expected_result= $result{$exp}; 43 | my @result= $t->get_xpath( $exp); 44 | my $result; 45 | if( @result) 46 | { $result= join ' ', map { $_->id || $_->gi } @result; } 47 | else 48 | { $result= 'none'; } 49 | 50 | if( $result eq $expected_result) 51 | { print "ok $i\n"; } 52 | else 53 | { print "not ok $i\n"; 54 | print STDERR "$exp: expected '$expected_result' - real '$result'\n"; 55 | } 56 | $i++; 57 | } 58 | 59 | exit 0; 60 | 61 | __DATA__ 62 | /elt => none 63 | /elt[@foo="bar"] => none 64 | /*[@foo="bar"] => none 65 | //*[@foo="bar"] => none 66 | /* => doc 67 | /*[@id="doc"] => doc 68 | //*[@id="doc"] => doc 69 | //elt => elt-1 elt-2 elt-3 70 | //*/elt => elt-1 elt-2 elt-3 71 | /doc/elt => elt-1 elt-2 72 | /*/elt => elt-1 elt-2 73 | /doc/elt[ last()] => elt-2 74 | /doc/*[ last()] => :elt 75 | //elt[@id='elt-1'] => elt-1 76 | //*[@id='elt-1'] => elt-1 77 | //[@id='elt-1'] => elt-1 78 | //elt[@id='elt-1' or @id='elt-2'] => elt-1 elt-2 79 | //elt[@id='elt-1' and @id='elt-2'] => none 80 | //elt[@id='elt-1' and @id!='elt-2'] => elt-1 81 | //elt[@id=~ /elt/] => elt-1 elt-2 elt-3 82 | //[@id='elt-1' or @id='elt-2'] => elt-1 elt-2 83 | //[@id='elt-1' and @id='elt-2'] => none 84 | //[@id='elt-1' and @id!='elt-2'] => elt-1 85 | //[@id=~ /elt/] => elt-1 elt-2 elt2-1 elt-3 elt2-2 elt2-3 elt2-4 :elt 86 | //*[@id='elt-1' or @id='elt-2'] => elt-1 elt-2 87 | //*[@id='elt-1' and @id='elt-2'] => none 88 | //*[@id='elt-1' and @id!='elt-2'] => elt-1 89 | //*[@id=~ /elt/] => elt-1 elt-2 elt2-1 elt-3 elt2-2 elt2-3 elt2-4 :elt 90 | //elt2[@att_int > 2] => elt2-4 91 | /doc/elt2[ last()]/* => elt2-3 elt2-4 92 | //*[@id=~/elt2/] => elt2-1 elt2-2 elt2-3 elt2-4 93 | /doc/*[@id=~/elt2/] => elt2-1 elt2-2 94 | /doc//*[@id=~/elt2/] => elt2-1 elt2-2 elt2-3 elt2-4 95 | //*[@id=~/elt2-[34]/] => elt2-3 elt2-4 96 | //*[@id!~/^elt/] => doc :elt 97 | //[@id=~/elt2-[34]/] => elt2-3 elt2-4 98 | //[@id!~/elt2-[34]/] => doc elt-1 elt-2 elt2-1 elt-3 elt2-2 :elt 99 | //elt2[@id=~/elt2-[34]/] => elt2-3 elt2-4 100 | //*[@id!~/elt2-[34]/] => doc elt-1 elt-2 elt2-1 elt-3 elt2-2 :elt 101 | //:elt => :elt 102 | //elt[string()="elt 1"] => elt-1 103 | //elt[string()=~/elt 1/] => elt-1 104 | //elt[string()=~/^elt 1/] => elt-1 105 | //*[string()="elt 1"] => elt-1 #PCDATA 106 | //*[string()=~/elt 1/] => doc elt-1 #PCDATA 107 | //*[string()=~/^elt 1/] => doc elt-1 #PCDATA 108 | //[string()="elt 1"] => elt-1 #PCDATA 109 | //[string()=~/elt 1/] => doc elt-1 #PCDATA 110 | //[string()=~/^elt 1/] => doc elt-1 #PCDATA 111 | //[string()="elt 2"] => elt-2 #PCDATA 112 | //[string()=~/elt 2/] => doc elt-2 #PCDATA 113 | //[string()=~/^elt 2/] => elt-2 #PCDATA 114 | -------------------------------------------------------------------------------- /t/test_3_24.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use strict; 6 | use Carp; 7 | use File::Spec; 8 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 9 | use tools; 10 | 11 | $|=1; 12 | my $DEBUG=0; 13 | 14 | use XML::Twig; 15 | 16 | my $TMAX=15; 17 | print "1..$TMAX\n"; 18 | 19 | { # adding comments or pi's before/after the root 20 | my $doc= XML::Twig->nparse( ''); 21 | my $xsl = XML::Twig::Elt->new('#PI'); 22 | $xsl->set_target('xml-stylesheet'); 23 | $xsl->set_data('type= "text/xsl" href="xsl_style.xsl"'); 24 | $xsl->paste( before => $doc->root); 25 | is( $doc->sprint, '', 26 | 'PI before the root' 27 | ); 28 | my $comment= XML::Twig::Elt->new( '#COMMENT'); 29 | $comment->set_comment( 'foo'); 30 | $comment->paste( before => $doc->root); 31 | 32 | is( $doc->sprint, '', 33 | 'Comment before the root' 34 | ); 35 | 36 | XML::Twig::Elt->new( '#COMMENT')->set_comment( 'bar')->paste( after => $doc->root); 37 | XML::Twig::Elt->new( '#PI')->set_target( 'foo')->set_data( 'bar')->paste( after => $doc->root); 38 | is( $doc->sprint, '', 39 | 'Pasting things after the root' 40 | ); 41 | 42 | } 43 | 44 | { # adding comments or pi's before/after the root 45 | my $doc= XML::Twig->nparse( ''); 46 | $doc->add_stylesheet( xsl => 'xsl_style.xsl'); 47 | is( $doc->sprint, '', 'add_stylesheet'); 48 | eval{ $doc->add_stylesheet( foo => 'xsl_style.xsl') }; 49 | matches( $@, q{^unsupported style sheet type 'foo'}, 'unsupported stylesheet type'); 50 | } 51 | 52 | { # creating a CDATA element 53 | my $elt1= XML::Twig::Elt->new( foo => { '#CDATA' => 1 }, '<&>'); 54 | is( $elt1->sprint, ']]>', "creating a CDATA element"); 55 | my $elt2= XML::Twig::Elt->new( foo => { '#CDATA' => 1, att => 'v1' }, '<&>'); 56 | is( $elt2->sprint, ']]>', "creating a CDATA element"); 57 | eval { my $elt3= XML::Twig::Elt->new( foo => { '#CDATA' => 1 }, "bar", $elt1); }; 58 | matches( $@, qr/^element #CDATA can only be created from text/, 59 | "error in creating CDATA element"); 60 | my $elt4= XML::Twig::Elt->new( foo => { '#CDATA' => 1 }, '<&>', 'bar'); 61 | is( $elt4->sprint, 'bar]]>', "creating a CDATA element (from list)"); 62 | 63 | } 64 | 65 | { # errors creating text/comment/pi elements 66 | eval { my $elt= XML::Twig::Elt->new( '#PCDATA', []); }; 67 | matches( $@, qr/^element #PCDATA can only be created from text/, "error in creating PCDATA element"); 68 | 69 | eval { my $elt= XML::Twig::Elt->new( '#COMMENT', "foo", []); }; 70 | matches( $@, qr/^element #COMMENT can only be created from text/, "error in creating COMMENT element"); 71 | 72 | eval { my $elt= XML::Twig::Elt->new( '#PI', "foo", [], "bah!"); }; 73 | matches( $@, qr/^element #PI can only be created from text/, "error in creating PI element"); 74 | 75 | } 76 | 77 | { # set_cdata on non CDATA element 78 | my $elt = XML::Twig::Elt->new("qux"); 79 | $elt->set_cdata("test this '<' & this '>'"); 80 | is( $elt->sprint, q{']]>}, "set_cdata on non CDATA element"); 81 | } 82 | 83 | { # set_comment on non comment element 84 | my $elt = XML::Twig::Elt->new(qux => "toto"); 85 | $elt->set_comment( " booh "); 86 | is( $elt->sprint, q{}, "set_comment on non comment element"); 87 | } 88 | 89 | { # set_pi on non pi element 90 | my $elt = XML::Twig::Elt->new(qux => "toto"); 91 | $elt->set_pi( ta => "tie ramisu"); 92 | is( $elt->sprint, q{}, "set_pi on non pi element"); 93 | } 94 | -------------------------------------------------------------------------------- /t/test_3_45.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use XML::Twig; 7 | use Test::More tests => 16; 8 | 9 | is( XML::Twig->new( keep_encoding => 1)->parse( q{})->sprint, q{}, "quote in att with keep_encoding"); 10 | 11 | # test CDATA sections in HTML escaping https://rt.cpan.org/Ticket/Display.html?id=86773 12 | my $html = <<'EOF'; 13 |
body
14 | 19 | EOF 20 | 21 | # module => XML::Twig->new options 22 | my %html_conv= ( 'HTML::TreeBuilder' => {}, 23 | 'HTML::Tidy' => { use_tidy => 1 }, 24 | ); 25 | foreach my $module ( sort keys %html_conv) 26 | { SKIP: 27 | { eval "use $module"; 28 | skip "$module not available", 3 if $@ ; 29 | 30 | my $parser= XML::Twig->new( %{$html_conv{$module}}); 31 | my $xml = $parser->safe_parse_html($html); 32 | print $@ if $@; 33 | 34 | my @cdata = $xml->get_xpath('//#CDATA'); 35 | ok(@cdata == 1, "1 CDATA section found (using $module)"); 36 | 37 | ok(((index $xml->sprint, "//]]>") >= 0), "end of cdata ok in doc (using $module)"); 38 | #diag "\n", $xml->sprint, "\n"; 39 | 40 | my @elts = $xml->get_xpath('//script'); 41 | 42 | foreach my $el (@elts) 43 | { #diag $el->sprint; 44 | ok(((index $el->sprint, "//]]>") >= 0), "end of cdata ok in script element (using $module)"); 45 | } 46 | } 47 | } 48 | 49 | # test & in HTML (RT #86633) 50 | my $html_with_amp='

Marco&company

'; 51 | my $expected_body= '

Marco&company

'; 52 | 53 | SKIP: 54 | { eval "use HTML::Tidy"; 55 | skip "HTML::Tidy not available", 1 if $@ ; 56 | my $parsert = XML::Twig->new(); 57 | my $html_tidy = $parsert->safe_parse_html( { use_tidy => 1 }, "

Marco&company

"); 58 | diag $@ if $@; 59 | is( $html_tidy->first_elt( 'body')->sprint, $expected_body, "& in text, converting html with use_tidy"); 60 | } 61 | 62 | SKIP: 63 | { eval "use HTML::TreeBuilder"; 64 | skip "HTML::TreeBuilder not available", 1 if $@ ; 65 | my $parserh= XML::Twig->new(); 66 | my $html = $parserh->safe_parse_html("

Marco&company

"); 67 | diag $@ if $@; 68 | is( $html->first_elt( 'body')->sprint , $expected_body, "& in text, converting html with treebuilder"); 69 | } 70 | 71 | is( XML::Twig::_unescape_cdata( '<tag att="foo&bar&baz">>></tag>'), '>>', '_unescape_cdata'); 72 | 73 | SKIP: 74 | { skip "safe_print_to_file method does not work on Windows", 6 if $^O =~ m{win}i; 75 | # testing safe_print_to_file 76 | my $tmp= "safe_print_to_file.xml"; 77 | my $doc= "foo"; 78 | unlink( $tmp); # no check, it could not be there 79 | my $t1= XML::Twig->nparse( $doc)->safe_print_to_file( $tmp); 80 | ok( -f $tmp, "safe_print_to_file created document"); 81 | my $t2= XML::Twig->nparse( $tmp); 82 | is( $t2->sprint, $t1->sprint, "generated document identical to original document"); 83 | unlink( $tmp); 84 | 85 | my $e1= XML::Twig->parse( 'foobar')->first_elt( 'b')->safe_print_to_file( $tmp); 86 | ok( -f $tmp, "safe_print_to_file on elt created document"); 87 | $t2= XML::Twig->nparse( $tmp); 88 | is( $t2->sprint, 'bar', "generated sub-document identical to original sub-document"); 89 | unlink( $tmp); 90 | 91 | # failure modes 92 | eval { XML::Twig->nparse( $tmp); }; 93 | like( $@, qr/Couldn't open $tmp:/, 'parse a non-existent file'); 94 | my $non_existent="safe_non_existent_I_hope_01/tmp"; 95 | while( -f $non_existent) { $non_existent++; } # most likely unnecessary ;--) 96 | eval { $t1->safe_print_to_file( $non_existent); }; 97 | like( $@, qr/(does not exist|is not a directory)/, 'safe_print_to_file in non-existent dir'); 98 | } 99 | 100 | exit; 101 | 102 | 103 | 104 | -------------------------------------------------------------------------------- /t/zz_dump_config.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | 4 | my $ok; # global, true if the last call to version found the module, false otherwise 5 | use Config; 6 | 7 | warn "\n\nConfiguration:\n\n"; 8 | 9 | # required 10 | warn "perl: $]\n"; 11 | warn "OS: $Config{'osname'} - $Config{'myarchname'}\n"; 12 | 13 | print "\n"; 14 | 15 | warn "required\n"; 16 | warn version( XML::Parser, ''); 17 | 18 | # We obviously have expat on VMS, but a symbol/logical might 19 | # not be set to xmlwf, and when this is the case a 20 | # '%DCL-W-IVVERB, unrecognized command verb - check validity and spelling 21 | # \XMLWF\' 22 | # will be returned. 23 | 24 | my $skip_xmlwf_test = 0; 25 | if ($^O eq 'VMS') { 26 | if(`write sys\$output "''xmlwf'"` !~ m/[a-z]+/i) { 27 | $skip_xmlwf_test = 1; 28 | warn format_warn( 'expat', "Skipping expat (version) test as don't have a symbol for 'xmlwf'."); 29 | } 30 | } 31 | 32 | if (! $skip_xmlwf_test) 33 | { # try getting this info 34 | my $xmlwf_v= `xmlwf -v`; 35 | if( $xmlwf_v=~ m{xmlwf using expat_(.*)$}m) 36 | { warn format_warn( 'expat', $1, '(required)'); } 37 | else 38 | { warn format_warn( 'expat', ''); } 39 | } 40 | 41 | warn version( Scalar::Util, 'for improved memory management'); 42 | if( $ok) 43 | { unless( defined( &Scalar::Util::weaken)) 44 | { warn format_warn( '', 'NOT USED, weaken not available in this version'); 45 | warn version( WeakRef); 46 | } 47 | } 48 | else 49 | { warn version( WeakRef, 'for improved memory management'); } 50 | 51 | print "\n"; 52 | 53 | 54 | # must-have 55 | warn "Strongly Recommended\n"; 56 | # encoding 57 | warn version( Encode, 'for encoding conversions'); 58 | unless( $ok) { warn version( Text::Iconv, 'for encoding conversions'); } 59 | unless( $ok) { warn version( Unicode::Map8, 'for encoding conversions'); } 60 | 61 | print "\n"; 62 | 63 | # optional 64 | warn "Modules providing additional features\n"; 65 | warn version( XML::XPathEngine, 'to use XML::Twig::XPath'); 66 | warn version( XML::XPath, 'to use XML::Twig::XPath if XML::XPathEngine not available'); 67 | warn version( LWP, 'for the parseurl method'); 68 | warn version( HTML::TreeBuilder, 'to use parse_html and parsefile_html'); 69 | warn version( HTML::Entities::Numbered, 'to allow parsing of HTML containing named entities'); 70 | warn version( HTML::Tidy, 'to use parse_html and parsefile_html with the use_tidy option'); 71 | warn version( HTML::Entities, 'for the html_encode filter'); 72 | warn version( Tie::IxHash, 'for the keep_atts_order option'); 73 | warn version( Text::Wrap, 'to use the "wrapped" option for pretty_print'); 74 | 75 | print "\n"; 76 | 77 | # used in tests 78 | warn "Modules used only by the auto tests\n"; 79 | warn version( Test, ''); 80 | warn version( Test::Pod, ''); 81 | warn version( XML::Simple, ''); 82 | warn version( XML::Handler::YAWriter, ''); 83 | warn version( XML::SAX::Writer, ''); 84 | warn version( XML::Filter::BufferText, ''); 85 | warn version( IO::Scalar, ''); 86 | warn version( IO::CaptureOutput, ''); 87 | 88 | my $zz_dump_config= File::Spec->catfile( t => "zz_dump_config.t"); 89 | warn "\n\nPlease add this information to bug reports (you can run $zz_dump_config to get it)\n\n"; 90 | warn "if you are upgrading the module from a previous version, make sure you read the\n", 91 | "Changes file for bug fixes, new features and the occasional COMPATIBILITY WARNING\n\n"; 92 | 93 | print "1..1\nok 1\n"; 94 | exit 0; 95 | 96 | sub version 97 | { my $module= shift; 98 | my $info= shift || ''; 99 | $info &&= "($info)"; 100 | my $version; 101 | if( eval "require $module") 102 | { $ok=1; 103 | import $module; 104 | $version= ${"$module\::VERSION"}; 105 | $version=~ s{\s*$}{}; 106 | } 107 | else 108 | { $ok=0; 109 | $version= ''; 110 | } 111 | return format_warn( $module, $version, $info); 112 | } 113 | 114 | sub format_warn 115 | { return sprintf( " %-25s: %16s %s\n", @_); } 116 | -------------------------------------------------------------------------------- /t/test_3_50.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use XML::Twig; 7 | use Test::More tests => 18; 8 | 9 | use utf8; 10 | 11 | SKIP: { 12 | if( XML::Twig::_use( 'XML::XPathEngine') && XML::Twig::_use( 'XML::Twig::XPath')) 13 | { ok( XML::Twig::XPath->new()->parse('')->findnodes('//namespace::*'), '//namespace::* does not crash'); } 14 | else 15 | { skip 'cannot use XML::Twig::XPath', 1; } 16 | } 17 | 18 | { 19 | my $doc=q{titlep 1p 2}; 20 | my $out; 21 | open( my $out_fh, '>', \$out); 22 | my $t= XML::Twig->new ( twig_handlers => { _default_ => sub { $_->flush( $out_fh); } }); 23 | $t->parse( $doc); 24 | is( $out, $doc, 'flush with _default_ handler'); 25 | } 26 | 27 | { 28 | my $doc=q{titlep 1p 2}; 29 | my $out; 30 | open( my $out_fh, '>', \$out); 31 | my $t= XML::Twig->new ( twig_handlers => { 'd' => sub { $_->flush( $out_fh); } }); 32 | $t->parse( $doc); 33 | #is( $out, $doc, 'flush with handler on the root'); 34 | } 35 | 36 | 37 | { # test notations 38 | my $doc=q{ 39 | 41 | 42 | 43 | 44 | 45 | ]> 46 | 47 | DirectionalLight { direction 0 -1 0 } 48 | XML::Twig->parse( 'file.xml'); 49 | 50 | }; 51 | my $t= XML::Twig->parse( $doc); 52 | my $n= $t->notation_list; 53 | is( join( ':', sort $t->notation_names), 'perl:vrml', 'notation_names'); 54 | is( join( ':', sort map { $_->name } $n->list), 'perl:vrml', 'notation_list (names)'); 55 | is( join( ':', sort map { $_->pubid } $n->list), 'Perl 22.4:VRML 1.0', 'notation_list (pubid)'); 56 | is( join( ':', sort map { $_->sysid || '' } $n->list), ':/usr/bin/perl', 'notation_list (pubid)'); 57 | is( $n->notation( 'perl')->pubid, 'Perl 22.4', 'individual notation pubid'); 58 | is( $n->notation( 'vrml')->base, undef, 'individual notation base'); 59 | is( $n->text, qq{\n}, 'all notations'); 60 | my $notations= () = ( $t->sprint() =~ m{sprint( update_DTD => 1) =~ m{delete( 'perl'); 65 | $notations= () = ( $t->sprint( update_DTD => 1) =~ m{notation( 'vrml')->pubid(), 'VRML 1.0', 'notation method'); 68 | $n->add_new_notation( 'svg', '', 'image/svg', 'SVG'); 69 | is( $n->notation( 'svg')->text, qq{}, 'new notation'); 70 | 71 | } 72 | 73 | { # somehow these were never tested (they are inlined within the module) 74 | my $t= XML::Twig->parse( ''); 75 | my $d= $t->root; 76 | 77 | my $e2= $t->first_elt( 'e2'); 78 | my $e1= XML::Twig::Elt->new( 'e1'); 79 | $d->set_first_child( $e1); 80 | $e2->set_prev_sibling( $e1); 81 | $e1->set_next_sibling( $e2); 82 | is( $t->sprint, '', 'set_first_child'); 83 | 84 | my $e3= XML::Twig::Elt->new( 'e3'); 85 | $d->set_last_child( $e3); 86 | $e2->set_next_sibling( $e3); 87 | $e3->set_prev_sibling( $e2); 88 | is( $t->sprint, '', 'set_last_child'); 89 | 90 | $e2->insert_new_elt( first_child => '#PCDATA')->_set_pcdata( 'foo'); 91 | is( $t->sprint, 'foo', '_set_pcdata'); 92 | 93 | $e1->insert_new_elt( first_child => '#CDATA')->_set_cdata( 'bar'); 94 | is( $t->sprint, 'foo', '_set_cdata'); 95 | } 96 | 97 | exit; 98 | 99 | 100 | 101 | -------------------------------------------------------------------------------- /t/test_3_38.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use Carp; 6 | use File::Spec; 7 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 8 | use tools; 9 | 10 | $|=1; 11 | my $DEBUG=0; 12 | 13 | use XML::Twig; 14 | 15 | my $TMAX=21; 16 | print "1..$TMAX\n"; 17 | 18 | my $d= ''; 19 | 20 | { my $r= XML::Twig->parse( $d)->root; 21 | my $result = $r->att('a'); 22 | is( $r->sprint, $d, 'att'); 23 | } 24 | 25 | 26 | { my $r= XML::Twig->parse( $d)->root; 27 | my $result = foo($r->att('a')); 28 | is( $r->sprint, $d, 'att in sub(1)'); 29 | } 30 | 31 | { my $r= XML::Twig->parse( $d)->root; 32 | my $result = sub { return @_ }->($r->att('a')); 33 | is( $r->sprint, $d, 'att in anonymous sub'); 34 | } 35 | 36 | { my $r= XML::Twig->parse( $d)->root; 37 | my $a= $r->att( 'a'); 38 | is( $r->sprint, $d, 'att in scalar context'); 39 | } 40 | 41 | { my $r= XML::Twig->parse( $d)->root; 42 | my( $a1, $a2)= ($r->att( 'a1'), $r->att( 'a2')); 43 | is( $r->sprint, $d, 'att in list context'); 44 | } 45 | 46 | { my $r= XML::Twig->parse( $d)->root; 47 | $r->att( 'a'); 48 | is( $r->sprint, $d, 'att in void context'); 49 | } 50 | 51 | { my $r= XML::Twig->parse( $d)->root; 52 | my $result = $r->att('a'); 53 | is( $r->sprint, $d, 'att'); 54 | } 55 | 56 | 57 | { my $r= XML::Twig->parse( $d)->root; 58 | my $result = foo($r->class); 59 | is( $r->sprint, $d, 'class in sub(1)'); 60 | } 61 | 62 | { my $r= XML::Twig->parse( $d)->root; 63 | my $result = sub { return @_ }->($r->class); 64 | is( $r->sprint, $d, 'att in anonymous sub'); 65 | } 66 | 67 | { my $r= XML::Twig->parse( $d)->root; 68 | my $a= $r->class; 69 | is( $r->sprint, $d, 'class in scalar context'); 70 | } 71 | 72 | { my $r= XML::Twig->parse( $d)->root; 73 | my( $a1, $a2)= ($r->class, $r->class); 74 | is( $r->sprint, $d, 'class in list context'); 75 | } 76 | 77 | { my $r= XML::Twig->parse( $d)->root; 78 | $r->class; 79 | is( $r->sprint, $d, 'class in void context'); 80 | } 81 | 82 | { my $t= XML::Twig->new->parse( ''); 83 | $t->root->latt( 'a')= 1; 84 | is( $t->sprint, '', 'latt'); 85 | } 86 | 87 | { my $r= XML::Twig->parse( $d)->root; 88 | my $att= $r->att( 'foo'); 89 | is( $att, undef, 'unexisting att'); 90 | } 91 | 92 | 93 | # my $value = $root->att('any_attribute'); 94 | # $result = length($value); 95 | 96 | sub foo { return @_; } 97 | 98 | { 99 | my $r; 100 | my $doc='<_e id="e1"><_e id="e2"><_foo a="2" id="foo"/>'; 101 | my $t= XML::Twig->new( twig_handlers => { _e => sub { $r.= $_->id } }) 102 | ->parse( $doc); 103 | is( $r, 'e1e2', 'handler, condition on tag starting with an underscore'); 104 | is( $t->first_elt( '_foo')->id, 'foo', 'navigation, element name starts with underscore'); 105 | is( $t->first_elt( '*[@_a="2"]')->id, 'bar', 'navigation, attribute name starts with underscore'); 106 | } 107 | 108 | { if( _use( 'LWP') && _use( 'HTML::TreeBuilder') ) 109 | { my $html=q{

Title

foo
bar

}; 110 | my $expected= qq{

Title

foo
bar

}; 111 | 112 | my $html_file= "t/test_3_38.html"; 113 | spit( $html_file, $html); 114 | is( scrub_xhtml( XML::Twig->new( )->parseurl_html( "file:$html_file")->sprint), $expected, 'parseurl_html'); 115 | unlink $html_file; 116 | } 117 | else 118 | { skip( 1, "LWP and/or HTML::TreeBuilder not available, cannot test safe_parseurl_html"); } 119 | 120 | 121 | } 122 | 123 | { my $doc=" foo bar baz"; 124 | is( XML::Twig->parse( $doc)->simplify( normalize_space => 2)->{e}, 'foo bar baz', 'simplify with normalize_space => 2'); 125 | } 126 | 127 | 128 | { my $doc="foo bar foofoo foobar totofoo"; 129 | my $t= XML::Twig->parse( $doc); 130 | is( $t->subs_text( qr/(f)o(o)/, '&elt(b => $1) $2')->sprint, 'f o bar f of o f obar totof o', 'complex subs_text'); 131 | } 132 | 133 | 134 | { my $t= XML::Twig->parse( 'e1e2'); 135 | is( join( '-', $t->findvalues( '//e')), 'e1-e2', 'findvalues'); 136 | } 137 | 138 | 139 | 1; 140 | -------------------------------------------------------------------------------- /speedup.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.010; 4 | 5 | my $FIELD = join( '|', qw( parent first_child last_child prev_sibling next_sibling pcdata cdata ent data target cdata pcdata comment flushed)); 6 | my $PRIVATE = join( '|', qw( parent first_child last_child prev_sibling next_sibling pcdata cdata comment 7 | extra_data_in_pcdata extra_data_before_end_tag 8 | ) 9 | ); # _$private is inlined 10 | my $FORMER = join( '|', qw( parent prev_sibling next_sibling)); # former_$former is inlined 11 | my $SET_FIELD = join( '|', qw( first_child next_sibling ent data pctarget comment flushed)); 12 | my $SET_NOT_EMPTY= join( '|', qw( pcdata cdata comment)); # set the field 13 | 14 | my $var= '(\$[a-z_]+(?:\[\d\])?|\$t(?:wig)?->root|\$t(?:wig)?->twig_current|\$t(?:wig)?->\{\'?twig_root\'?\}|\$t(?:wig)?->\{\'?twig_current\'?\})'; 15 | 16 | my $set_to = '(?:undef|\$\w+|\$\w+->\{\w+\}|\$\w+->\w+|\$\w+->\w+\([^)]+\))'; 17 | my $elt = '\$(?:elt|new_elt|child|cdata|ent|_?parent|twig_current|next_sibling|first_child|prev_sibling|last_child|ref|elt->_parent)'; 18 | 19 | 20 | my %gi2index=( '', 0, PCDATA => 1, CDATA => 2, PI => 3, COMMENT => 4, ENT => 5); 21 | 22 | (my $version= $])=~ s{\.}{}g; 23 | 24 | my $in_pod = 0; # do not change the POD! 25 | 26 | while( <>) 27 | { 28 | $in_pod = 1 if m{^__END__}; 29 | # do not fix the pod 30 | if ($in_pod) { 31 | print $_; 32 | next; 33 | } 34 | 35 | if( /=/) 36 | { s/$var->_children/do { my \$elt= $1; my \@children=(); my \$child= \$elt->_first_child; while( \$child) { push \@children, \$child; \$child= \$child->_next_sibling; } \@children; }/; } 37 | 38 | s/$var->set_gi\(\s*(PCDATA|CDATA|PI|COMMENT|ENT)\s*\)/$1\->{gi}= $gi2index{$2}/; 39 | 40 | s/$var->del_(twig_current)/delete $1\->{'$2'}/g; 41 | s/$var->set_(twig_current)/$1\->{'$2'}=1/g; 42 | s/$var->_del_(flushed)/delete $1\->{'$2'}/g; 43 | s/$var->_set_(flushed)/$1\->{'$2'}=1/g; 44 | s/$var->_(flushed)/$1\->{'$2'}/g; 45 | 46 | s/$var->set_($SET_FIELD)\(([^)]*)\)/$1\->\{$2\}= $3/g; 47 | s/$var->($FIELD)\b(?!\()/$1\->\{$2\}/g; 48 | s/$var->_($PRIVATE)\b(\s*\(\s*\))?(?!\s*\()/$1\->\{$2\}/g; 49 | 50 | s{($elt)->former_($FORMER)}{($1\->{former} && $1\->{former}\->{$2})}g; 51 | 52 | s{($elt)->set_(parent|prev_sibling)\(\s*($set_to)\s*\)}{$1\->\{$2\}=$3; weaken( $1\->\{$2\}); }g; 53 | s{($elt)->set_(first_child)\(\s*($set_to)\s*\)}{ $1\->set_not_empty; $1\->\{$2\}=$3; }g; 54 | s{($elt)->set_(next_sibling)\(\s*($set_to)\s*\)}{ $1\->\{$2\}=$3; }g; 55 | s{($elt)->set_(last_child)\(\s*($set_to)\s*\)}{ $1\->set_not_empty; $1\->\{$2\}=$3; weaken( $1\->\{$2\}); }g; 56 | 57 | s/$var->atts/$1\->{att}/g; 58 | 59 | s/$var->append_(pcdata|cdata)\(([^)]*)\)/$1\->\{$2\}.= $3/g; 60 | s/$var->set_($SET_NOT_EMPTY)\(([^)]*)\)/$1\->\{$2\}= (delete $1->\{empty\} || 1) && $3/g; 61 | s/$var->_set_($SET_NOT_EMPTY)\s*\(([^)]*)\)/$1\->{$2}= $3/g; 62 | 63 | s/(\$[a-z][a-z_]*(?:\[\d\])?)->gi/\$XML::Twig::index2gi\[$1\->{'gi'}\]/g; 64 | 65 | s/$var->id/$1\->{'att'}->{\$ID}/g; 66 | s/$var->att\(\s*([^)]+)\)/$1\->{'att'}->\{$2\}/g; 67 | 68 | s/(\$[a-z][a-z_]*(?:\[\d\])?)->is_pcdata/(exists $1\->{'pcdata'})/g; 69 | s/(\$[a-z][a-z_]*(?:\[\d\])?)->is_cdata/(exists $1\->{'cdata'})/g; 70 | s/$var->is_pi/(exists $1\->{'target'})/g; 71 | s/$var->is_comment/(exists $1\->{'comment'})/g; 72 | s/$var->is_ent/(exists $1\->{'ent'})/g; 73 | s/(\$,a-z][a-z_]*(?:\[\d\])?)->is_text/((exists $1\->{'pcdata'}) || (exists $1\->{'cdata'}))/g; 74 | 75 | s/$var->is_empty/$1\->{'empty'}/g; 76 | s/$var->set_empty(?:\(([^)]*)\))?(?!_)/"$1\->{empty}= " . ($2 || 1)/ge; 77 | s/$var->set_not_empty/delete $1\->{empty}/g; 78 | 79 | s/$var->_is_private/( (substr( \$XML::Twig::index2gi\[$1\->{'gi'}\], 0, 1) eq '#') && (substr( \$XML::Twig::index2gi\[$1\->{'gi'}\], 0, 9) ne '#default:') )/g; 80 | s/_is_private_name\(\s*$var\s*\)/( $1=~ m{^#(?!default:)} )/g; 81 | 82 | s{_is_fh\(\s*$var\)}{isa( $1, 'GLOB') || isa( $1, 'IO::Scalar')}g; 83 | 84 | s/$var->set_gi\s*\(\s*([^)]*)\s*\)/$1\->{gi}=\$XML::Twig::gi2index{$2} or $1->set_gi( $2)/g; 85 | 86 | s/$var->xml_string/$1->sprint( 1)/g; 87 | 88 | print $_ ; 89 | } 90 | 91 | -------------------------------------------------------------------------------- /t/test3.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | 6 | use File::Spec; 7 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 8 | use tools; 9 | 10 | # This just tests a complete twig, no callbacks 11 | # additional tests for element creation/parse and 12 | # space policy 13 | # plus test for the is_pcdata method 14 | 15 | $|=1; 16 | 17 | use XML::Twig; 18 | 19 | my $i=0; 20 | my $failed=0; 21 | 22 | my $TMAX=23; # do not forget to update! 23 | 24 | print "1..$TMAX\n"; 25 | 26 | my $p1= XML::Twig::Elt->new( 'para', 'p1'); 27 | $p1->set_id( 'p1'); 28 | etest( $p1, 'para', 'p1', 'Element creation'); 29 | my $p2= XML::Twig::Elt->parse( 'para2'); 30 | etest( $p2, 'para', 'p2', 'Element parse'); 31 | my $s1= parse XML::Twig::Elt( '
title1para 3
'); 32 | etest( $s1, 'section', 's1', 'Element parse (complex)'); 33 | my $p3= $s1->first_child( 'para'); 34 | etest( $p3, 'para', 'p3', 'Element parse (sub-element)'); 35 | 36 | my $string= "\n

para

\n

\n"; 37 | 38 | my $t1= new XML::Twig( DiscardSpacesIn => [ 'doc']); 39 | $t1->parse( $string); 40 | sttest( $t1->root, "

para

\n

", 'DiscardSpacesIn'); 41 | my $t2= new XML::Twig( DiscardSpacesIn => [ 'doc', 'p']); 42 | $t2->parse( $string); 43 | sttest( $t2->root, "

para

", 'DiscardSpacesIn'); 44 | my $t3= new XML::Twig( KeepSpaces =>1); 45 | $t3->parse( $string); 46 | sttest( $t3->root, $string, 'KeepSpaces'); 47 | my $t4= new XML::Twig( KeepSpacesIn =>[ 'p']); 48 | $t4->parse( $string); 49 | sttest( $t4->root, "

para

\n

", 'KeepSpacesIn'); 50 | 51 | 52 | my $p4= XML::Twig::Elt->parse( $string, KeepSpaces => 1); 53 | sttest( $p4, $string, 'KeepSpaces'); 54 | 55 | my $p5= XML::Twig::Elt->parse( $string, DiscardSpaces => 1); 56 | sttest( $p5, '

para

', "DiscardSpaces"); 57 | 58 | $p5= XML::Twig::Elt->parse( $string); 59 | sttest( $p5, '

para

', "DiscardSpaces (def)"); 60 | 61 | my $p6= XML::Twig::Elt->parse( $string, KeepSpacesIn => ['p']); 62 | sttest( $p6, "

para

\n

", "KeepSpacesIn 1"); 63 | 64 | my $p7= XML::Twig::Elt->parse( $string, KeepSpacesIn => [ 'doc', 'p']); 65 | sttest( $p7, "\n

para

\n

\n", "KeepSpacesIn 2"); 66 | 67 | my $p8= XML::Twig::Elt->parse( $string, DiscardSpacesIn => ['doc']); 68 | sttest( $p8, "

para

\n

", "DiscardSpacesIn 1 "); 69 | 70 | my $p9= XML::Twig::Elt->parse( $string, DiscardSpacesIn => [ 'doc', 'p']); 71 | sttest( $p9, "

para

", "DiscardSpacesIn 2"); 72 | 73 | my $string2= "

para bold end of para

"; 74 | my $p10= XML::Twig::Elt->parse( $string2,); 75 | sttest( $p10, '

para bold end of para

', "mixed content"); 76 | 77 | my $string3= "\n

para

\n

\n

\n"; 78 | my $p11= XML::Twig::Elt->parse( $string3, KeepSpaces => 1); 79 | sttest( $p4, $string, 'KeepSpaces'); 80 | my $p12= XML::Twig::Elt->parse( $string3, KeepSpacesIn => [ 'doc']); 81 | sttest( $p12, "\n

para

\n

\n", 'KeepSpacesIn'); 82 | my $p13= XML::Twig::Elt->parse( $string3, KeepSpaces => 1); 83 | sttest( $p13, "\n

para

\n

\n

\n", 'KeepSpaces'); 84 | 85 | my $p14= XML::Twig::Elt->parse( $string2); 86 | my $is_pcdata= $p14->is_pcdata; 87 | ok( $is_pcdata ? 0 : 1, "is_pcdata on a "); 88 | my $pcdata= $p14->first_child( PCDATA); 89 | $is_pcdata= $pcdata->is_pcdata; 90 | ok( $pcdata->is_pcdata, "is_pcdata on PCDATA"); 91 | 92 | my $erase_string='text 1 text 2 text 3 text 4'; 96 | my $er_t= new XML::Twig( TwigHandlers => { selt => sub { $_[1]->erase; } }); 97 | $er_t->parse( $erase_string); 98 | sttest( $er_t->root, 'text 1 text 2 text 3 text 4', 99 | "erase"); 100 | 101 | # test whether Twig packs strings 102 | my $br_pcdata= "line 1\nline 2\nline 3\n"; 103 | my $doc_br_pcdata= "$br_pcdata"; 104 | my $t_br_pcdata= new XML::Twig(); 105 | $t_br_pcdata->parse( $doc_br_pcdata); 106 | $pcdata= $t_br_pcdata->root->first_child->pcdata; 107 | stest( $pcdata, $br_pcdata, "multi-line pcdata"); 108 | 109 | exit 0; 110 | 111 | -------------------------------------------------------------------------------- /t/xmlxpath_31vars.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | use FindBin qw($Bin); BEGIN { unshift @INC, $Bin; } use xmlxpath_tools; 6 | 7 | use Test::More; 8 | 9 | use XML::Twig::XPath; 10 | 11 | eval "use XML::XPathEngine"; 12 | if( $@) { print "1..1\nok 1\n"; warn "skipping, using variables in XPath requires XML::XPathEngine\n"; exit; } 13 | 14 | plan( tests => 8); 15 | 16 | my( $employees, $areas)= do { local $/="\n\n"; ; }; 17 | 18 | { 19 | # test all data in 1 single file 20 | my $data= "$employees$areas"; 21 | my $t = XML::Twig::XPath->new->parse( $data); 22 | 23 | { $t->set_var( salary => 12000); 24 | my @nodes= $t->findnodes('/data/employees/employee[@salary=$salary]/name'); 25 | is( results( @nodes), 'e3:e4', '1 doc, var is a litteral'); 26 | } 27 | 28 | { $t->set_var( E => $t->find( '/data/employees/employee[@salary>10000]')); 29 | $t->set_var( A => $t->find( '/data/areas/area[district="Brooklyn"]/street')); 30 | my @nodes = $t->findnodes('$E[work_area/street = $A]/name'); 31 | is( results( @nodes), 'e3:e4', '1 doc, var is a node set'); 32 | } 33 | 34 | { $t->set_var( org => 'A'); 35 | my @nodes= $t->findnodes('/data/employees/employee[@org=$org]/name'); 36 | is( results( @nodes), 'e5', '1 doc, var is a simple litteral'); 37 | } 38 | 39 | { $t->set_var( org => 'A/B'); 40 | my @nodes= $t->findnodes('/data/employees/employee[@org=$org]/name'); 41 | is( results( @nodes), 'e6', '1 doc, var is an XPath-like litteral'); 42 | } 43 | 44 | } 45 | 46 | { # test with data in 2 single file 47 | my $te = XML::Twig::XPath->new->parse( $employees); 48 | my $ta = XML::Twig::XPath->new->parse( $areas); 49 | 50 | { $te->set_var( salary => 12000); 51 | my @nodes= $te->findnodes('/employees/employee[@salary=$salary]/name'); 52 | is( results( @nodes), 'e3:e4', '2 docs, var is a litteral'); 53 | } 54 | 55 | SKIP: 56 | { skip "node sets in an XPath variable are not supported with perl < 5.12", 1 unless $] >= 5.012; 57 | $te->set_var( E => $te->find( '/employees/employee[@salary>10000]')); 58 | $te->set_var( A => $ta->find( '/areas/area[district="Brooklyn"]/street')); 59 | my @nodes = $te->findnodes('$E[work_area/street = $A]/name'); 60 | is( results( @nodes), 'e3:e4', '2 docs, var is a node set'); 61 | } 62 | 63 | { $te->set_var( org => 'A'); 64 | my @nodes= $te->findnodes('/employees/employee[@org=$org]/name'); 65 | is( results( @nodes), 'e5', '2 docs, var is a simple litteral'); 66 | } 67 | 68 | { $te->set_var( org => 'A/B'); 69 | my @nodes= $te->findnodes('/employees/employee[@org=$org]/name'); 70 | is( results( @nodes), 'e6', '2 docs, var is an XPath-like litteral'); 71 | } 72 | 73 | } 74 | 75 | 76 | sub results 77 | { return join ':', map { $_->id || 'XX' } @_; } 78 | 79 | __DATA__ 80 | 81 | 82 | Employee 1 83 | 84 | Fifth Avenue 85 | 86 | 87 | 88 | Employee 2 89 | 90 | Abbey Court 91 | 92 | 93 | 94 | Employee 3 95 | 96 | Abbey Court 97 | 98 | 99 | 100 | Employee 4 101 | 102 | Broad Street 103 | Abbey Court 104 | 105 | 106 | 107 | Employee 5 108 | 109 | Broad Street 110 | Abbey Court 111 | 112 | 113 | 114 | Employee 6 115 | 116 | Broad Street 117 | Abbey Court 118 | 119 | 120 | 121 | 122 | 123 | 124 | Brooklyn 125 | Abbey Court 126 | Aberdeen Street 127 | Adams Street 128 | 129 | 130 | Manhattan 131 | Fifth Avenue 132 | Broad Street 133 | 134 | 135 | 136 | -------------------------------------------------------------------------------- /tools/xml_merge/xml_merge: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # $Id: /xmltwig/trunk/tools/xml_merge/xml_merge 12 2007-04-22T06:04:54.627880Z mrodrigu $ 3 | use strict; 4 | 5 | use XML::Twig; 6 | use FindBin qw( $RealBin $RealScript); 7 | use Getopt::Std; 8 | 9 | $Getopt::Std::STANDARD_HELP_VERSION=1; # to stop processing after --help or --version 10 | 11 | use vars qw( $VERSION $USAGE); 12 | 13 | $VERSION= "0.02"; 14 | $USAGE= "xml_merge [-o ] [-i] [-v] [-h] [-m] [-V] [file]\n"; 15 | 16 | { # main block 17 | 18 | my $opt={}; 19 | getopts('o:ivhmV', $opt); 20 | 21 | if( $opt->{h}) { die $USAGE, "\n"; } 22 | if( $opt->{m}) { exec "pod2text $RealBin/$RealScript"; } 23 | if( $opt->{V}) { print "xml_merge version $VERSION\n"; exit; } 24 | 25 | if( $opt->{o}) 26 | { open( my $out, '>', $opt->{o}) or die "cannot create $opt->{o}: $!"; 27 | $opt->{fh}= $out; # used to set twig_print_outside_roots 28 | } 29 | else 30 | { $opt->{fh}= 1; } # this way twig_print_outside_roots outputs to STDOUT 31 | 32 | $opt->{subdocs} = 1; 33 | $opt->{file} = $ARGV[0]; 34 | 35 | $opt->{twig_roots}= $opt->{i} ? { 'xi:include' => sub { $opt->{file}= $_->att( 'href'); 36 | if( $_->att( 'subdocs')) { merge( $opt); } 37 | else { spit( $opt); } 38 | }, 39 | } 40 | : { '?merge' => sub { $opt= parse( $_->data, $opt); 41 | if( $opt->{subdocs}) { merge( $opt); } 42 | else { spit( $opt); } 43 | }, 44 | } 45 | 46 | ; 47 | 48 | merge( $opt); 49 | 50 | if( $opt->{v}) { warn "done\n"; } 51 | 52 | } 53 | 54 | sub merge 55 | { my( $opt)= @_; 56 | my $t= XML::Twig->new( keep_encoding => 1, keep_spaces => 1, 57 | twig_roots => $opt->{twig_roots}, 58 | twig_print_outside_roots => $opt->{fh}, 59 | ); 60 | if( $opt->{v} && $opt->{file}) { warn "merging $opt->{file} (parsing)\n"; } 61 | if( $opt->{file}) { $t->parsefile( $opt->{file}); } else { $t->parse( \*STDIN); } 62 | } 63 | 64 | sub spit 65 | { my( $opt)= @_; 66 | if( $opt->{v} && $opt->{file}) { warn "merging $opt->{file} (no parsing)\n"; } 67 | open( my $in, '<', $opt->{file}) or die "cannot open sub document '$opt->{file}': $!"; 68 | while( <$in>) 69 | { next if( m{^\Q{o}) { print {$opt->{fh}} $_; } else { print $_; } 71 | } 72 | close $in; 73 | } 74 | 75 | # data is the pi data, 76 | # (ugly) format is keyword1 = val1 : keyword2 = val2 ... : filename 77 | # ex: subdoc = 1 : file-01.xml 78 | 79 | sub parse 80 | { my( $data, $opt)= @_; 81 | while( $data=~ s{^\s*(\S+)\s*=\s*(\S+)\s*:\s*}{}) { $opt->{$1}= $2; } 82 | $opt->{file}= $data; 83 | return $opt; 84 | } 85 | 86 | 87 | # for Getop::Std 88 | sub HELP_MESSAGE { return $USAGE; } 89 | sub VERSION_MESSAGE { return $VERSION; } 90 | 91 | __END__ 92 | 93 | =head1 NAME 94 | 95 | xml_merge - merge back XML files split with C 96 | 97 | =head1 DESCRIPTION 98 | 99 | C takes several xml files that have been split using 100 | C and recreates a single file. 101 | 102 | =head1 OPTIONS 103 | 104 | =over 4 105 | 106 | =item -o 107 | 108 | unless this option is used the program output goes to STDOUT 109 | 110 | =item -i 111 | 112 | the files use XInclude instead of processing instructions (they 113 | were created using the C<-i> option in C) 114 | 115 | =item -v 116 | 117 | verbose output 118 | 119 | =item -V 120 | 121 | outputs version and exit 122 | 123 | =item -h 124 | 125 | short help 126 | 127 | =item -m 128 | 129 | man (requires pod2text to be in the path) 130 | 131 | =back 132 | 133 | =head1 EXAMPLES 134 | 135 | xml_merge foo-00.xml # output to stdout 136 | xml_merge -o foo.xml foo-00.xml # output to foo.xml 137 | 138 | =head1 SEE ALSO 139 | 140 | XML::Twig, xml_split 141 | 142 | =head1 TODO/BUGS 143 | 144 | =head1 AUTHOR 145 | 146 | Michel Rodriguez 147 | 148 | =head1 LICENSE 149 | 150 | This tool is free software; you can redistribute it and/or modify 151 | it under the same terms as Perl itself. 152 | 153 | -------------------------------------------------------------------------------- /t/test_bugs_3_21.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use strict; 6 | use Carp; 7 | use File::Spec; 8 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 9 | use tools; 10 | 11 | $|=1; 12 | my $DEBUG=0; 13 | 14 | use XML::Twig; 15 | 16 | my $TMAX=25; 17 | print "1..$TMAX\n"; 18 | 19 | { # testing creation of elements in the proper class 20 | 21 | package foo; use base 'XML::Twig::Elt'; package main; 22 | 23 | my $t= XML::Twig->new( elt_class => "foo")->parse( ''); 24 | my $elt= $t->first_elt( 'elt'); 25 | $elt->set_text( 'bar'); 26 | is( $elt->first_child->text, 'bar', "content of element created with set_text"); 27 | is( ref( $elt->first_child), 'foo', "class of element created with set_text"); 28 | $elt->set_content( 'baz'); 29 | is( $elt->first_child->text, 'baz', "content of element created with set_content"); 30 | is( ref( $elt->first_child), 'foo', "class of element created with set_content"); 31 | $elt->insert( 'toto'); 32 | is( $elt->first_child->tag, 'toto', "tag of element created with set_content"); 33 | is( ref( $elt->first_child), 'foo', "class of element created with insert"); 34 | $elt->insert_new_elt( first_child => 'tata'); 35 | is( $elt->first_child->tag, 'tata', "tag of element created with insert_new_elt"); 36 | is( ref( $elt->first_child), 'foo', "class of element created with insert"); 37 | $elt->wrap_in( 'tutu'); 38 | is( $t->root->first_child->tag, 'tutu', "tag of element created with wrap_in"); 39 | is( ref( $t->root->first_child), 'foo', "class of element created with wrap_in"); 40 | $elt->prefix( 'titi'); 41 | is( $elt->first_child->text, 'titi', "content of element created with prefix"); 42 | is( ref( $elt->first_child), 'foo', "class of element created with prefix"); 43 | $elt->suffix( 'foobar'); 44 | is( $elt->last_child->text, 'foobar', "content of element created with suffix"); 45 | is( ref( $elt->last_child), 'foo', "class of element created with suffix"); 46 | $elt->last_child->split_at( 3); 47 | is( $elt->last_child->text, 'bar', "content of element created with split_at"); 48 | is( ref( $elt->last_child), 'foo', "class of element created with split_at"); 49 | is( ref( $elt->copy), 'foo', "class of element created with copy"); 50 | 51 | $t= XML::Twig->new( elt_class => "foo")->parse( 'toto'); 52 | $t->root->subs_text( qr{(to)} => '&elt( p => $1)'); 53 | is( $t->sprint, '

to

to

', "subs_text result"); 54 | my $result= join( '-', map { join( ":", ref($_), $_->tag) } $t->root->descendants); 55 | is( $result, "foo:p-foo:#PCDATA-foo:p-foo:#PCDATA", "subs_text classes and tags"); 56 | 57 | } 58 | 59 | 60 | { # wrap children with > in attribute 61 | my $doc=q{}; 62 | my $result =XML::Twig->new->parse( $doc)->root->wrap_children( '+', "w")->strip_att( 'id')->sprint; 63 | my $expected = q{}; 64 | is( $result => $expected, "wrap_children with > in attributes"); 65 | $result =XML::Twig->new->parse( $doc)->root->wrap_children( '+', "w")->strip_att( 'id')->sprint; 66 | $expected = q{}; 67 | is( $result => $expected, "wrap_children with > in attributes, > in condition"); 68 | $result =XML::Twig->new->parse( $doc)->root->wrap_children( '+', "w")->strip_att( 'id')->sprint; 69 | $expected = q{}; 70 | is( $result => $expected, "wrap_children with > in attributes un-escaped > in condition"); 71 | $result =XML::Twig->new->parse( $doc)->root->wrap_children( '+', "w")->strip_att( 'id')->sprint; 72 | $expected = q{}; 73 | is( $result => $expected, "wrap_children with > in attributes, 2 atts in condition"); 74 | $result =XML::Twig->new->parse( $doc)->root->wrap_children( '+', "w")->strip_att( 'id')->sprint; 75 | $expected = q{}; 76 | is( $result => $expected, "wrap_children with > in attributes, 2 atts in condition (no child matches)"); 77 | } 78 | 79 | { # test improvements to wrap_children 80 | my $doc= q{okNOK}; 81 | my $expected= q{okNOK}; 82 | my $t= XML::Twig->new->parse( $doc); 83 | $t->root->wrap_children( '+', w => { a => "&" }); 84 | $t->root->strip_att( 'id'); 85 | is( $t->sprint, $expected, "wrap_children with &"); 86 | } 87 | 88 | -------------------------------------------------------------------------------- /t/test_bugs_3_19.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | 5 | use strict; 6 | use Carp; 7 | use File::Spec; 8 | use lib File::Spec->catdir(File::Spec->curdir,"t"); 9 | use tools; 10 | 11 | $|=1; 12 | my $DEBUG=0; 13 | 14 | use XML::Twig; 15 | 16 | my $TMAX=26; 17 | print "1..$TMAX\n"; 18 | 19 | { 20 | #bug with long CDATA 21 | 22 | # get an accented char in iso-8859-1 23 | my $latin1_char= perl_io_layer_used() ? '' : slurp( File::Spec->catfile('t', "latin1_accented_char.iso-8859-1")); 24 | chomp $latin1_char; 25 | 26 | 27 | my %cdata=( "01- 1025 chars" => 'x' x 1025 . 'a', 28 | "02- short CDATA with nl" => "first line\nsecond line", 29 | "03- short CDATA with ]" => "first part]second part", 30 | "04- short CDATA with ] and spaces" => "first part ] second part", 31 | "05- 1024 chars with accent" => $latin1_char x 1023 . 'a', 32 | "06- 1025 chars with accent" => $latin1_char x 1024 . 'a', 33 | "07- 1023 chars, last a nl" => 'x' x 1022 . "\n", 34 | "08- 1023 chars, last a ]" => 'x' x 1022 . "]", 35 | "09- 1024 chars, last a nl" => 'x' x 1023 . "\n", 36 | "10- 1024 chars, last a ]" => 'x' x 1023 . "]", 37 | "11- 1025 chars, last a nl" => 'x' x 1024 . "\n", 38 | "12- 1025 chars, last a ]" => 'x' x 1024 . "]", 39 | "13- 1050 chars, last a nl" => ('1' x 1024) . ('2' x 25) . "\n", 40 | "14- 1050 chars, last a ]" => ('1' x 1024) . ('2' x 25) . "]", 41 | '15- 1060 chars, ] and \n' => ('1' x 1024) . ('2' x 26) . "\n \n ]\n]]\n", 42 | '16- 1060 chars, ] and \n' => ('1' x 1024) . ('2' x 26) . "\n \n ]\n]]", 43 | '17- 1060 chars, ] and \n' => ('1' x 1024) . ('2' x 26) . "\n \n ]\n]] ", 44 | '18- 1060 chars, ] and \n' => ('1' x 1024) . ('2' x 26) . "\n \n ]\n]] a", 45 | '19- 1060 chars, ] and \n' => '1' x 500 . "\n \n ]\n]] a" . '2' x 500 . "\n \n ]\n]] a", 46 | "20- 800 chars with accent" => $latin1_char x 800, 47 | "21- 800 chars with accent" => "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa$latin1_char" x 16, 48 | "22- 1600 chars with accent" => "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa$latin1_char" x 32, 49 | '23- 1600 chars with accent and \n' => "aaaaaaaa]aaaaaaaaaaaaaaaaaaaaaaaaa\naaaaaaaaaaaaaaa$latin1_char" x 32, 50 | ); 51 | 52 | if( ($] == 5.008) || ($] < 5.006) ) 53 | { skip( scalar keys %cdata, "KNOWN BUG in 5.8.0 and 5.005 with keep_encoding and long (>1024 char) CDATA, " 54 | . "see http://rt.cpan.org/Ticket/Display.html?id=14008" 55 | ); 56 | } 57 | elsif( perl_io_layer_used()) 58 | { skip( scalar keys %cdata, "cannot test parseurl when UTF8 perIO layer used " 59 | . "(due to PERL_UNICODE or -C option used)\n" 60 | ); 61 | } 62 | else 63 | { 64 | foreach my $test (sort keys %cdata) 65 | { my $cdata=$cdata{$test}; 66 | my $doc= qq{}; 67 | my $twig= XML::Twig->new( keep_encoding => 1)->parse($doc); 68 | my $res = $twig->root->first_child->cdata; 69 | is( $res, $cdata, "long CDATA with keep_encoding $test"); 70 | } 71 | } 72 | } 73 | 74 | { # testing _dump 75 | my $doc= q{foobartototatatitiand now a long (more than 40 characters) text to see if it gets shortened by default (or not)}; 76 | my $t= XML::Twig->new->parse( $doc); 77 | my $dump= q{document 78 | |-doc 79 | | |-elt att="xyz" 80 | | |-- (cpi before) '' 81 | | | |-PCDATA: 'foo' 82 | | |-elt 83 | | | |-PCDATA: 'bar' 84 | | | |-CDATA: 'baz' 85 | | |-elt2 86 | | |-- (cpi before) '' 87 | | | |-PCDATA: 'toto' 88 | | | |-b 89 | | | | |-PCDATA: 'tata' 90 | | | |-PCDATA: 'titi' 91 | | |-elt3 92 | | |-elt 93 | | | |-PCDATA: 'and now a long (more than 40 characters) tex ... see if it gets shortened by default (or not)' 94 | }; 95 | 96 | is( $t->_dump( { extra => 1 }), $dump, "_dump with extra on"); 97 | 98 | (my $no_extra= $dump)=~ s{^.*cpi before.*\n}{}gm; 99 | is( $t->_dump( ), $no_extra, "_dump without extra"); 100 | 101 | (my $no_att= $no_extra)=~ s{ att=.*}{}g; 102 | is( $t->_dump( { atts => 0 }), $no_att, "_dump without atts"); 103 | 104 | } 105 | 106 | -------------------------------------------------------------------------------- /t/test_memory.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use strict; 5 | use Carp; 6 | use File::Spec; 7 | use lib File::Spec->catdir( File::Spec->curdir, "t" ); 8 | use tools; 9 | 10 | $| = 1; 11 | my $DEBUG = 0; 12 | 13 | use XML::Twig; 14 | 15 | # only display warnings, test is too unreliable (especially under Devel::Cover) to trust 16 | 17 | my $mem_size = mem_size(); 18 | 19 | unless ($mem_size) { 20 | print "1..1\nok 1\n"; 21 | warn "skipping: memory size not available\n"; 22 | exit; 23 | } 24 | 25 | my $long_test = $ARGV[0] && $ARGV[0] eq '-L'; 26 | 27 | my $conf 28 | = $long_test 29 | ? { iter => 10, p => 1000 } 30 | : { iter => 5, p => 500 }; 31 | $conf->{normal} = $conf->{p} * $conf->{iter}; 32 | $conf->{normal_html} = $conf->{normal} * 2; 33 | 34 | my $TMAX = 3; 35 | print "1..$TMAX\n"; 36 | 37 | my $warn = 0; 38 | my $test_nb = 0; 39 | 40 | my $paras = join '', map {qq{

lorem ipsus whatever (clever latin stuff) no $_

}} 1 .. $conf->{p}; 41 | 42 | my $xml = qq{$paras}; 43 | XML::Twig->new->parse($xml); 44 | my $before = mem_size(); 45 | for ( 1 .. $conf->{iter} ) { 46 | my $t = XML::Twig->new->parse($xml); 47 | really_clear($t); 48 | } 49 | my $after = mem_size(); 50 | if ( $after - $before > $conf->{normal} ) { 51 | warn "test $test_nb: possible memory leak parsing xml ($after > $before)"; 52 | $warn++; 53 | } elsif ($long_test) { 54 | warn "$before => $after\n"; 55 | } 56 | ok( 1, "testing memory leaks for xml parsing" ); 57 | $test_nb++; 58 | 59 | { 60 | if ( XML::Twig::_use( 'HTML::TreeBuilder', 3.13 ) ) { 61 | my $html = qq{with HTB$paras}; 62 | XML::Twig->new->parse_html($html); 63 | my $before = mem_size(); 64 | for ( 1 .. $conf->{iter} ) { XML::Twig->new->parse_html($html); } 65 | my $after = mem_size(); 66 | if ( $after - $before > $conf->{normal_html} ) { 67 | warn "test $test_nb: possible memory leak parsing html ($after > $before)"; 68 | $warn++; 69 | } elsif ($long_test) { 70 | warn "$before => $after\n"; 71 | } 72 | ok( 1, "testing memory leaks for html parsing" ); 73 | } else { 74 | skip( 1, "need HTML::TreeBuilder 3.13+" ); 75 | } 76 | $test_nb++; 77 | } 78 | 79 | { 80 | if ( XML::Twig::_use('HTML::Tidy') ) { 81 | my $html = qq{with tidy$paras}; 82 | XML::Twig->new( use_tidy => 1 )->parse_html($html); 83 | my $before = mem_size(); 84 | for ( 1 .. $conf->{iter} ) { XML::Twig->new( use_tidy => 1 )->parse_html($html); } 85 | my $after = mem_size(); 86 | if ( $after - $before > $conf->{normal_html} ) { 87 | warn "test $test_nb: possible memory leak parsing html ($after > $before)"; 88 | $warn++; 89 | } elsif ($long_test) { 90 | warn "$before => $after\n"; 91 | } 92 | ok( 1, "testing memory leaks for html parsing using HTML::Tidy" ); 93 | } else { 94 | skip( 1, "need HTML::Tidy" ); 95 | } 96 | $test_nb++; 97 | } 98 | 99 | if ($warn) { 100 | warn "\nnote that memory leaks can happen even if the module itself doesn't leak, if running", 101 | "\ntests under Devel::Cover for example. So do not panic if you get a warning here.\n"; 102 | } 103 | 104 | sub mem_size { 105 | open( STATUS, "/proc/$$/status" ) or return; 106 | my ($size) = map {m{^VmSize:\s+(\d+\s+\w+)}} ; 107 | $size =~ s{ kB}{}; 108 | 109 | #warn "data size found: $size\n"; 110 | return $size; 111 | } 112 | 113 | sub really_clear { 114 | my ($t) = shift; 115 | my $elt = $t->root; 116 | delete $t->{twig_dtd}; 117 | delete $t->{twig_doctype}; 118 | delete $t->{twig_xmldecl}; 119 | delete $t->{twig_root}; 120 | delete $t->{twig_parser}; 121 | 122 | return; 123 | 124 | local $SIG{__WARN__} = sub { }; 125 | 126 | while ($elt) { 127 | my $nelt = nelt($elt); 128 | $elt->del_id($t); 129 | foreach (qw(gi att empty former)) { undef $elt->{$_}; delete $elt->{$_}; } 130 | $elt->delete; 131 | $elt = $nelt; 132 | } 133 | $t->dispose; 134 | } 135 | 136 | sub nelt { 137 | my ($elt) = @_; 138 | if ( $elt->_first_child ) { return deepest_child($elt); } 139 | if ( $elt->_next_sibling ) { return deepest_child( $elt->_next_sibling ); } 140 | return $elt->parent; 141 | } 142 | 143 | sub deepest_child { 144 | my ($elt) = @_; 145 | while ( $elt->_first_child ) { $elt = $elt->_first_child; } 146 | return $elt; 147 | } 148 | --------------------------------------------------------------------------------