← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm
StatementsExecuted 74150636 statements in 41.9s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
364369329.97s35.2sXML::Twig::::_twig_start XML::Twig::_twig_start
1095679216.34s15.8sXML::Twig::::_ns_info XML::Twig::_ns_info
398167215.90s22.1sXML::Twig::::_replace_ns XML::Twig::_replace_ns
364369225.66s25.4sXML::Twig::::_twig_end XML::Twig::_twig_end
380001215.08s7.90sXML::Twig::::_a_proper_ns_prefix XML::Twig::_a_proper_ns_prefix
364369112.12s2.69sXML::Twig::::_replace_prefix XML::Twig::_replace_prefix
364369111.71s1.82sXML::Twig::Elt::::new XML::Twig::Elt::new
4215601421.66s2.08sXML::Twig::Elt::::first_child XML::Twig::Elt::first_child
364369111.56s1.69sXML::Twig::Elt::::set_atts XML::Twig::Elt::set_atts
397806211.18s1.46sXML::Twig::::_handler XML::Twig::_handler
12729211968ms1.00sXML::Twig::::_insert_pcdata XML::Twig::_insert_pcdata
20298611915ms958msXML::Twig::Elt::::next_sibling XML::Twig::Elt::next_sibling
12729211829ms1.91sXML::Twig::::_twig_char XML::Twig::_twig_char
3379911720ms8.21sXML::Twig::::_twig_start_check_roots XML::Twig::_twig_start_check_roots
25458232678ms678msXML::Twig::Elt::::text XML::Twig::Elt::text (recurses: max depth 1, inclusive time 145ms)
72873821599ms599msXML::Twig::::_add_or_discard_stored_spaces XML::Twig::_add_or_discard_stored_spaces
3381311545ms579msXML::Twig::Elt::::cut XML::Twig::Elt::cut
185824341524ms524msXML::Twig::::parser XML::Twig::parser
1565187500ms1.57sXML::Twig::Elt::::children XML::Twig::Elt::children
3380771317ms1.17sXML::Twig::::purge XML::Twig::purge
674081451278ms278msXML::Twig::Elt::::att XML::Twig::Elt::att
6776831177ms203msXML::Twig::Elt::::in XML::Twig::Elt::in
36436911128ms128msXML::Twig::Elt::::keep_atts_order XML::Twig::Elt::keep_atts_order
338132174.1ms653msXML::Twig::Elt::::delete XML::Twig::Elt::delete
12748710964.6ms64.6msXML::Twig::Elt::::gi XML::Twig::Elt::gi
37216.09ms7.38msXML::Twig::Elt::::_install_cond XML::Twig::Elt::_install_cond
21113.22ms5.96msXML::Twig::::_parse_xpath_handler XML::Twig::_parse_xpath_handler
15111.98ms3.48msXML::Twig::Elt::::_install_xpath XML::Twig::Elt::_install_xpath
7111.59ms2.49msXML::Twig::::_use XML::Twig::_use
1111.01ms3.56msXML::Twig::::BEGIN@151 XML::Twig::BEGIN@151
1611618µs870µsXML::Twig::Elt::::descendants XML::Twig::Elt::descendants
15421527µs649µsXML::Twig::Elt::::ancestors XML::Twig::Elt::ancestors
7711479µs1.42msXML::Twig::Elt::::cmp XML::Twig::Elt::cmp
711392µs12.0msXML::Twig::::new XML::Twig::new
2121382µs8.48msXML::Twig::::_set_handler XML::Twig::_set_handler
111307µs480µsXML::Twig::::BEGIN@1125 XML::Twig::BEGIN@1125
11711242µs242µsXML::Twig::Elt::::set_gi XML::Twig::Elt::set_gi
45821190µs5.29msXML::Twig::Elt::::passes XML::Twig::Elt::passes
111141µs169µsXML::Twig::::BEGIN@25 XML::Twig::BEGIN@25
111136µs252µsXML::Twig::Elt::::next_elt XML::Twig::Elt::next_elt
632125µs584µsXML::Twig::::DESTROY XML::Twig::DESTROY
2711117µs120µsXML::Twig::::_tag_cond XML::Twig::_tag_cond
3711112µs153µsXML::Twig::Elt::::_gi_test XML::Twig::Elt::_gi_test
211194µs6.12msXML::Twig::::_set_xpath_handler XML::Twig::_set_xpath_handler
161186µs12.3msXML::Twig::Elt::::get_xpath XML::Twig::Elt::get_xpath
16151584µs6.13msXML::Twig::::descendants XML::Twig::descendants
1616182µs12.4msXML::Twig::::get_xpath XML::Twig::get_xpath
11181µs81µsSpreadsheet::ParseXLSX::::BEGIN@11.2 Spreadsheet::ParseXLSX::BEGIN@11.2
11179µs240µsXML::Twig::::BEGIN@148 XML::Twig::BEGIN@148
211172µs72µsXML::Twig::::_add_handler XML::Twig::_add_handler
71165µs88µsXML::Twig::::_twig_final XML::Twig::_twig_final
71163µs63µsXML::Twig::::_normalize_args XML::Twig::_normalize_args
11161µs4.78msXML::Twig::::setTwigRoots XML::Twig::setTwigRoots
753160µs60µsXML::Twig::::_join_n XML::Twig::_join_n
16151560µs1.56msXML::Twig::::_unique_elts XML::Twig::_unique_elts
71150µs80µsXML::Twig::::_twig_end_check_roots XML::Twig::_twig_end_check_roots
73148µs70.4sXML::Twig::::parse XML::Twig::parse
211148µs92µsXML::Twig::::_set_pi_handler XML::Twig::_set_pi_handler
211148µs88µsXML::Twig::::_set_special_handler XML::Twig::_set_special_handler
161140µs40µsXML::Twig::Elt::::root XML::Twig::Elt::root
16151538µs78µsXML::Twig::Elt::::twig XML::Twig::Elt::twig
71133µs44µsXML::Twig::::_twig_init XML::Twig::_twig_init
11133µs49µsXML::Twig::Elt::::BEGIN@5096 XML::Twig::Elt::BEGIN@5096
71132µs32µsXML::Twig::::_twig_xmldecl XML::Twig::_twig_xmldecl
211131µs36µsXML::Twig::::_set_level_handler XML::Twig::_set_level_handler
11129µs29µsXML::Twig::::BEGIN@3842 XML::Twig::BEGIN@3842
211129µs32µsXML::Twig::::_set_regexp_handler XML::Twig::_set_regexp_handler
22122µs6.11msXML::Twig::::_set_handlers XML::Twig::_set_handlers
71122µs24µsXML::Twig::::set_root XML::Twig::set_root
71121µs25µsXML::Twig::Elt::::set_output_filter XML::Twig::Elt::set_output_filter
344120µs20µsXML::Twig::::root XML::Twig::root
61118µs26µsXML::Twig::Elt::::is_elt XML::Twig::Elt::is_elt
71118µs20µsXML::Twig::Elt::::set_output_text_filter XML::Twig::Elt::set_output_text_filter
71118µs26µsXML::Twig::::set_keep_encoding XML::Twig::set_keep_encoding
61118µs23µsXML::Twig::::_twig_default XML::Twig::_twig_default
71117µs78µsXML::Twig::::_checked_parse_result XML::Twig::_checked_parse_result
11116µs16µsXML::Twig::Elt::::BEGIN@8119 XML::Twig::Elt::BEGIN@8119
71113µs13µsXML::Twig::Entity_list::::new XML::Twig::Entity_list::new
71113µs13µsXML::Twig::Elt::::_join_defined XML::Twig::Elt::_join_defined
71113µs26µsXML::Twig::Elt::::_and XML::Twig::Elt::_and
71111µs20µsXML::Twig::::set_expand_external_entities XML::Twig::set_expand_external_entities
71111µs11µsXML::Twig::Elt::::set_quote XML::Twig::Elt::set_quote
71111µs17µsXML::Twig::::set_do_not_escape_amp_in_atts XML::Twig::set_do_not_escape_amp_in_atts
71111µs22µsXML::Twig::::set_quote XML::Twig::set_quote
71110µs17µsXML::Twig::::set_keep_atts_order XML::Twig::set_keep_atts_order
51110µs10µsXML::Twig::Elt::::_op XML::Twig::Elt::_op
71110µs10µsXML::Twig::Notation_list::::newXML::Twig::Notation_list::new
7119µs14µsXML::Twig::::set_remove_cdata XML::Twig::set_remove_cdata
7119µs34µsXML::Twig::::set_output_filter XML::Twig::set_output_filter
1119µs10µsXML::Twig::Elt::::BEGIN@8108 XML::Twig::Elt::BEGIN@8108
1119µs9µsXML::Twig::::_check_illegal_twig_roots_handlers XML::Twig::_check_illegal_twig_roots_handlers
7119µs28µsXML::Twig::::set_output_text_filter XML::Twig::set_output_text_filter
7118µs8µsXML::Twig::Elt::::set_expand_external_entities XML::Twig::Elt::set_expand_external_entities
1118µs3.81msXML::Twig::::setTwigHandlers XML::Twig::setTwigHandlers
1118µs10µsSpreadsheet::ParseXLSX::::BEGIN@1 Spreadsheet::ParseXLSX::BEGIN@1
1118µs10µsXML::Twig::::BEGIN@2455 XML::Twig::BEGIN@2455
7118µs8µsXML::Twig::Elt::::set_keep_encoding XML::Twig::Elt::set_keep_encoding
1118µs10µsXML::Twig::::BEGIN@4636 XML::Twig::BEGIN@4636
1118µs12µsXML::Twig::::BEGIN@1327 XML::Twig::BEGIN@1327
1118µs12µsXML::Twig::::BEGIN@3229 XML::Twig::BEGIN@3229
7118µs8µsXML::Twig::::_set_fh_to_selected_fh XML::Twig::_set_fh_to_selected_fh
1117µs20µsXML::Twig::::BEGIN@439 XML::Twig::BEGIN@439
1117µs31µsXML::Twig::Elt::::BEGIN@5082 XML::Twig::Elt::BEGIN@5082
1117µs9µsXML::Twig::Elt::::BEGIN@7919 XML::Twig::Elt::BEGIN@7919
1117µs8µsXML::Twig::::BEGIN@30 XML::Twig::BEGIN@30
7117µs7µsXML::Twig::Elt::::set_keep_atts_order XML::Twig::Elt::set_keep_atts_order
1117µs7µsXML::Twig::Elt::::BEGIN@8404 XML::Twig::Elt::BEGIN@8404
1117µs11µsXML::Twig::::BEGIN@3587 XML::Twig::BEGIN@3587
7117µs7µsXML::Twig::Elt::::set_do_not_escape_amp_in_atts XML::Twig::Elt::set_do_not_escape_amp_in_atts
1116µs10µsXML::Twig::::BEGIN@4159 XML::Twig::BEGIN@4159
7116µs6µsXML::Twig::::_set_fh_to_twig_output_fh XML::Twig::_set_fh_to_twig_output_fh
1116µs6µsXML::Twig::Elt::::BEGIN@8906 XML::Twig::Elt::BEGIN@8906
1116µs10µsXML::Twig::::BEGIN@3852 XML::Twig::BEGIN@3852
2216µs6µsXML::Twig::::_reset_handlers XML::Twig::_reset_handlers
1116µs6µsXML::Twig::Elt::::BEGIN@6961 XML::Twig::Elt::BEGIN@6961
1116µs9µsXML::Twig::::BEGIN@3619 XML::Twig::BEGIN@3619
1116µs9µsXML::Twig::::BEGIN@3648 XML::Twig::BEGIN@3648
1115µs18µsXML::Twig::::BEGIN@812 XML::Twig::BEGIN@812
1115µs6µsXML::Twig::::BEGIN@4649 XML::Twig::BEGIN@4649
1115µs8µsXML::Twig::::BEGIN@4211 XML::Twig::BEGIN@4211
1115µs8µsXML::Twig::::BEGIN@4246 XML::Twig::BEGIN@4246
7115µs5µsXML::Twig::Elt::::set_remove_cdata XML::Twig::Elt::set_remove_cdata
1115µs24µsXML::Twig::::BEGIN@29 XML::Twig::BEGIN@29
1115µs8µsXML::Twig::::BEGIN@4175 XML::Twig::BEGIN@4175
1114µs14µsXML::Twig::::BEGIN@38 XML::Twig::BEGIN@38
1114µs4µsXML::Twig::Elt::::BEGIN@7340 XML::Twig::Elt::BEGIN@7340
1114µs10µsXML::Twig::::BEGIN@33 XML::Twig::BEGIN@33
1114µs21µsXML::Twig::::BEGIN@31 XML::Twig::BEGIN@31
1114µs28µsXML::Twig::::BEGIN@27 XML::Twig::BEGIN@27
1114µs6µsXML::Twig::::BEGIN@4181 XML::Twig::BEGIN@4181
1114µs18µsSpreadsheet::ParseXLSX::::BEGIN@2 Spreadsheet::ParseXLSX::BEGIN@2
1113µs3µsXML::Twig::Notation::::BEGIN@5023 XML::Twig::Notation::BEGIN@5023
1113µs3µsXML::Twig::Elt::::BEGIN@6232 XML::Twig::Elt::BEGIN@6232
1112µs2µsXML::Twig::::__ANON__[:265] XML::Twig::__ANON__[:265]
1111µs1µsSpreadsheet::ParseXLSX::::BEGIN@7 Spreadsheet::ParseXLSX::BEGIN@7
1111µs1µsXML::Twig::Elt::::set_destroy XML::Twig::Elt::set_destroy
111600ns600nsSpreadsheet::ParseXLSX::::__ANON__ Spreadsheet::ParseXLSX::__ANON__ (xsub)
0000s0sXML::Twig::Elt::::__ANON__[:9636] XML::Twig::Elt::__ANON__[:9636]
0000s0sXML::Twig::Elt::::__ANON__[:9643] XML::Twig::Elt::__ANON__[:9643]
0000s0sXML::Twig::Elt::::__destroy XML::Twig::Elt::__destroy
0000s0sXML::Twig::Elt::::__flush XML::Twig::Elt::__flush
0000s0sXML::Twig::Elt::::_ancestors XML::Twig::Elt::_ancestors
0000s0sXML::Twig::Elt::::_att_xml_string XML::Twig::Elt::_att_xml_string
0000s0sXML::Twig::Elt::::_atts_to_SAX2 XML::Twig::Elt::_atts_to_SAX2
0000s0sXML::Twig::Elt::::_children XML::Twig::Elt::_children
0000s0sXML::Twig::Elt::::_comment_escaped_string XML::Twig::Elt::_comment_escaped_string
0000s0sXML::Twig::Elt::::_croak_and_doublecheck_xpath XML::Twig::Elt::_croak_and_doublecheck_xpath
0000s0sXML::Twig::Elt::::_current_ns_prefix_map XML::Twig::Elt::_current_ns_prefix_map
0000s0sXML::Twig::Elt::::_del_extra_data_before_end_tag XML::Twig::Elt::_del_extra_data_before_end_tag
0000s0sXML::Twig::Elt::::_del_extra_data_in_pcdata XML::Twig::Elt::_del_extra_data_in_pcdata
0000s0sXML::Twig::Elt::::_del_flushed XML::Twig::Elt::_del_flushed
0000s0sXML::Twig::Elt::::_descendants XML::Twig::Elt::_descendants
0000s0sXML::Twig::Elt::::_dump XML::Twig::Elt::_dump
0000s0sXML::Twig::Elt::::_dump_extra_data XML::Twig::Elt::_dump_extra_data
0000s0sXML::Twig::Elt::::_end_prefix_mapping XML::Twig::Elt::_end_prefix_mapping
0000s0sXML::Twig::Elt::::_end_tag_data_SAX1 XML::Twig::Elt::_end_tag_data_SAX1
0000s0sXML::Twig::Elt::::_end_tag_data_SAX2 XML::Twig::Elt::_end_tag_data_SAX2
0000s0sXML::Twig::Elt::::_extra_data_before_end_tag XML::Twig::Elt::_extra_data_before_end_tag
0000s0sXML::Twig::Elt::::_extra_data_in_pcdata XML::Twig::Elt::_extra_data_in_pcdata
0000s0sXML::Twig::Elt::::_first_child XML::Twig::Elt::_first_child
0000s0sXML::Twig::Elt::::_flush XML::Twig::Elt::_flush
0000s0sXML::Twig::Elt::::_flushed XML::Twig::Elt::_flushed
0000s0sXML::Twig::Elt::::_following_elt XML::Twig::Elt::_following_elt
0000s0sXML::Twig::Elt::::_gen_mark XML::Twig::Elt::_gen_mark
0000s0sXML::Twig::Elt::::_inherit_att_through_cut XML::Twig::Elt::_inherit_att_through_cut
0000s0sXML::Twig::Elt::::_install_replace_sub XML::Twig::Elt::_install_replace_sub
0000s0sXML::Twig::Elt::::_is_private XML::Twig::Elt::_is_private
0000s0sXML::Twig::Elt::::_is_private_name XML::Twig::Elt::_is_private_name
0000s0sXML::Twig::Elt::::_is_string XML::Twig::Elt::_is_string
0000s0sXML::Twig::Elt::::_keep_encoding XML::Twig::Elt::_keep_encoding
0000s0sXML::Twig::Elt::::_key_attr XML::Twig::Elt::_key_attr
0000s0sXML::Twig::Elt::::_last_child XML::Twig::Elt::_last_child
0000s0sXML::Twig::Elt::::_last_descendant XML::Twig::Elt::_last_descendant
0000s0sXML::Twig::Elt::::_local_name XML::Twig::Elt::_local_name
0000s0sXML::Twig::Elt::::_match_expr XML::Twig::Elt::_match_expr
0000s0sXML::Twig::Elt::::_match_extra_data XML::Twig::Elt::_match_extra_data
0000s0sXML::Twig::Elt::::_match_extra_data_chars XML::Twig::Elt::_match_extra_data_chars
0000s0sXML::Twig::Elt::::_match_extra_data_words XML::Twig::Elt::_match_extra_data_words
0000s0sXML::Twig::Elt::::_match_tag XML::Twig::Elt::_match_tag
0000s0sXML::Twig::Elt::::_move_extra_data_after_erase XML::Twig::Elt::_move_extra_data_after_erase
0000s0sXML::Twig::Elt::::_new_pcdata XML::Twig::Elt::_new_pcdata
0000s0sXML::Twig::Elt::::_next_sibling XML::Twig::Elt::_next_sibling
0000s0sXML::Twig::Elt::::_next_siblings XML::Twig::Elt::_next_siblings
0000s0sXML::Twig::Elt::::_normalize_space XML::Twig::Elt::_normalize_space
0000s0sXML::Twig::Elt::::_ns_prefix XML::Twig::Elt::_ns_prefix
0000s0sXML::Twig::Elt::::_parent XML::Twig::Elt::_parent
0000s0sXML::Twig::Elt::::_parse_predicate_in_step XML::Twig::Elt::_parse_predicate_in_step
0000s0sXML::Twig::Elt::::_pos_offset XML::Twig::Elt::_pos_offset
0000s0sXML::Twig::Elt::::_preceding_elt XML::Twig::Elt::_preceding_elt
0000s0sXML::Twig::Elt::::_prefix_extra_data_before_end_tag XML::Twig::Elt::_prefix_extra_data_before_end_tag
0000s0sXML::Twig::Elt::::_pretty_print XML::Twig::Elt::_pretty_print
0000s0sXML::Twig::Elt::::_pretty_print_styles XML::Twig::Elt::_pretty_print_styles
0000s0sXML::Twig::Elt::::_prev_sibling XML::Twig::Elt::_prev_sibling
0000s0sXML::Twig::Elt::::_prev_siblings XML::Twig::Elt::_prev_siblings
0000s0sXML::Twig::Elt::::_protect_extra_data XML::Twig::Elt::_protect_extra_data
0000s0sXML::Twig::Elt::::_push_extra_data_in_pcdata XML::Twig::Elt::_push_extra_data_in_pcdata
0000s0sXML::Twig::Elt::::_repl_match XML::Twig::Elt::_repl_match
0000s0sXML::Twig::Elt::::_replace_var XML::Twig::Elt::_replace_var
0000s0sXML::Twig::Elt::::_replace_vars_in_text XML::Twig::Elt::_replace_vars_in_text
0000s0sXML::Twig::Elt::::_restore_original_prefix XML::Twig::Elt::_restore_original_prefix
0000s0sXML::Twig::Elt::::_root_through_cut XML::Twig::Elt::_root_through_cut
0000s0sXML::Twig::Elt::::_self XML::Twig::Elt::_self
0000s0sXML::Twig::Elt::::_set_cdata XML::Twig::Elt::_set_cdata
0000s0sXML::Twig::Elt::::_set_comment XML::Twig::Elt::_set_comment
0000s0sXML::Twig::Elt::::_set_extra_data_before_end_tag XML::Twig::Elt::_set_extra_data_before_end_tag
0000s0sXML::Twig::Elt::::_set_extra_data_in_pcdata XML::Twig::Elt::_set_extra_data_in_pcdata
0000s0sXML::Twig::Elt::::_set_flushed XML::Twig::Elt::_set_flushed
0000s0sXML::Twig::Elt::::_set_id XML::Twig::Elt::_set_id
0000s0sXML::Twig::Elt::::_set_pcdata XML::Twig::Elt::_set_pcdata
0000s0sXML::Twig::Elt::::_set_pi XML::Twig::Elt::_set_pi
0000s0sXML::Twig::Elt::::_short_text XML::Twig::Elt::_short_text
0000s0sXML::Twig::Elt::::_simplify XML::Twig::Elt::_simplify
0000s0sXML::Twig::Elt::::_split XML::Twig::Elt::_split
0000s0sXML::Twig::Elt::::_sprint XML::Twig::Elt::_sprint
0000s0sXML::Twig::Elt::::_start_prefix_mapping XML::Twig::Elt::_start_prefix_mapping
0000s0sXML::Twig::Elt::::_start_tag_data_SAX1 XML::Twig::Elt::_start_tag_data_SAX1
0000s0sXML::Twig::Elt::::_start_tag_data_SAX2 XML::Twig::Elt::_start_tag_data_SAX2
0000s0sXML::Twig::Elt::::_store_var XML::Twig::Elt::_store_var
0000s0sXML::Twig::Elt::::_stringify_struct XML::Twig::Elt::_stringify_struct
0000s0sXML::Twig::Elt::::_text_with_vars XML::Twig::Elt::_text_with_vars
0000s0sXML::Twig::Elt::::_toSAX XML::Twig::Elt::_toSAX
0000s0sXML::Twig::Elt::::_try_moving_extra_data XML::Twig::Elt::_try_moving_extra_data
0000s0sXML::Twig::Elt::::_twig_through_cut XML::Twig::Elt::_twig_through_cut
0000s0sXML::Twig::Elt::::_unprotect_extra_data XML::Twig::Elt::_unprotect_extra_data
0000s0sXML::Twig::Elt::::_unshift_extra_data_in_pcdata XML::Twig::Elt::_unshift_extra_data_in_pcdata
0000s0sXML::Twig::Elt::::_utf8_ify XML::Twig::Elt::_utf8_ify
0000s0sXML::Twig::Elt::::_wrap_range XML::Twig::Elt::_wrap_range
0000s0sXML::Twig::Elt::::_wrap_text XML::Twig::Elt::_wrap_text
0000s0sXML::Twig::Elt::::add_att_to_class XML::Twig::Elt::add_att_to_class
0000s0sXML::Twig::Elt::::add_id XML::Twig::Elt::add_id
0000s0sXML::Twig::Elt::::add_tag_to_class XML::Twig::Elt::add_tag_to_class
0000s0sXML::Twig::Elt::::add_to_class XML::Twig::Elt::add_to_class
0000s0sXML::Twig::Elt::::after XML::Twig::Elt::after
0000s0sXML::Twig::Elt::::all_children_are XML::Twig::Elt::all_children_are
0000s0sXML::Twig::Elt::::ancestors_or_self XML::Twig::Elt::ancestors_or_self
0000s0sXML::Twig::Elt::::append_cdata XML::Twig::Elt::append_cdata
0000s0sXML::Twig::Elt::::append_extra_data XML::Twig::Elt::append_extra_data
0000s0sXML::Twig::Elt::::append_pcdata XML::Twig::Elt::append_pcdata
0000s0sXML::Twig::Elt::::att_exists XML::Twig::Elt::att_exists
0000s0sXML::Twig::Elt::::att_names XML::Twig::Elt::att_names
0000s0sXML::Twig::Elt::::att_nb XML::Twig::Elt::att_nb
0000s0sXML::Twig::Elt::::att_to_class XML::Twig::Elt::att_to_class
0000s0sXML::Twig::Elt::::att_to_field XML::Twig::Elt::att_to_field
0000s0sXML::Twig::Elt::::att_xml_string XML::Twig::Elt::att_xml_string
0000s0sXML::Twig::Elt::::atts XML::Twig::Elt::atts
0000s0sXML::Twig::Elt::::before XML::Twig::Elt::before
0000s0sXML::Twig::Elt::::cdata XML::Twig::Elt::cdata
0000s0sXML::Twig::Elt::::cdata_string XML::Twig::Elt::cdata_string
0000s0sXML::Twig::Elt::::change_att_name XML::Twig::Elt::change_att_name
0000s0sXML::Twig::Elt::::child XML::Twig::Elt::child
0000s0sXML::Twig::Elt::::child_matches XML::Twig::Elt::child_matches
0000s0sXML::Twig::Elt::::child_text XML::Twig::Elt::child_text
0000s0sXML::Twig::Elt::::child_trimmed_text XML::Twig::Elt::child_trimmed_text
0000s0sXML::Twig::Elt::::children_copy XML::Twig::Elt::children_copy
0000s0sXML::Twig::Elt::::children_count XML::Twig::Elt::children_count
0000s0sXML::Twig::Elt::::children_text XML::Twig::Elt::children_text
0000s0sXML::Twig::Elt::::children_trimmed_text XML::Twig::Elt::children_trimmed_text
0000s0sXML::Twig::Elt::::class XML::Twig::Elt::class
0000s0sXML::Twig::Elt::::closed XML::Twig::Elt::closed
0000s0sXML::Twig::Elt::::comment XML::Twig::Elt::comment
0000s0sXML::Twig::Elt::::comment_string XML::Twig::Elt::comment_string
0000s0sXML::Twig::Elt::::contains_a_single XML::Twig::Elt::contains_a_single
0000s0sXML::Twig::Elt::::contains_only XML::Twig::Elt::contains_only
0000s0sXML::Twig::Elt::::contains_only_text XML::Twig::Elt::contains_only_text
0000s0sXML::Twig::Elt::::contains_text XML::Twig::Elt::contains_text
0000s0sXML::Twig::Elt::::copy XML::Twig::Elt::copy
0000s0sXML::Twig::Elt::::current_ns_prefixes XML::Twig::Elt::current_ns_prefixes
0000s0sXML::Twig::Elt::::cut_children XML::Twig::Elt::cut_children
0000s0sXML::Twig::Elt::::cut_descendants XML::Twig::Elt::cut_descendants
0000s0sXML::Twig::Elt::::data XML::Twig::Elt::data
0000s0sXML::Twig::Elt::::declare_missing_ns XML::Twig::Elt::declare_missing_ns
0000s0sXML::Twig::Elt::::del_att XML::Twig::Elt::del_att
0000s0sXML::Twig::Elt::::del_atts XML::Twig::Elt::del_atts
0000s0sXML::Twig::Elt::::del_id XML::Twig::Elt::del_id
0000s0sXML::Twig::Elt::::del_twig_current XML::Twig::Elt::del_twig_current
0000s0sXML::Twig::Elt::::descendants_or_self XML::Twig::Elt::descendants_or_self
0000s0sXML::Twig::Elt::::do_not_escape_gt XML::Twig::Elt::do_not_escape_gt
0000s0sXML::Twig::Elt::::end_tag XML::Twig::Elt::end_tag
0000s0sXML::Twig::Elt::::ent XML::Twig::Elt::ent
0000s0sXML::Twig::Elt::::ent_name XML::Twig::Elt::ent_name
0000s0sXML::Twig::Elt::::ent_string XML::Twig::Elt::ent_string
0000s0sXML::Twig::Elt::::erase XML::Twig::Elt::erase
0000s0sXML::Twig::Elt::::escape_gt XML::Twig::Elt::escape_gt
0000s0sXML::Twig::Elt::::extra_data XML::Twig::Elt::extra_data
0000s0sXML::Twig::Elt::::field_to_att XML::Twig::Elt::field_to_att
0000s0sXML::Twig::Elt::::fields XML::Twig::Elt::fields
0000s0sXML::Twig::Elt::::findvalue XML::Twig::Elt::findvalue
0000s0sXML::Twig::Elt::::findvalues XML::Twig::Elt::findvalues
0000s0sXML::Twig::Elt::::first_child_matches XML::Twig::Elt::first_child_matches
0000s0sXML::Twig::Elt::::first_child_text XML::Twig::Elt::first_child_text
0000s0sXML::Twig::Elt::::first_child_trimmed_text XML::Twig::Elt::first_child_trimmed_text
0000s0sXML::Twig::Elt::::first_descendant XML::Twig::Elt::first_descendant
0000s0sXML::Twig::Elt::::flush XML::Twig::Elt::flush
0000s0sXML::Twig::Elt::::following_elt XML::Twig::Elt::following_elt
0000s0sXML::Twig::Elt::::following_elts XML::Twig::Elt::following_elts
0000s0sXML::Twig::Elt::::former_next_sibling XML::Twig::Elt::former_next_sibling
0000s0sXML::Twig::Elt::::former_parent XML::Twig::Elt::former_parent
0000s0sXML::Twig::Elt::::former_prev_sibling XML::Twig::Elt::former_prev_sibling
0000s0sXML::Twig::Elt::::ge XML::Twig::Elt::ge
0000s0sXML::Twig::Elt::::getChildNodes XML::Twig::Elt::getChildNodes
0000s0sXML::Twig::Elt::::getElementById XML::Twig::Elt::getElementById
0000s0sXML::Twig::Elt::::get_type XML::Twig::Elt::get_type
0000s0sXML::Twig::Elt::::global_state XML::Twig::Elt::global_state
0000s0sXML::Twig::Elt::::gt XML::Twig::Elt::gt
0000s0sXML::Twig::Elt::::has_no_atts XML::Twig::Elt::has_no_atts
0000s0sXML::Twig::Elt::::id XML::Twig::Elt::id
0000s0sXML::Twig::Elt::::ignore XML::Twig::Elt::ignore
0000s0sXML::Twig::Elt::::in_class XML::Twig::Elt::in_class
0000s0sXML::Twig::Elt::::in_context XML::Twig::Elt::in_context
0000s0sXML::Twig::Elt::::inherit_att XML::Twig::Elt::inherit_att
0000s0sXML::Twig::Elt::::init_global_state XML::Twig::Elt::init_global_state
0000s0sXML::Twig::Elt::::insert XML::Twig::Elt::insert
0000s0sXML::Twig::Elt::::insert_new_elt XML::Twig::Elt::insert_new_elt
0000s0sXML::Twig::Elt::::is_asis XML::Twig::Elt::is_asis
0000s0sXML::Twig::Elt::::is_cdata XML::Twig::Elt::is_cdata
0000s0sXML::Twig::Elt::::is_comment XML::Twig::Elt::is_comment
0000s0sXML::Twig::Elt::::is_empty XML::Twig::Elt::is_empty
0000s0sXML::Twig::Elt::::is_ent XML::Twig::Elt::is_ent
0000s0sXML::Twig::Elt::::is_first_child XML::Twig::Elt::is_first_child
0000s0sXML::Twig::Elt::::is_last_child XML::Twig::Elt::is_last_child
0000s0sXML::Twig::Elt::::is_pcdata XML::Twig::Elt::is_pcdata
0000s0sXML::Twig::Elt::::is_pi XML::Twig::Elt::is_pi
0000s0sXML::Twig::Elt::::is_text XML::Twig::Elt::is_text
0000s0sXML::Twig::Elt::::last_child XML::Twig::Elt::last_child
0000s0sXML::Twig::Elt::::last_child_matches XML::Twig::Elt::last_child_matches
0000s0sXML::Twig::Elt::::last_child_text XML::Twig::Elt::last_child_text
0000s0sXML::Twig::Elt::::last_child_trimmed_text XML::Twig::Elt::last_child_trimmed_text
0000s0sXML::Twig::Elt::::last_descendant XML::Twig::Elt::last_descendant
0000s0sXML::Twig::Elt::::latt XML::Twig::Elt::latt
0000s0sXML::Twig::Elt::::lc_attnames XML::Twig::Elt::lc_attnames
0000s0sXML::Twig::Elt::::lclass XML::Twig::Elt::lclass
0000s0sXML::Twig::Elt::::le XML::Twig::Elt::le
0000s0sXML::Twig::Elt::::level XML::Twig::Elt::level
0000s0sXML::Twig::Elt::::local_name XML::Twig::Elt::local_name
0000s0sXML::Twig::Elt::::lt XML::Twig::Elt::lt
0000s0sXML::Twig::Elt::::mark XML::Twig::Elt::mark
0000s0sXML::Twig::Elt::::merge XML::Twig::Elt::merge
0000s0sXML::Twig::Elt::::merge_text XML::Twig::Elt::merge_text
0000s0sXML::Twig::Elt::::move XML::Twig::Elt::move
0000s0sXML::Twig::Elt::::move_att_to_class XML::Twig::Elt::move_att_to_class
0000s0sXML::Twig::Elt::::namespace XML::Twig::Elt::namespace
0000s0sXML::Twig::Elt::::next_elt_matches XML::Twig::Elt::next_elt_matches
0000s0sXML::Twig::Elt::::next_elt_text XML::Twig::Elt::next_elt_text
0000s0sXML::Twig::Elt::::next_elt_trimmed_text XML::Twig::Elt::next_elt_trimmed_text
0000s0sXML::Twig::Elt::::next_n_elt XML::Twig::Elt::next_n_elt
0000s0sXML::Twig::Elt::::next_sibling_matches XML::Twig::Elt::next_sibling_matches
0000s0sXML::Twig::Elt::::next_sibling_text XML::Twig::Elt::next_sibling_text
0000s0sXML::Twig::Elt::::next_sibling_trimmed_text XML::Twig::Elt::next_sibling_trimmed_text
0000s0sXML::Twig::Elt::::next_siblings XML::Twig::Elt::next_siblings
0000s0sXML::Twig::Elt::::normalize XML::Twig::Elt::normalize
0000s0sXML::Twig::Elt::::ns_prefix XML::Twig::Elt::ns_prefix
0000s0sXML::Twig::Elt::::output_filter XML::Twig::Elt::output_filter
0000s0sXML::Twig::Elt::::output_text_filter XML::Twig::Elt::output_text_filter
0000s0sXML::Twig::Elt::::parent XML::Twig::Elt::parent
0000s0sXML::Twig::Elt::::parent_matches XML::Twig::Elt::parent_matches
0000s0sXML::Twig::Elt::::parent_text XML::Twig::Elt::parent_text
0000s0sXML::Twig::Elt::::parent_trimmed_text XML::Twig::Elt::parent_trimmed_text
0000s0sXML::Twig::Elt::::parse XML::Twig::Elt::parse
0000s0sXML::Twig::Elt::::paste XML::Twig::Elt::paste
0000s0sXML::Twig::Elt::::paste_after XML::Twig::Elt::paste_after
0000s0sXML::Twig::Elt::::paste_before XML::Twig::Elt::paste_before
0000s0sXML::Twig::Elt::::paste_first_child XML::Twig::Elt::paste_first_child
0000s0sXML::Twig::Elt::::paste_last_child XML::Twig::Elt::paste_last_child
0000s0sXML::Twig::Elt::::paste_within XML::Twig::Elt::paste_within
0000s0sXML::Twig::Elt::::path XML::Twig::Elt::path
0000s0sXML::Twig::Elt::::pcdata XML::Twig::Elt::pcdata
0000s0sXML::Twig::Elt::::pcdata_xml_string XML::Twig::Elt::pcdata_xml_string
0000s0sXML::Twig::Elt::::pi_string XML::Twig::Elt::pi_string
0000s0sXML::Twig::Elt::::pos XML::Twig::Elt::pos
0000s0sXML::Twig::Elt::::preceding_elt XML::Twig::Elt::preceding_elt
0000s0sXML::Twig::Elt::::preceding_elts XML::Twig::Elt::preceding_elts
0000s0sXML::Twig::Elt::::prefix XML::Twig::Elt::prefix
0000s0sXML::Twig::Elt::::prev_elt XML::Twig::Elt::prev_elt
0000s0sXML::Twig::Elt::::prev_elt_matches XML::Twig::Elt::prev_elt_matches
0000s0sXML::Twig::Elt::::prev_elt_text XML::Twig::Elt::prev_elt_text
0000s0sXML::Twig::Elt::::prev_elt_trimmed_text XML::Twig::Elt::prev_elt_trimmed_text
0000s0sXML::Twig::Elt::::prev_sibling XML::Twig::Elt::prev_sibling
0000s0sXML::Twig::Elt::::prev_sibling_matches XML::Twig::Elt::prev_sibling_matches
0000s0sXML::Twig::Elt::::prev_sibling_text XML::Twig::Elt::prev_sibling_text
0000s0sXML::Twig::Elt::::prev_sibling_trimmed_text XML::Twig::Elt::prev_sibling_trimmed_text
0000s0sXML::Twig::Elt::::prev_siblings XML::Twig::Elt::prev_siblings
0000s0sXML::Twig::Elt::::print XML::Twig::Elt::print
0000s0sXML::Twig::Elt::::print_to_file XML::Twig::Elt::print_to_file
0000s0sXML::Twig::Elt::::purge XML::Twig::Elt::purge
0000s0sXML::Twig::Elt::::remove_cdata XML::Twig::Elt::remove_cdata
0000s0sXML::Twig::Elt::::remove_class XML::Twig::Elt::remove_class
0000s0sXML::Twig::Elt::::replace XML::Twig::Elt::replace
0000s0sXML::Twig::Elt::::replace_with XML::Twig::Elt::replace_with
0000s0sXML::Twig::Elt::::reset_cond_cache XML::Twig::Elt::reset_cond_cache
0000s0sXML::Twig::Elt::::safe_print_to_file XML::Twig::Elt::safe_print_to_file
0000s0sXML::Twig::Elt::::set_asis XML::Twig::Elt::set_asis
0000s0sXML::Twig::Elt::::set_att XML::Twig::Elt::set_att
0000s0sXML::Twig::Elt::::set_cdata XML::Twig::Elt::set_cdata
0000s0sXML::Twig::Elt::::set_class XML::Twig::Elt::set_class
0000s0sXML::Twig::Elt::::set_comment XML::Twig::Elt::set_comment
0000s0sXML::Twig::Elt::::set_content XML::Twig::Elt::set_content
0000s0sXML::Twig::Elt::::set_data XML::Twig::Elt::set_data
0000s0sXML::Twig::Elt::::set_empty XML::Twig::Elt::set_empty
0000s0sXML::Twig::Elt::::set_empty_tag_style XML::Twig::Elt::set_empty_tag_style
0000s0sXML::Twig::Elt::::set_ent XML::Twig::Elt::set_ent
0000s0sXML::Twig::Elt::::set_extra_data XML::Twig::Elt::set_extra_data
0000s0sXML::Twig::Elt::::set_field XML::Twig::Elt::set_field
0000s0sXML::Twig::Elt::::set_first_child XML::Twig::Elt::set_first_child
0000s0sXML::Twig::Elt::::set_global_state XML::Twig::Elt::set_global_state
0000s0sXML::Twig::Elt::::set_id XML::Twig::Elt::set_id
0000s0sXML::Twig::Elt::::set_id_seed XML::Twig::Elt::set_id_seed
0000s0sXML::Twig::Elt::::set_indent XML::Twig::Elt::set_indent
0000s0sXML::Twig::Elt::::set_inner_html XML::Twig::Elt::set_inner_html
0000s0sXML::Twig::Elt::::set_inner_xml XML::Twig::Elt::set_inner_xml
0000s0sXML::Twig::Elt::::set_last_child XML::Twig::Elt::set_last_child
0000s0sXML::Twig::Elt::::set_next_sibling XML::Twig::Elt::set_next_sibling
0000s0sXML::Twig::Elt::::set_not_asis XML::Twig::Elt::set_not_asis
0000s0sXML::Twig::Elt::::set_not_empty XML::Twig::Elt::set_not_empty
0000s0sXML::Twig::Elt::::set_ns_as_default XML::Twig::Elt::set_ns_as_default
0000s0sXML::Twig::Elt::::set_ns_decl XML::Twig::Elt::set_ns_decl
0000s0sXML::Twig::Elt::::set_outer_xml XML::Twig::Elt::set_outer_xml
0000s0sXML::Twig::Elt::::set_parent XML::Twig::Elt::set_parent
0000s0sXML::Twig::Elt::::set_pcdata XML::Twig::Elt::set_pcdata
0000s0sXML::Twig::Elt::::set_pi XML::Twig::Elt::set_pi
0000s0sXML::Twig::Elt::::set_pretty_print XML::Twig::Elt::set_pretty_print
0000s0sXML::Twig::Elt::::set_prev_sibling XML::Twig::Elt::set_prev_sibling
0000s0sXML::Twig::Elt::::set_replaced_ents XML::Twig::Elt::set_replaced_ents
0000s0sXML::Twig::Elt::::set_tag_class XML::Twig::Elt::set_tag_class
0000s0sXML::Twig::Elt::::set_target XML::Twig::Elt::set_target
0000s0sXML::Twig::Elt::::set_text XML::Twig::Elt::set_text
0000s0sXML::Twig::Elt::::set_twig_current XML::Twig::Elt::set_twig_current
0000s0sXML::Twig::Elt::::set_wrap XML::Twig::Elt::set_wrap
0000s0sXML::Twig::Elt::::sibling XML::Twig::Elt::sibling
0000s0sXML::Twig::Elt::::sibling_text XML::Twig::Elt::sibling_text
0000s0sXML::Twig::Elt::::siblings XML::Twig::Elt::siblings
0000s0sXML::Twig::Elt::::simplify XML::Twig::Elt::simplify
0000s0sXML::Twig::Elt::::sort_children XML::Twig::Elt::sort_children
0000s0sXML::Twig::Elt::::sort_children_on_att XML::Twig::Elt::sort_children_on_att
0000s0sXML::Twig::Elt::::sort_children_on_field XML::Twig::Elt::sort_children_on_field
0000s0sXML::Twig::Elt::::sort_children_on_value XML::Twig::Elt::sort_children_on_value
0000s0sXML::Twig::Elt::::split XML::Twig::Elt::split
0000s0sXML::Twig::Elt::::split_at XML::Twig::Elt::split_at
0000s0sXML::Twig::Elt::::sprint XML::Twig::Elt::sprint
0000s0sXML::Twig::Elt::::start_tag XML::Twig::Elt::start_tag
0000s0sXML::Twig::Elt::::strip_att XML::Twig::Elt::strip_att
0000s0sXML::Twig::Elt::::subs_text XML::Twig::Elt::subs_text
0000s0sXML::Twig::Elt::::suffix XML::Twig::Elt::suffix
0000s0sXML::Twig::Elt::::tag_to_class XML::Twig::Elt::tag_to_class
0000s0sXML::Twig::Elt::::tag_to_div XML::Twig::Elt::tag_to_div
0000s0sXML::Twig::Elt::::tag_to_span XML::Twig::Elt::tag_to_span
0000s0sXML::Twig::Elt::::target XML::Twig::Elt::target
0000s0sXML::Twig::Elt::::text_only XML::Twig::Elt::text_only
0000s0sXML::Twig::Elt::::toSAX1 XML::Twig::Elt::toSAX1
0000s0sXML::Twig::Elt::::toSAX2 XML::Twig::Elt::toSAX2
0000s0sXML::Twig::Elt::::trim XML::Twig::Elt::trim
0000s0sXML::Twig::Elt::::trimmed_text XML::Twig::Elt::trimmed_text
0000s0sXML::Twig::Elt::::wrap_children XML::Twig::Elt::wrap_children
0000s0sXML::Twig::Elt::::wrap_in XML::Twig::Elt::wrap_in
0000s0sXML::Twig::Elt::::xml_string XML::Twig::Elt::xml_string
0000s0sXML::Twig::Elt::::xml_text XML::Twig::Elt::xml_text
0000s0sXML::Twig::Elt::::xml_text_only XML::Twig::Elt::xml_text_only
0000s0sXML::Twig::Elt::::xpath XML::Twig::Elt::xpath
0000s0sXML::Twig::Entity::::_dump XML::Twig::Entity::_dump
0000s0sXML::Twig::Entity::::_quoted_val XML::Twig::Entity::_quoted_val
0000s0sXML::Twig::Entity::::name XML::Twig::Entity::name
0000s0sXML::Twig::Entity::::ndata XML::Twig::Entity::ndata
0000s0sXML::Twig::Entity::::new XML::Twig::Entity::new
0000s0sXML::Twig::Entity::::param XML::Twig::Entity::param
0000s0sXML::Twig::Entity::::print XML::Twig::Entity::print
0000s0sXML::Twig::Entity::::pubid XML::Twig::Entity::pubid
0000s0sXML::Twig::Entity::::sprint XML::Twig::Entity::sprint
0000s0sXML::Twig::Entity::::sysid XML::Twig::Entity::sysid
0000s0sXML::Twig::Entity::::text XML::Twig::Entity::text
0000s0sXML::Twig::Entity::::val XML::Twig::Entity::val
0000s0sXML::Twig::Entity_list::::_add_list XML::Twig::Entity_list::_add_list
0000s0sXML::Twig::Entity_list::::add XML::Twig::Entity_list::add
0000s0sXML::Twig::Entity_list::::add_new_ent XML::Twig::Entity_list::add_new_ent
0000s0sXML::Twig::Entity_list::::delete XML::Twig::Entity_list::delete
0000s0sXML::Twig::Entity_list::::ent XML::Twig::Entity_list::ent
0000s0sXML::Twig::Entity_list::::entity_names XML::Twig::Entity_list::entity_names
0000s0sXML::Twig::Entity_list::::list XML::Twig::Entity_list::list
0000s0sXML::Twig::Entity_list::::print XML::Twig::Entity_list::print
0000s0sXML::Twig::Entity_list::::text XML::Twig::Entity_list::text
0000s0sXML::Twig::Notation::::_dump XML::Twig::Notation::_dump
0000s0sXML::Twig::Notation::::_quoted_val XML::Twig::Notation::_quoted_val
0000s0sXML::Twig::Notation::::base XML::Twig::Notation::base
0000s0sXML::Twig::Notation::::name XML::Twig::Notation::name
0000s0sXML::Twig::Notation::::new XML::Twig::Notation::new
0000s0sXML::Twig::Notation::::print XML::Twig::Notation::print
0000s0sXML::Twig::Notation::::pubid XML::Twig::Notation::pubid
0000s0sXML::Twig::Notation::::sysid XML::Twig::Notation::sysid
0000s0sXML::Twig::Notation::::text XML::Twig::Notation::text
0000s0sXML::Twig::Notation_list::::_add_listXML::Twig::Notation_list::_add_list
0000s0sXML::Twig::Notation_list::::addXML::Twig::Notation_list::add
0000s0sXML::Twig::Notation_list::::add_new_notationXML::Twig::Notation_list::add_new_notation
0000s0sXML::Twig::Notation_list::::deleteXML::Twig::Notation_list::delete
0000s0sXML::Twig::Notation_list::::listXML::Twig::Notation_list::list
0000s0sXML::Twig::Notation_list::::notationXML::Twig::Notation_list::notation
0000s0sXML::Twig::Notation_list::::notation_namesXML::Twig::Notation_list::notation_names
0000s0sXML::Twig::Notation_list::::printXML::Twig::Notation_list::print
0000s0sXML::Twig::Notation_list::::textXML::Twig::Notation_list::text
0000s0sXML::Twig::::_DTD_toSAX XML::Twig::_DTD_toSAX
0000s0sXML::Twig::::_XmlUtf8Decode XML::Twig::_XmlUtf8Decode
0000s0sXML::Twig::::__ANON__[:1183] XML::Twig::__ANON__[:1183]
0000s0sXML::Twig::::__ANON__[:1415] XML::Twig::__ANON__[:1415]
0000s0sXML::Twig::::__ANON__[:1591] XML::Twig::__ANON__[:1591]
0000s0sXML::Twig::::__ANON__[:1607] XML::Twig::__ANON__[:1607]
0000s0sXML::Twig::::__ANON__[:2115] XML::Twig::__ANON__[:2115]
0000s0sXML::Twig::::__ANON__[:278] XML::Twig::__ANON__[:278]
0000s0sXML::Twig::::__ANON__[:297] XML::Twig::__ANON__[:297]
0000s0sXML::Twig::::__ANON__[:313] XML::Twig::__ANON__[:313]
0000s0sXML::Twig::::__ANON__[:332] XML::Twig::__ANON__[:332]
0000s0sXML::Twig::::__ANON__[:3599] XML::Twig::__ANON__[:3599]
0000s0sXML::Twig::::__ANON__[:3629] XML::Twig::__ANON__[:3629]
0000s0sXML::Twig::::__ANON__[:3657] XML::Twig::__ANON__[:3657]
0000s0sXML::Twig::::__ANON__[:3856] XML::Twig::__ANON__[:3856]
0000s0sXML::Twig::::__ANON__[:4358] XML::Twig::__ANON__[:4358]
0000s0sXML::Twig::::__ANON__[:4368] XML::Twig::__ANON__[:4368]
0000s0sXML::Twig::::__ANON__[:505] XML::Twig::__ANON__[:505]
0000s0sXML::Twig::::__ANON__[:544] XML::Twig::__ANON__[:544]
0000s0sXML::Twig::::__ANON__[:814] XML::Twig::__ANON__[:814]
0000s0sXML::Twig::::_add_cpi_outside_of_root XML::Twig::_add_cpi_outside_of_root
0000s0sXML::Twig::::_allow_use XML::Twig::_allow_use
0000s0sXML::Twig::::_as_XML XML::Twig::_as_XML
0000s0sXML::Twig::::_based_filename XML::Twig::_based_filename
0000s0sXML::Twig::::_check_xml XML::Twig::_check_xml
0000s0sXML::Twig::::_children XML::Twig::_children
0000s0sXML::Twig::::_comment_elt_handler XML::Twig::_comment_elt_handler
0000s0sXML::Twig::::_comment_text_handler XML::Twig::_comment_text_handler
0000s0sXML::Twig::::_croak XML::Twig::_croak
0000s0sXML::Twig::::_disallow_use XML::Twig::_disallow_use
0000s0sXML::Twig::::_dump XML::Twig::_dump
0000s0sXML::Twig::::_encoding_filter XML::Twig::_encoding_filter
0000s0sXML::Twig::::_encoding_from_meta XML::Twig::_encoding_from_meta
0000s0sXML::Twig::::_fill_default_atts XML::Twig::_fill_default_atts
0000s0sXML::Twig::::_first_n XML::Twig::_first_n
0000s0sXML::Twig::::_fix_xml XML::Twig::_fix_xml
0000s0sXML::Twig::::_flush_toSAX XML::Twig::_flush_toSAX
0000s0sXML::Twig::::_html2xml XML::Twig::_html2xml
0000s0sXML::Twig::::_indent_xhtml XML::Twig::_indent_xhtml
0000s0sXML::Twig::::_is_fh XML::Twig::_is_fh
0000s0sXML::Twig::::_is_well_formed_xml XML::Twig::_is_well_formed_xml
0000s0sXML::Twig::::_leading_cpi XML::Twig::_leading_cpi
0000s0sXML::Twig::::_level_in_stack XML::Twig::_level_in_stack
0000s0sXML::Twig::::_output_ignored XML::Twig::_output_ignored
0000s0sXML::Twig::::_parse_as_xml_or_html XML::Twig::_parse_as_xml_or_html
0000s0sXML::Twig::::_parse_inplace XML::Twig::_parse_inplace
0000s0sXML::Twig::::_parse_predicate_in_handler XML::Twig::_parse_predicate_in_handler
0000s0sXML::Twig::::_parse_start_tag XML::Twig::_parse_start_tag
0000s0sXML::Twig::::_parseurl XML::Twig::_parseurl
0000s0sXML::Twig::::_pass_url_content XML::Twig::_pass_url_content
0000s0sXML::Twig::::_pi_elt_handlers XML::Twig::_pi_elt_handlers
0000s0sXML::Twig::::_pi_text_handler XML::Twig::_pi_text_handler
0000s0sXML::Twig::::_pretty_print_styles XML::Twig::_pretty_print_styles
0000s0sXML::Twig::::_prolog_toSAX XML::Twig::_prolog_toSAX
0000s0sXML::Twig::::_reset_twig XML::Twig::_reset_twig
0000s0sXML::Twig::::_reset_twig_after_error XML::Twig::_reset_twig_after_error
0000s0sXML::Twig::::_return_debug_handler XML::Twig::_return_debug_handler
0000s0sXML::Twig::::_set_debug_handler XML::Twig::_set_debug_handler
0000s0sXML::Twig::::_set_weakrefs XML::Twig::_set_weakrefs
0000s0sXML::Twig::::_slurp XML::Twig::_slurp
0000s0sXML::Twig::::_slurp_fh XML::Twig::_slurp_fh
0000s0sXML::Twig::::_slurp_uri XML::Twig::_slurp_uri
0000s0sXML::Twig::::_space_policy XML::Twig::_space_policy
0000s0sXML::Twig::::_this_perl XML::Twig::_this_perl
0000s0sXML::Twig::::_tidy_html XML::Twig::_tidy_html
0000s0sXML::Twig::::_toSAX XML::Twig::_toSAX
0000s0sXML::Twig::::_to_utf8 XML::Twig::_to_utf8
0000s0sXML::Twig::::_trailing_cpi XML::Twig::_trailing_cpi
0000s0sXML::Twig::::_trailing_cpi_text XML::Twig::_trailing_cpi_text
0000s0sXML::Twig::::_trigger_tdh XML::Twig::_trigger_tdh
0000s0sXML::Twig::::_twig_attlist XML::Twig::_twig_attlist
0000s0sXML::Twig::::_twig_cdataend XML::Twig::_twig_cdataend
0000s0sXML::Twig::::_twig_cdatastart XML::Twig::_twig_cdatastart
0000s0sXML::Twig::::_twig_comment XML::Twig::_twig_comment
0000s0sXML::Twig::::_twig_doctype XML::Twig::_twig_doctype
0000s0sXML::Twig::::_twig_doctype_fin_print XML::Twig::_twig_doctype_fin_print
0000s0sXML::Twig::::_twig_element XML::Twig::_twig_element
0000s0sXML::Twig::::_twig_entity XML::Twig::_twig_entity
0000s0sXML::Twig::::_twig_extern_ent XML::Twig::_twig_extern_ent
0000s0sXML::Twig::::_twig_ignore_end XML::Twig::_twig_ignore_end
0000s0sXML::Twig::::_twig_ignore_start XML::Twig::_twig_ignore_start
0000s0sXML::Twig::::_twig_insert_ent XML::Twig::_twig_insert_ent
0000s0sXML::Twig::::_twig_notation XML::Twig::_twig_notation
0000s0sXML::Twig::::_twig_pi XML::Twig::_twig_pi
0000s0sXML::Twig::::_twig_pi_check_roots XML::Twig::_twig_pi_check_roots
0000s0sXML::Twig::::_twig_pi_comment XML::Twig::_twig_pi_comment
0000s0sXML::Twig::::_twig_print XML::Twig::_twig_print
0000s0sXML::Twig::::_twig_print_check_doctype XML::Twig::_twig_print_check_doctype
0000s0sXML::Twig::::_twig_print_doctype XML::Twig::_twig_print_doctype
0000s0sXML::Twig::::_twig_print_end_original XML::Twig::_twig_print_end_original
0000s0sXML::Twig::::_twig_print_entity XML::Twig::_twig_print_entity
0000s0sXML::Twig::::_twig_print_original XML::Twig::_twig_print_original
0000s0sXML::Twig::::_twig_print_original_check_doctype XML::Twig::_twig_print_original_check_doctype
0000s0sXML::Twig::::_twig_print_original_default XML::Twig::_twig_print_original_default
0000s0sXML::Twig::::_twig_print_original_doctype XML::Twig::_twig_print_original_doctype
0000s0sXML::Twig::::_twig_stop_storing_internal_dtd XML::Twig::_twig_stop_storing_internal_dtd
0000s0sXML::Twig::::_twig_store_internal_dtd XML::Twig::_twig_store_internal_dtd
0000s0sXML::Twig::::_unescape_cdata XML::Twig::_unescape_cdata
0000s0sXML::Twig::::_use_perlio XML::Twig::_use_perlio
0000s0sXML::Twig::::_warn_debug_handler XML::Twig::_warn_debug_handler
0000s0sXML::Twig::::_weakrefs XML::Twig::_weakrefs
0000s0sXML::Twig::::_xml_escape XML::Twig::_xml_escape
0000s0sXML::Twig::::_xml_parser_encodings XML::Twig::_xml_parser_encodings
0000s0sXML::Twig::::_xmldecl_toSAX XML::Twig::_xmldecl_toSAX
0000s0sXML::Twig::::active_twig XML::Twig::active_twig
0000s0sXML::Twig::::add_options XML::Twig::add_options
0000s0sXML::Twig::::add_stylesheet XML::Twig::add_stylesheet
0000s0sXML::Twig::::att_accessors XML::Twig::att_accessors
0000s0sXML::Twig::::change_gi XML::Twig::change_gi
0000s0sXML::Twig::::child XML::Twig::child
0000s0sXML::Twig::::children XML::Twig::children
0000s0sXML::Twig::::dispose XML::Twig::dispose
0000s0sXML::Twig::::do_not_escape_gt XML::Twig::do_not_escape_gt
0000s0sXML::Twig::::doctype XML::Twig::doctype
0000s0sXML::Twig::::doctype_name XML::Twig::doctype_name
0000s0sXML::Twig::::dtd XML::Twig::dtd
0000s0sXML::Twig::::dtd_print XML::Twig::dtd_print
0000s0sXML::Twig::::dtd_text XML::Twig::dtd_text
0000s0sXML::Twig::::elt_accessors XML::Twig::elt_accessors
0000s0sXML::Twig::::elt_id XML::Twig::elt_id
0000s0sXML::Twig::::encode_convert XML::Twig::encode_convert
0000s0sXML::Twig::::encoding XML::Twig::encoding
0000s0sXML::Twig::::entity XML::Twig::entity
0000s0sXML::Twig::::entity_list XML::Twig::entity_list
0000s0sXML::Twig::::entity_names XML::Twig::entity_names
0000s0sXML::Twig::::escape_gt XML::Twig::escape_gt
0000s0sXML::Twig::::field_accessors XML::Twig::field_accessors
0000s0sXML::Twig::::findvalue XML::Twig::findvalue
0000s0sXML::Twig::::findvalues XML::Twig::findvalues
0000s0sXML::Twig::::finish XML::Twig::finish
0000s0sXML::Twig::::finish_now XML::Twig::finish_now
0000s0sXML::Twig::::finish_print XML::Twig::finish_print
0000s0sXML::Twig::::first_elt XML::Twig::first_elt
0000s0sXML::Twig::::flush XML::Twig::flush
0000s0sXML::Twig::::flush_toSAX1 XML::Twig::flush_toSAX1
0000s0sXML::Twig::::flush_toSAX2 XML::Twig::flush_toSAX2
0000s0sXML::Twig::::flush_up_to XML::Twig::flush_up_to
0000s0sXML::Twig::::getChildNodes XML::Twig::getChildNodes
0000s0sXML::Twig::::getParentNode XML::Twig::getParentNode
0000s0sXML::Twig::::getRootNode XML::Twig::getRootNode
0000s0sXML::Twig::::global_state XML::Twig::global_state
0000s0sXML::Twig::::html_encode XML::Twig::html_encode
0000s0sXML::Twig::::iconv_convert XML::Twig::iconv_convert
0000s0sXML::Twig::::ignore XML::Twig::ignore
0000s0sXML::Twig::::index XML::Twig::index
0000s0sXML::Twig::::internal_subset XML::Twig::internal_subset
0000s0sXML::Twig::::keep_atts_order XML::Twig::keep_atts_order
0000s0sXML::Twig::::last_elt XML::Twig::last_elt
0000s0sXML::Twig::::latin1 XML::Twig::latin1
0000s0sXML::Twig::::model XML::Twig::model
0000s0sXML::Twig::::next_n_elt XML::Twig::next_n_elt
0000s0sXML::Twig::::normalize XML::Twig::normalize
0000s0sXML::Twig::::notation XML::Twig::notation
0000s0sXML::Twig::::notation_list XML::Twig::notation_list
0000s0sXML::Twig::::notation_names XML::Twig::notation_names
0000s0sXML::Twig::::nparse XML::Twig::nparse
0000s0sXML::Twig::::nparse_e XML::Twig::nparse_e
0000s0sXML::Twig::::nparse_pp XML::Twig::nparse_pp
0000s0sXML::Twig::::nparse_ppe XML::Twig::nparse_ppe
0000s0sXML::Twig::::original_uri XML::Twig::original_uri
0000s0sXML::Twig::::output_encoding XML::Twig::output_encoding
0000s0sXML::Twig::::output_filter XML::Twig::output_filter
0000s0sXML::Twig::::output_text_filter XML::Twig::output_text_filter
0000s0sXML::Twig::::parse_html XML::Twig::parse_html
0000s0sXML::Twig::::parsefile XML::Twig::parsefile
0000s0sXML::Twig::::parsefile_html XML::Twig::parsefile_html
0000s0sXML::Twig::::parsefile_html_inplace XML::Twig::parsefile_html_inplace
0000s0sXML::Twig::::parsefile_inplace XML::Twig::parsefile_inplace
0000s0sXML::Twig::::parseurl XML::Twig::parseurl
0000s0sXML::Twig::::parseurl_html XML::Twig::parseurl_html
0000s0sXML::Twig::::path XML::Twig::path
0000s0sXML::Twig::::print XML::Twig::print
0000s0sXML::Twig::::print_prolog XML::Twig::print_prolog
0000s0sXML::Twig::::print_to_file XML::Twig::print_to_file
0000s0sXML::Twig::::prolog XML::Twig::prolog
0000s0sXML::Twig::::public_id XML::Twig::public_id
0000s0sXML::Twig::::purge_up_to XML::Twig::purge_up_to
0000s0sXML::Twig::::regexp2latin1 XML::Twig::regexp2latin1
0000s0sXML::Twig::::restore_global_state XML::Twig::restore_global_state
0000s0sXML::Twig::::safe_encode XML::Twig::safe_encode
0000s0sXML::Twig::::safe_encode_hex XML::Twig::safe_encode_hex
0000s0sXML::Twig::::safe_parse XML::Twig::safe_parse
0000s0sXML::Twig::::safe_parse_html XML::Twig::safe_parse_html
0000s0sXML::Twig::::safe_parsefile XML::Twig::safe_parsefile
0000s0sXML::Twig::::safe_parsefile_html XML::Twig::safe_parsefile_html
0000s0sXML::Twig::::safe_parseurl XML::Twig::safe_parseurl
0000s0sXML::Twig::::safe_parseurl_html XML::Twig::safe_parseurl_html
0000s0sXML::Twig::::safe_print_to_file XML::Twig::safe_print_to_file
0000s0sXML::Twig::::save_global_state XML::Twig::save_global_state
0000s0sXML::Twig::::setCharHandler XML::Twig::setCharHandler
0000s0sXML::Twig::::setEndTagHandler XML::Twig::setEndTagHandler
0000s0sXML::Twig::::setEndTagHandlers XML::Twig::setEndTagHandlers
0000s0sXML::Twig::::setIgnoreEltsHandler XML::Twig::setIgnoreEltsHandler
0000s0sXML::Twig::::setIgnoreEltsHandlers XML::Twig::setIgnoreEltsHandlers
0000s0sXML::Twig::::setStartTagHandler XML::Twig::setStartTagHandler
0000s0sXML::Twig::::setStartTagHandlers XML::Twig::setStartTagHandlers
0000s0sXML::Twig::::setTwigHandler XML::Twig::setTwigHandler
0000s0sXML::Twig::::set_doctype XML::Twig::set_doctype
0000s0sXML::Twig::::set_empty_tag_style XML::Twig::set_empty_tag_style
0000s0sXML::Twig::::set_encoding XML::Twig::set_encoding
0000s0sXML::Twig::::set_global_state XML::Twig::set_global_state
0000s0sXML::Twig::::set_id_seed XML::Twig::set_id_seed
0000s0sXML::Twig::::set_indent XML::Twig::set_indent
0000s0sXML::Twig::::set_input_filter XML::Twig::set_input_filter
0000s0sXML::Twig::::set_output_encoding XML::Twig::set_output_encoding
0000s0sXML::Twig::::set_pretty_print XML::Twig::set_pretty_print
0000s0sXML::Twig::::set_standalone XML::Twig::set_standalone
0000s0sXML::Twig::::set_xml_version XML::Twig::set_xml_version
0000s0sXML::Twig::::simplify XML::Twig::simplify
0000s0sXML::Twig::::sprint XML::Twig::sprint
0000s0sXML::Twig::::standalone XML::Twig::standalone
0000s0sXML::Twig::::subs_text XML::Twig::subs_text
0000s0sXML::Twig::::system_id XML::Twig::system_id
0000s0sXML::Twig::::toSAX1 XML::Twig::toSAX1
0000s0sXML::Twig::::toSAX2 XML::Twig::toSAX2
0000s0sXML::Twig::::trim XML::Twig::trim
0000s0sXML::Twig::::unicode_convert XML::Twig::unicode_convert
0000s0sXML::Twig::::xml_version XML::Twig::xml_version
0000s0sXML::Twig::::xmldecl XML::Twig::xmldecl
0000s0sXML::Twig::::xparse XML::Twig::xparse
0000s0smain::::CDATA main::CDATA
0000s0smain::::PCDATA main::PCDATA
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1217µs211µs
# spent 10µs (8+2) within Spreadsheet::ParseXLSX::BEGIN@1 which was called: # once (8µs+2µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 1
use strict;
# spent 10µs making 1 call to Spreadsheet::ParseXLSX::BEGIN@1 # spent 2µs making 1 call to strict::import
2229µs232µs
# spent 18µs (4+14) within Spreadsheet::ParseXLSX::BEGIN@2 which was called: # once (4µs+14µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 2
use warnings; # > perl 5.5
# spent 18µs making 1 call to Spreadsheet::ParseXLSX::BEGIN@2 # spent 14µs making 1 call to warnings::import
3
4# This is created in the caller's space
5# I realize (now!) that it's not clean, but it's been there for 10+ years...
6BEGIN
7
# spent 1µs within Spreadsheet::ParseXLSX::BEGIN@7 which was called: # once (1µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 9
{ sub ::PCDATA { '#PCDATA' } ## no critic (Subroutines::ProhibitNestedSubs);
8 sub ::CDATA { '#CDATA' } ## no critic (Subroutines::ProhibitNestedSubs);
918µs11µs}
# spent 1µs making 1 call to Spreadsheet::ParseXLSX::BEGIN@7
10
112106µs181µs
# spent 81µs within Spreadsheet::ParseXLSX::BEGIN@11.2 which was called: # once (81µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 11
use UNIVERSAL();
# spent 81µs making 1 call to Spreadsheet::ParseXLSX::BEGIN@11.2
12
13## if a sub returns a scalar, it better not bloody disappear in list context
14## no critic (Subroutines::ProhibitExplicitReturnUndef);
15
161300nsmy $perl_version;
17my $parser_version;
18
19######################################################################
20package XML::Twig;
21######################################################################
22
23112µsrequire 5.004;
24
25267µs2171µs
# spent 169µs (141+28) within XML::Twig::BEGIN@25 which was called: # once (141µs+28µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 25
use utf8; # > perl 5.5
# spent 169µs making 1 call to XML::Twig::BEGIN@25 # spent 2µs making 1 call to utf8::import
26
27220µs252µs
# spent 28µs (4+24) within XML::Twig::BEGIN@27 which was called: # once (4µs+24µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 27
use vars qw($VERSION @ISA %valid_option);
# spent 28µs making 1 call to XML::Twig::BEGIN@27 # spent 24µs making 1 call to vars::import
28
29215µs244µs
# spent 24µs (5+19) within XML::Twig::BEGIN@29 which was called: # once (5µs+19µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 29
use Carp;
# spent 24µs making 1 call to XML::Twig::BEGIN@29 # spent 19µs making 1 call to Exporter::import
30214µs28µs
# spent 8µs (7+700ns) within XML::Twig::BEGIN@30 which was called: # once (7µs+700ns) by Spreadsheet::ParseXLSX::BEGIN@15 at line 30
use File::Spec;
# spent 8µs making 1 call to XML::Twig::BEGIN@30 # spent 700ns making 1 call to UNIVERSAL::import
31214µs237µs
# spent 21µs (4+16) within XML::Twig::BEGIN@31 which was called: # once (4µs+16µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 31
use File::Basename;
# spent 21µs making 1 call to XML::Twig::BEGIN@31 # spent 16µs making 1 call to Exporter::import
32
33222µs216µs
# spent 10µs (4+6) within XML::Twig::BEGIN@33 which was called: # once (4µs+6µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 33
use Config; # to get perl's path name in case we need to know if perlio is available
# spent 10µs making 1 call to XML::Twig::BEGIN@33 # spent 6µs making 1 call to Config::import
34
3511µs*isa= *UNIVERSAL::isa;
36
37# flag, set to true if the weaken sub is available
382283µs223µs
# spent 14µs (4+9) within XML::Twig::BEGIN@38 which was called: # once (4µs+9µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 38
use vars qw( $weakrefs);
# spent 14µs making 1 call to XML::Twig::BEGIN@38 # spent 9µs making 1 call to vars::import
39
40# flag set to true if the version of expat seems to be 1.95.2, which has annoying bugs
41# wrt doctype handling. This is global for performance reasons.
421200nsmy $expat_1_95_2=0;
43
44# a slight non-xml mod: # is allowed as a first character
451200nsmy $REG_TAG_FIRST_LETTER;
46#$REG_TAG_FIRST_LETTER= q{(?:[^\W\d]|[:#_])}; # < perl 5.6 - does not work for leading non-ascii letters
471300ns$REG_TAG_FIRST_LETTER= q{(?:[[:alpha:]:#_])}; # >= perl 5.6
48
491200nsmy $REG_TAG_LETTER= q{(?:[\w_.-]*)};
50
51# a simple name (no colon)
521500nsmy $REG_NAME_TOKEN= qq{(?:$REG_TAG_FIRST_LETTER$REG_TAG_LETTER*)};
53
54# a tag name, possibly including namespace
551300nsmy $REG_NAME= qq{(?:(?:$REG_NAME_TOKEN:)?$REG_NAME_TOKEN)};
56
57# tag name (leading # allowed)
58# first line is for perl 5.005, second line for modern perl, that accept character classes
591200nsmy $REG_TAG_NAME=$REG_NAME;
60
61# name or wildcard (* or '') (leading # allowed)
621300nsmy $REG_NAME_W = qq{(?:$REG_NAME|[*])};
63
64# class and ids are deliberately permissive
651100nsmy $REG_NTOKEN_FIRST_LETTER;
66#$REG_NTOKEN_FIRST_LETTER= q{(?:[^\W\d]|[:_])}; # < perl 5.6 - does not work for leading non-ascii letters
671100ns$REG_NTOKEN_FIRST_LETTER= q{(?:[[:alpha:]:_])}; # >= perl 5.6
68
691200nsmy $REG_NTOKEN_LETTER= q{(?:[\w_:.-]*)};
70
711200nsmy $REG_NTOKEN= qq{(?:$REG_NTOKEN_FIRST_LETTER$REG_NTOKEN_LETTER*)};
721100nsmy $REG_CLASS = $REG_NTOKEN;
731100nsmy $REG_ID = $REG_NTOKEN;
74
75# allow <tag> #<tag> (private elt) * <tag>.<class> *.<class> <tag>#<id> *#<id>
761400nsmy $REG_TAG_PART= qq{(?:$REG_NAME_W(?:[.]$REG_CLASS|[#]$REG_ID)?|[.]$REG_CLASS)};
77
781200nsmy $REG_REGEXP = q{(?:/(?:[^\\/]|\\.)*/[eimsox]*)}; # regexp
791200nsmy $REG_MATCH = q{[!=]~}; # match (or not)
801100nsmy $REG_STRING = q{(?:"(?:[^\\"]|\\.)*"|'(?:[^\\']|\\.)*')}; # string (simple or double quoted)
811100nsmy $REG_NUMBER = q{(?:\d+(?:\.\d*)?|\.\d+)}; # number
821200nsmy $REG_VALUE = qq{(?:$REG_STRING|$REG_NUMBER)}; # value
831200nsmy $REG_OP = q{==|!=|>|<|>=|<=|eq|ne|lt|gt|le|ge|=}; # op
841100nsmy $REG_FUNCTION = q{(?:string|text)\(\s*\)};
851200nsmy $REG_STRING_ARG = qq{(?:string|text)\\(\\s*$REG_NAME_W\\s*\\)};
861100nsmy $REG_COMP = q{(?:>=|<=|!=|<|>|=)};
87
881200nsmy $REG_TAG_IN_PREDICATE= $REG_NAME_W . q{(?=\s*(?i:and\b|or\b|\]|$))};
89
90# keys in the context stack, chosen not to interfere with att names, even private (#-prefixed) ones
911100nsmy $ST_TAG = '##tag';
921100nsmy $ST_ELT = '##elt';
931100nsmy $ST_NS = '##ns' ;
94
95# used in the handler trigger code
961500nsmy $REG_NAKED_PREDICATE= qq{((?:"[^"]*"|'[^']*'|$REG_STRING_ARG|$REG_FUNCTION|\@$REG_NAME_W|$REG_MATCH\\s*$REG_REGEXP|[\\s\\d><=!()+.-]|(?i:and)|(?i:or)|$REG_TAG_IN_PREDICATE)*)};
971200nsmy $REG_PREDICATE= qq{\\[$REG_NAKED_PREDICATE\\]};
98
99# not all axis, only supported ones (in get_xpath)
10012µsmy @supported_axis= ( 'ancestor', 'ancestor-or-self', 'child', 'descendant', 'descendant-or-self',
101 'following', 'following-sibling', 'parent', 'preceding', 'preceding-sibling', 'self'
102 );
10311µsmy $REG_AXIS = "(?:" . join( '|', @supported_axis) .")";
104
105# only used in the "xpath"engine (for get_xpath/findnodes) for now
1061232µs2226µsmy $REG_PREDICATE_ALT = qr{\[(?:(?:string\(\s*\)|\@$REG_TAG_NAME)\s*$REG_MATCH\s*$REG_REGEXP\s*|[^\]]*)\]};
# spent 224µs making 1 call to CORE::regcomp # spent 2µs making 1 call to CORE::qr
107
108# used to convert XPath tests on strings to the perl equivalent
10912µsmy %PERL_ALPHA_TEST= ( '=' => ' eq ', '!=' => ' ne ', '>' => ' gt ', '>=' => ' ge ', '<' => ' lt ', '<=' => ' le ');
110
1111200nsmy( $FB_HTMLCREF, $FB_XMLCREF);
112
1131400nsmy $NO_WARNINGS= $perl_version >= 5.006 ? 'no warnings' : 'local $^W=0';
114
115# default namespaces, both ways
1161800nsmy %DEFAULT_NS= ( xml => "http://www.w3.org/XML/1998/namespace",
117 xmlns => "http://www.w3.org/2000/xmlns/",
118 );
11913µsmy %DEFAULT_URI2NS= map { $DEFAULT_NS{$_} => $_ } keys %DEFAULT_NS;
120
121# constants
1221100nsmy( $PCDATA, $CDATA, $PI, $COMMENT, $ENT, $ELT, $NOTATION, $TEXT, $ASIS, $EMPTY, $BUFSIZE);
123
124# used when an HTML doc only has a PUBLIC declaration, to generate the SYSTEM one
125# this should really be done by HTML::TreeBuilder, but as of HTML::TreeBuilder 4.2 it isn't
126# the various declarations are taken from http://en.wikipedia.org/wiki/Document_Type_Declaration
12714µsmy %HTML_DECL= ( "-//W3C//DTD HTML 4.0 Transitional//EN" => "http://www.w3.org/TR/REC-html40/loose.dtd",
128 "-//W3C//DTD HTML 4.01//EN" => "http://www.w3.org/TR/html4/strict.dtd",
129 "-//W3C//DTD HTML 4.01 Transitional//EN" => "http://www.w3.org/TR/html4/loose.dtd",
130 "-//W3C//DTD HTML 4.01 Frameset//EN" => "http://www.w3.org/TR/html4/frameset.dtd",
131 "-//W3C//DTD XHTML 1.0 Strict//EN" => "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd",
132 "-//W3C//DTD XHTML 1.0 Transitional//EN" => "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd",
133 "-//W3C//DTD XHTML 1.0 Frameset//EN" => "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd",
134 "-//W3C//DTD XHTML 1.1//EN" => "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd",
135 "-//W3C//DTD XHTML Basic 1.0//EN" => "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd",
136 "-//W3C//DTD XHTML Basic 1.1//EN" => "http://www.w3.org/TR/xhtml-basic/xhtml-basic11.dtd",
137 "-//WAPFORUM//DTD XHTML Mobile 1.0//EN" => "http://www.wapforum.org/DTD/xhtml-mobile10.dtd",
138 "-//WAPFORUM//DTD XHTML Mobile 1.1//EN" => "http://www.openmobilealliance.org/tech/DTD/xhtml-mobile11.dtd",
139 "-//WAPFORUM//DTD XHTML Mobile 1.2//EN" => "http://www.openmobilealliance.org/tech/DTD/xhtml-mobile12.dtd",
140 "-//W3C//DTD XHTML+RDFa 1.0//EN" => "http://www.w3.org/MarkUp/DTD/xhtml-rdfa-1.dtd",
141 );
142
1431100nsmy $DEFAULT_HTML_TYPE= "-//W3C//DTD HTML 4.0 Transitional//EN";
144
14512µs1800nsmy $SEP= qr/\s*(?:$|\|)/;
# spent 800ns making 1 call to CORE::qr
146
147BEGIN
148
# spent 240µs (79+162) within XML::Twig::BEGIN@148 which was called: # once (79µs+162µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 225
{
1491300ns$VERSION = '3.52';
150
1512307µs23.56ms
# spent 3.56ms (1.01+2.55) within XML::Twig::BEGIN@151 which was called: # once (1.01ms+2.55ms) by Spreadsheet::ParseXLSX::BEGIN@15 at line 151
use XML::Parser;
# spent 3.56ms making 1 call to XML::Twig::BEGIN@151 # spent 1µs making 1 call to UNIVERSAL::import
1521200nsmy $needVersion = '2.23';
15317µs1600ns($parser_version= $XML::Parser::VERSION)=~ s{_\d+}{}; # remove _<n> from version so numeric tests do not warn
# spent 600ns making 1 call to CORE::subst
15412µscroak "need at least XML::Parser version $needVersion" unless $parser_version >= $needVersion;
155
15612µs1200ns($perl_version= $])=~ s{_\d+}{};
# spent 200ns making 1 call to CORE::subst
157
1581400nsif( $perl_version >= 5.008)
159125µs { eval "use Encode qw( :all)"; ## no critic ProhibitStringyEval
# spent 11µs executing statements in string eval
# includes 7µs spent executing 1 call to 1 sub defined therein.
1601200ns $FB_XMLCREF = 0x0400; # Encode::FB_XMLCREF;
1611200ns $FB_HTMLCREF = 0x0200; # Encode::FB_HTMLCREF;
162 }
163
164# test whether we can use weak references
165# set local empty signal handler to trap error messages
16622µs{ local $SIG{__DIE__};
167112µs if( eval( 'require Scalar::Util') && defined( \&Scalar::Util::weaken))
# spent 2µs executing statements in string eval
16822µs113µs { import Scalar::Util( 'weaken'); $weakrefs= 1; }
# spent 13µs making 1 call to Exporter::import
169 elsif( eval( 'require WeakRef'))
170 { import WeakRef; $weakrefs= 1; }
171 else
172 { $weakrefs= 0; }
173}
174
17511µs1600nsimport XML::Twig::Elt;
# spent 600ns making 1 call to UNIVERSAL::import
17611µs1100nsimport XML::Twig::Entity;
# spent 100ns making 1 call to UNIVERSAL::import
17711µs1100nsimport XML::Twig::Entity_list;
# spent 100ns making 1 call to UNIVERSAL::import
178
179# used to store the gi's
180# should be set for each twig really, at least when there are several
181# the init ensures that special gi's are always the same
182
183# constants: element types
1841200ns$PCDATA = '#PCDATA';
1851100ns$CDATA = '#CDATA';
18610s$PI = '#PI';
1871100ns$COMMENT = '#COMMENT';
1881100ns$ENT = '#ENT';
18910s$NOTATION = '#NOTATION';
190
191# element classes
1921100ns$ELT = '#ELT';
1931100ns$TEXT = '#TEXT';
194
195# element properties
1961100ns$ASIS = '#ASIS';
1971100ns$EMPTY = '#EMPTY';
198
199# used in parseurl to set the buffer size to the same size as in XML::Parser::Expat
2001100ns$BUFSIZE = 32768;
201
202
203# gi => index
20412µs%XML::Twig::gi2index=( '', 0, $PCDATA => 1, $CDATA => 2, $PI => 3, $COMMENT => 4, $ENT => 5);
205# list of gi's
2061700ns@XML::Twig::index2gi=( '', $PCDATA, $CDATA, $PI, $COMMENT, $ENT);
207
208# gi's under this value are special
2091300ns$XML::Twig::SPECIAL_GI= @XML::Twig::index2gi;
210
21111µs%XML::Twig::base_ent= ( '>' => '&gt;', '<' => '&lt;', '&' => '&amp;', "'" => '&apos;', '"' => '&quot;',);
21243µsforeach my $c ( "\n", "\r", "\t") { $XML::Twig::base_ent{$c}= sprintf( "&#x%02x;", ord( $c)); }
213
214# now set some aliases
2151600ns*find_nodes = *get_xpath; # same as XML::XPath
2161200ns*findnodes = *get_xpath; # same as XML::LibXML
2171100ns*getElementsByTagName = *descendants;
2181100ns*descendants_or_self = *descendants; # valid in XML::Twig, not in XML::Twig::Elt
2191100ns*find_by_tag_name = *descendants;
2201100ns*getElementById = *elt_id;
2211100ns*getEltById = *elt_id;
2221100ns*toString = *sprint;
22312µs*create_accessors = *att_accessors;
224
2251489µs1240µs}
# spent 240µs making 1 call to XML::Twig::BEGIN@148
226
22718µs@ISA = qw(XML::Parser);
228
229# fake gi's used in twig_handlers and start_tag_handlers
2301200nsmy $ALL = '_all_'; # the associated function is always called
2311200nsmy $DEFAULT= '_default_'; # the function is called if no other handler has been
232
233# some defaults
2341100nsmy $COMMENTS_DEFAULT= 'keep';
2351200nsmy $PI_DEFAULT = 'keep';
236
237
238# handlers used in regular mode
23914µsmy %twig_handlers=( Start => \&_twig_start,
240 End => \&_twig_end,
241 Char => \&_twig_char,
242 Entity => \&_twig_entity,
243 Notation => \&_twig_notation,
244 XMLDecl => \&_twig_xmldecl,
245 Doctype => \&_twig_doctype,
246 Element => \&_twig_element,
247 Attlist => \&_twig_attlist,
248 CdataStart => \&_twig_cdatastart,
249 CdataEnd => \&_twig_cdataend,
250 Proc => \&_twig_pi,
251 Comment => \&_twig_comment,
252 Default => \&_twig_default,
253 ExternEnt => \&_twig_extern_ent,
254 );
255
256# handlers used when twig_roots is used and we are outside of the roots
257my %twig_handlers_roots=
258 ( Start => \&_twig_start_check_roots,
259 End => \&_twig_end_check_roots,
260 Doctype => \&_twig_doctype,
261 Char => undef, Entity => undef, XMLDecl => \&_twig_xmldecl,
262 Element => undef, Attlist => undef, CdataStart => undef,
263 CdataEnd => undef, Proc => undef, Comment => undef,
264 Proc => \&_twig_pi_check_roots,
26513µs
# spent 2µs within XML::Twig::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:265] which was called: # once (2µs+0s) by XML::Parser::Expat::ParseString at line 486 of XML/Parser/Expat.pm
Default => sub {}, # hack needed for XML::Parser 2.27
26614µs ExternEnt => \&_twig_extern_ent,
267 );
268
269# handlers used when twig_roots and print_outside_roots are used and we are
270# outside of the roots
271my %twig_handlers_roots_print_2_30=
272 ( Start => \&_twig_start_check_roots,
273 End => \&_twig_end_check_roots,
274 Char => \&_twig_print,
275 Entity => \&_twig_print_entity,
276 ExternEnt => \&_twig_print_entity,
277 DoctypeFin => \&_twig_doctype_fin_print,
278 XMLDecl => sub { _twig_xmldecl( @_); _twig_print( @_); },
27914µs Doctype => \&_twig_print_doctype, # because recognized_string is broken here
280 # Element => \&_twig_print, Attlist => \&_twig_print,
281 CdataStart => \&_twig_print, CdataEnd => \&_twig_print,
282 Proc => \&_twig_pi_check_roots, Comment => \&_twig_print,
283 Default => \&_twig_print_check_doctype,
284 ExternEnt => \&_twig_extern_ent,
285 );
286
287# handlers used when twig_roots, print_outside_roots and keep_encoding are used
288# and we are outside of the roots
289my %twig_handlers_roots_print_original_2_30=
290 ( Start => \&_twig_start_check_roots,
291 End => \&_twig_end_check_roots,
292 Char => \&_twig_print_original,
293 # I have no idea why I should not be using this handler!
294 Entity => \&_twig_print_entity,
295 ExternEnt => \&_twig_print_entity,
296 DoctypeFin => \&_twig_doctype_fin_print,
297 XMLDecl => sub { _twig_xmldecl( @_); _twig_print_original( @_) },
29813µs Doctype => \&_twig_print_original_doctype, # because original_string is broken here
299 Element => \&_twig_print_original, Attlist => \&_twig_print_original,
300 CdataStart => \&_twig_print_original, CdataEnd => \&_twig_print_original,
301 Proc => \&_twig_pi_check_roots, Comment => \&_twig_print_original,
302 Default => \&_twig_print_original_check_doctype,
303 );
304
305# handlers used when twig_roots and print_outside_roots are used and we are
306# outside of the roots
307my %twig_handlers_roots_print_2_27=
308 ( Start => \&_twig_start_check_roots,
309 End => \&_twig_end_check_roots,
310 Char => \&_twig_print,
311 # if the Entity handler is set then it prints the entity declaration
312 # before the entire internal subset (including the declaration!) is output
313 Entity => sub {},
31412µs XMLDecl => \&_twig_print, Doctype => \&_twig_print,
315 CdataStart => \&_twig_print, CdataEnd => \&_twig_print,
316 Proc => \&_twig_pi_check_roots, Comment => \&_twig_print,
317 Default => \&_twig_print,
318 ExternEnt => \&_twig_extern_ent,
319 );
320
321# handlers used when twig_roots, print_outside_roots and keep_encoding are used
322# and we are outside of the roots
323my %twig_handlers_roots_print_original_2_27=
324 ( Start => \&_twig_start_check_roots,
325 End => \&_twig_end_check_roots,
326 Char => \&_twig_print_original,
327 # for some reason original_string is wrong here
328 # this can be a problem if the doctype includes non ascii characters
329 XMLDecl => \&_twig_print, Doctype => \&_twig_print,
330 # if the Entity handler is set then it prints the entity declaration
331 # before the entire internal subset (including the declaration!) is output
332 Entity => sub {},
333 #Element => undef, Attlist => undef,
33412µs CdataStart => \&_twig_print_original, CdataEnd => \&_twig_print_original,
335 Proc => \&_twig_pi_check_roots, Comment => \&_twig_print_original,
336 Default => \&_twig_print, # _twig_print_original does not work
337 ExternEnt => \&_twig_extern_ent,
338 );
339
340
34112µsmy %twig_handlers_roots_print= $parser_version > 2.27
342 ? %twig_handlers_roots_print_2_30
343 : %twig_handlers_roots_print_2_27;
34412µsmy %twig_handlers_roots_print_original= $parser_version > 2.27
345 ? %twig_handlers_roots_print_original_2_30
346 : %twig_handlers_roots_print_original_2_27;
347
348
349# handlers used when the finish_print method has been called
35012µsmy %twig_handlers_finish_print=
351 ( Start => \&_twig_print,
352 End => \&_twig_print, Char => \&_twig_print,
353 Entity => \&_twig_print, XMLDecl => \&_twig_print,
354 Doctype => \&_twig_print, Element => \&_twig_print,
355 Attlist => \&_twig_print, CdataStart => \&_twig_print,
356 CdataEnd => \&_twig_print, Proc => \&_twig_print,
357 Comment => \&_twig_print, Default => \&_twig_print,
358 ExternEnt => \&_twig_extern_ent,
359 );
360
361# handlers used when the finish_print method has been called and the keep_encoding
362# option is used
36311µsmy %twig_handlers_finish_print_original=
364 ( Start => \&_twig_print_original, End => \&_twig_print_end_original,
365 Char => \&_twig_print_original, Entity => \&_twig_print_original,
366 XMLDecl => \&_twig_print_original, Doctype => \&_twig_print_original,
367 Element => \&_twig_print_original, Attlist => \&_twig_print_original,
368 CdataStart => \&_twig_print_original, CdataEnd => \&_twig_print_original,
369 Proc => \&_twig_print_original, Comment => \&_twig_print_original,
370 Default => \&_twig_print_original,
371 );
372
373# handlers used within ignored elements
37411µsmy %twig_handlers_ignore=
375 ( Start => \&_twig_ignore_start,
376 End => \&_twig_ignore_end,
377 Char => undef, Entity => undef, XMLDecl => undef,
378 Doctype => undef, Element => undef, Attlist => undef,
379 CdataStart => undef, CdataEnd => undef, Proc => undef,
380 Comment => undef, Default => undef,
381 ExternEnt => undef,
382 );
383
384
385# those handlers are only used if the entities are NOT to be expanded
3861400nsmy %twig_noexpand_handlers= ( ExternEnt => undef, Default => \&_twig_default );
387
3881100nsmy @saved_default_handler;
389
3901100nsmy $ID= 'id'; # default value, set by the Id argument
3911200nsmy $css_sel=0; # set through the css_sel option to allow .class selectors in triggers
392
393# all allowed options
394121µs%valid_option=
395 ( # XML::Twig options
396 TwigHandlers => 1, Id => 1,
397 TwigRoots => 1, TwigPrintOutsideRoots => 1,
398 StartTagHandlers => 1, EndTagHandlers => 1,
399 ForceEndTagHandlersUsage => 1,
400 DoNotChainHandlers => 1,
401 IgnoreElts => 1,
402 Index => 1,
403 AttAccessors => 1,
404 EltAccessors => 1,
405 FieldAccessors => 1,
406 CharHandler => 1,
407 TopDownHandlers => 1,
408 KeepEncoding => 1, DoNotEscapeAmpInAtts => 1,
409 ParseStartTag => 1, KeepAttsOrder => 1,
410 LoadDTD => 1, DTDHandler => 1, DTDBase => 1, NoXxe => 1,
411 DoNotOutputDTD => 1, NoProlog => 1,
412 ExpandExternalEnts => 1,
413 DiscardSpaces => 1, KeepSpaces => 1, DiscardAllSpaces => 1,
414 DiscardSpacesIn => 1, KeepSpacesIn => 1,
415 PrettyPrint => 1, EmptyTags => 1,
416 EscapeGt => 1,
417 Quote => 1,
418 Comments => 1, Pi => 1,
419 OutputFilter => 1, InputFilter => 1,
420 OutputTextFilter => 1,
421 OutputEncoding => 1,
422 RemoveCdata => 1,
423 EltClass => 1,
424 MapXmlns => 1, KeepOriginalPrefix => 1,
425 SkipMissingEnts => 1,
426 # XML::Parser options
427 ErrorContext => 1, ProtocolEncoding => 1,
428 Namespaces => 1, NoExpand => 1,
429 Stream_Delimiter => 1, ParseParamEnt => 1,
430 NoLWP => 1, Non_Expat_Options => 1,
431 Xmlns => 1, CssSel => 1,
432 UseTidy => 1, TidyOptions => 1,
433 OutputHtmlDoctype => 1,
434 );
435
4361100nsmy $active_twig; # last active twig,for XML::Twig::s
437
438# predefined input and output filters
43921.47ms234µs
# spent 20µs (7+13) within XML::Twig::BEGIN@439 which was called: # once (7µs+13µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 439
use vars qw( %filter);
# spent 20µs making 1 call to XML::Twig::BEGIN@439 # spent 13µs making 1 call to vars::import
4401900ns%filter= ( html => \&html_encode,
441 safe => \&safe_encode,
442 safe_hex => \&safe_encode_hex,
443 );
444
445
446# trigger types (used to sort them)
4471600nsmy ($LEVEL_TRIGGER, $REGEXP_TRIGGER, $XPATH_TRIGGER)=(1..3);
448
449sub new
45078µs
# spent 12.0ms (392µs+11.6) within XML::Twig::new which was called 7 times, avg 1.71ms/call: # 7 times (392µs+11.6ms) by Spreadsheet::ParseXLSX::_new_twig at line 1177 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 1.71ms/call
{ my ($class, %args) = @_;
4517800ns my $handlers;
452
453 # change all nice_perlish_names into nicePerlishNames
454714µs763µs %args= _normalize_args( %args);
# spent 63µs making 7 calls to XML::Twig::_normalize_args, avg 9µs/call
455
456 # check options
45777µs unless( $args{MoreOptions})
458 { foreach my $arg (keys %args)
459238µs { carp "invalid option $arg" unless $valid_option{$arg}; }
460 }
461
462 # a twig is really an XML::Parser
463 # my $self= XML::Parser->new(%args);
4647600ns my $self;
465713µs782µs $self= XML::Parser->new(%args);
# spent 82µs making 7 calls to XML::Parser::new, avg 12µs/call
466
46772µs bless $self, $class;
468
46973µs $self->{_twig_context_stack}= [];
470
471 # allow tag.class selectors in handler triggers
47272µs $css_sel= $args{CssSel} || 0;
473
474
47572µs if( exists $args{TwigHandlers})
4761400ns { $handlers= $args{TwigHandlers};
47712µs13.81ms $self->setTwigHandlers( $handlers);
# spent 3.81ms making 1 call to XML::Twig::setTwigHandlers
4781500ns delete $args{TwigHandlers};
479 }
480
481 # take care of twig-specific arguments
48271µs if( exists $args{StartTagHandlers})
483 { $self->setStartTagHandlers( $args{StartTagHandlers});
484 delete $args{StartTagHandlers};
485 }
486
48771µs if( exists $args{DoNotChainHandlers})
488 { $self->{twig_do_not_chain_handlers}= $args{DoNotChainHandlers}; }
489
49071µs if( exists $args{IgnoreElts})
491 { # change array to hash so you can write ignore_elts => [ qw(foo bar baz)]
492 if( isa( $args{IgnoreElts}, 'ARRAY')) { $args{IgnoreElts}= { map { $_ => 1 } @{$args{IgnoreElts}} }; }
493 $self->setIgnoreEltsHandlers( $args{IgnoreElts});
494 delete $args{IgnoreElts};
495 }
496
49771µs if( exists $args{Index})
498 { my $index= $args{Index};
499 # we really want a hash name => path, we turn an array into a hash if necessary
500 if( ref( $index) eq 'ARRAY')
501 { my %index= map { $_ => $_ } @$index;
502 $index= \%index;
503 }
504 while( my( $name, $exp)= each %$index)
505 { $self->setTwigHandler( $exp, sub { push @{$_[0]->{_twig_index}->{$name}}, $_; 1; }); }
506 }
507
50875µs $self->{twig_elt_class}= $args{EltClass} || 'XML::Twig::Elt';
50971µs if( defined( $args{EltClass}) && $args{EltClass} ne 'XML::Twig::Elt') { $self->{twig_alt_elt_class}=1; }
51071µs if( exists( $args{EltClass})) { delete $args{EltClass}; }
511
51272µs if( exists( $args{MapXmlns}))
51373µs { $self->{twig_map_xmlns}= $args{MapXmlns};
51472µs $self->{Namespaces}=1;
51572µs delete $args{MapXmlns};
516 }
517
51871µs if( exists( $args{KeepOriginalPrefix}))
51972µs { $self->{twig_keep_original_prefix}= $args{KeepOriginalPrefix};
5207800ns delete $args{KeepOriginalPrefix};
521 }
522
52372µs $self->{twig_dtd_handler}= $args{DTDHandler};
52471µs delete $args{DTDHandler};
525
52672µs if( $args{ExpandExternalEnts})
527 { $self->set_expand_external_entities( 1);
528 $self->{twig_expand_external_ents}= $args{ExpandExternalEnts};
529 $self->{twig_read_external_dtd}= 1; # implied by ExpandExternalEnts
530 if( $args{ExpandExternalEnts} == -1)
531 { $self->{twig_extern_ent_nofail}= 1;
532 $self->setHandlers( ExternEnt => \&_twig_extern_ent_nofail);
533 }
534 delete $args{LoadDTD};
535 delete $args{ExpandExternalEnts};
536 }
537 else
53877µs720µs { $self->set_expand_external_entities( 0); }
# spent 20µs making 7 calls to XML::Twig::set_expand_external_entities, avg 3µs/call
539
54079µs72.49ms if( !$args{NoLWP} && ! _use( 'URI') && ! _use( 'URI::File') && ! _use( 'LWP'))
# spent 2.49ms making 7 calls to XML::Twig::_use, avg 356µs/call
541 { $self->{twig_ext_ent_handler}= \&XML::Parser::initial_ext_ent_handler }
542 elsif( $args{NoXxe})
543 { $self->{twig_ext_ent_handler}=
544711µs sub { my($xp, $base, $path) = @_; $xp->{ErrorMessage}.= "cannot use entities in document when the no_xxe option is on"; return undef; };
545 }
546 else
547 { $self->{twig_ext_ent_handler}= \&XML::Parser::file_ext_ent_handler }
548
54972µs if( $args{DoNotEscapeAmpInAtts})
550 { $self->set_do_not_escape_amp_in_atts( 1);
551 $self->{twig_do_not_escape_amp_in_atts}=1;
552 }
553 else
55475µs717µs { $self->set_do_not_escape_amp_in_atts( 0);
# spent 17µs making 7 calls to XML::Twig::set_do_not_escape_amp_in_atts, avg 2µs/call
55575µs $self->{twig_do_not_escape_amp_in_atts}=0;
556 }
557
558 # deal with TwigRoots argument, a hash of elements for which
559 # subtrees will be built (and associated handlers)
560
56172µs if( $args{TwigRoots})
56212µs14.78ms { $self->setTwigRoots( $args{TwigRoots});
# spent 4.78ms making 1 call to XML::Twig::setTwigRoots
5631500ns delete $args{TwigRoots};
564 }
565
56671µs if( $args{EndTagHandlers})
567 { unless ($self->{twig_roots} || $args{ForceEndTagHandlersUsage})
568 { croak "you should not use EndTagHandlers without TwigRoots\n",
569 "if you want to use it anyway, normally because you have ",
570 "a start_tag_handlers that calls 'ignore' and you want to ",
571 "call an ent_tag_handlers at the end of the element, then ",
572 "pass 'force_end_tag_handlers_usage => 1' as an argument ",
573 "to new";
574 }
575
576 $self->setEndTagHandlers( $args{EndTagHandlers});
577 delete $args{EndTagHandlers};
578 }
579
58071µs if( $args{TwigPrintOutsideRoots})
581 { croak "cannot use twig_print_outside_roots without twig_roots"
582 unless( $self->{twig_roots});
583 # if the arg is a filehandle then store it
584 if( _is_fh( $args{TwigPrintOutsideRoots}) )
585 { $self->{twig_output_fh}= $args{TwigPrintOutsideRoots}; }
586 $self->{twig_default_print}= $args{TwigPrintOutsideRoots};
587 }
588
589 # space policy
59071µs if( $args{KeepSpaces})
591 { croak "cannot use both keep_spaces and discard_spaces" if( $args{DiscardSpaces});
592 croak "cannot use both keep_spaces and discard_all_spaces" if( $args{DiscardAllSpaces});
593 croak "cannot use both keep_spaces and keep_spaces_in" if( $args{KeepSpacesIn});
594 $self->{twig_keep_spaces}=1;
595 delete $args{KeepSpaces};
596 }
59771µs if( $args{DiscardSpaces})
598 {
599 croak "cannot use both discard_spaces and keep_spaces_in" if( $args{KeepSpacesIn});
600 croak "cannot use both discard_spaces and discard_all_spaces" if( $args{DiscardAllSpaces});
601 croak "cannot use both discard_spaces and discard_spaces_in" if( $args{DiscardSpacesIn});
602 $self->{twig_discard_spaces}=1;
603 delete $args{DiscardSpaces};
604 }
60571µs if( $args{KeepSpacesIn})
606 { croak "cannot use both keep_spaces_in and discard_spaces_in" if( $args{DiscardSpacesIn});
607 croak "cannot use both keep_spaces_in and discard_all_spaces" if( $args{DiscardAllSpaces});
608 $self->{twig_discard_spaces}=1;
609 $self->{twig_keep_spaces_in}={};
610 my @tags= @{$args{KeepSpacesIn}};
611 foreach my $tag (@tags) { $self->{twig_keep_spaces_in}->{$tag}=1; }
612 delete $args{KeepSpacesIn};
613 }
614
61571µs if( $args{DiscardAllSpaces})
616 {
617 croak "cannot use both discard_all_spaces and discard_spaces_in" if( $args{DiscardSpacesIn});
618 $self->{twig_discard_all_spaces}=1;
619 delete $args{DiscardAllSpaces};
620 }
621
62271µs if( $args{DiscardSpacesIn})
623 { $self->{twig_keep_spaces}=1;
624 $self->{twig_discard_spaces_in}={};
625 my @tags= @{$args{DiscardSpacesIn}};
626 foreach my $tag (@tags) { $self->{twig_discard_spaces_in}->{$tag}=1; }
627 delete $args{DiscardSpacesIn};
628 }
629 # discard spaces by default
63076µs $self->{twig_discard_spaces}= 1 unless( $self->{twig_keep_spaces});
631
63273µs $args{Comments}||= $COMMENTS_DEFAULT;
63377µs if( $args{Comments} eq 'drop') { $self->{twig_keep_comments}= 0; }
634 elsif( $args{Comments} eq 'keep') { $self->{twig_keep_comments}= 1; }
635 elsif( $args{Comments} eq 'process') { $self->{twig_process_comments}= 1; }
636 else { croak "wrong value for comments argument: '$args{Comments}' (should be 'drop', 'keep' or 'process')"; }
63772µs delete $args{Comments};
638
63973µs $args{Pi}||= $PI_DEFAULT;
64074µs if( $args{Pi} eq 'drop') { $self->{twig_keep_pi}= 0; }
641 elsif( $args{Pi} eq 'keep') { $self->{twig_keep_pi}= 1; }
642 elsif( $args{Pi} eq 'process') { $self->{twig_process_pi}= 1; }
643 else { croak "wrong value for pi argument: '$args{Pi}' (should be 'drop', 'keep' or 'process')"; }
64471µs delete $args{Pi};
645
64672µs if( $args{KeepEncoding})
647 {
648 # set it in XML::Twig::Elt so print functions know what to do
649 $self->set_keep_encoding( 1);
650 $self->{parse_start_tag}= $args{ParseStartTag} || \&_parse_start_tag;
651 delete $args{ParseStartTag} if defined( $args{ParseStartTag}) ;
652 delete $args{KeepEncoding};
653 }
654 else
65575µs726µs { $self->set_keep_encoding( 0);
# spent 26µs making 7 calls to XML::Twig::set_keep_encoding, avg 4µs/call
65672µs if( $args{ParseStartTag})
657 { $self->{parse_start_tag}= $args{ParseStartTag}; }
658 else
65971µs { delete $self->{parse_start_tag}; }
66071µs delete $args{ParseStartTag};
661 }
662
66372µs if( $args{OutputFilter})
664 { $self->set_output_filter( $args{OutputFilter});
665 delete $args{OutputFilter};
666 }
667 else
66875µs734µs { $self->set_output_filter( 0); }
# spent 34µs making 7 calls to XML::Twig::set_output_filter, avg 5µs/call
669
67071µs if( $args{RemoveCdata})
671 { $self->set_remove_cdata( $args{RemoveCdata});
672 delete $args{RemoveCdata};
673 }
674 else
67574µs714µs { $self->set_remove_cdata( 0); }
# spent 14µs making 7 calls to XML::Twig::set_remove_cdata, avg 2µs/call
676
67771µs if( $args{OutputTextFilter})
678 { $self->set_output_text_filter( $args{OutputTextFilter});
679 delete $args{OutputTextFilter};
680 }
681 else
68275µs728µs { $self->set_output_text_filter( 0); }
# spent 28µs making 7 calls to XML::Twig::set_output_text_filter, avg 4µs/call
683
68471µs if( $args{KeepAttsOrder})
685 { $self->{keep_atts_order}= $args{KeepAttsOrder};
686 if( _use( 'Tie::IxHash'))
687 { $self->set_keep_atts_order( $self->{keep_atts_order}); }
688 else
689 { croak "Tie::IxHash not available, option keep_atts_order not allowed"; }
690 }
691 else
69275µs717µs { $self->set_keep_atts_order( 0); }
# spent 17µs making 7 calls to XML::Twig::set_keep_atts_order, avg 2µs/call
693
694
69571µs if( $args{PrettyPrint}) { $self->set_pretty_print( $args{PrettyPrint}); }
6967900ns if( $args{EscapeGt}) { $self->escape_gt( $args{EscapeGt}); }
69771µs if( $args{EmptyTags}) { $self->set_empty_tag_style( $args{EmptyTags}) }
698
69971µs if( exists $args{Id}) { $ID= $args{Id}; delete $args{ID}; }
70071µs if( $args{NoProlog}) { $self->{no_prolog}= 1; delete $args{NoProlog}; }
7017700ns if( $args{DoNotOutputDTD}) { $self->{no_dtd_output}= 1; delete $args{DoNotOutputDTD}; }
7027900ns if( $args{LoadDTD}) { $self->{twig_read_external_dtd}= 1; delete $args{LoadDTD}; }
7037900ns if( $args{CharHandler}) { $self->setCharHandler( $args{CharHandler}); delete $args{CharHandler}; }
704
70571µs if( $args{InputFilter}) { $self->set_input_filter( $args{InputFilter}); delete $args{InputFilter}; }
7067800ns if( $args{NoExpand}) { $self->setHandlers( %twig_noexpand_handlers); $self->{twig_no_expand}=1; }
70772µs if( my $output_encoding= $args{OutputEncoding}) { $self->set_output_encoding( $output_encoding); delete $args{OutputFilter}; }
708
70971µs if( my $tdh= $args{TopDownHandlers}) { $self->{twig_tdh}=1; delete $args{TopDownHandlers}; }
710
71171µs if( my $acc_a= $args{AttAccessors}) { $self->att_accessors( @$acc_a); }
7127900ns if( my $acc_e= $args{EltAccessors}) { $self->elt_accessors( isa( $acc_e, 'ARRAY') ? @$acc_e : $acc_e); }
7137800ns if( my $acc_f= $args{FieldAccessors}) { $self->field_accessors( isa( $acc_f, 'ARRAY') ? @$acc_f : $acc_f); }
714
7157800ns if( $args{UseTidy}) { $self->{use_tidy}= 1; }
71673µs $self->{tidy_options}= $args{TidyOptions} || {};
717
7187800ns if( $args{OutputHtmlDoctype}) { $self->{html_doctype}= 1; }
719
72076µs722µs $self->set_quote( $args{Quote} || 'double');
# spent 22µs making 7 calls to XML::Twig::set_quote, avg 3µs/call
721
722 # set handlers
72374µs if( $self->{twig_roots})
724 { if( $self->{twig_default_print})
725 { if( $self->{twig_keep_encoding})
726 { $self->setHandlers( %twig_handlers_roots_print_original); }
727 else
728 { $self->setHandlers( %twig_handlers_roots_print); }
729 }
730 else
73112µs116µs { $self->setHandlers( %twig_handlers_roots); }
# spent 16µs making 1 call to XML::Parser::setHandlers
732 }
733 else
734611µs6104µs { $self->setHandlers( %twig_handlers); }
# spent 104µs making 6 calls to XML::Parser::setHandlers, avg 17µs/call
735
736 # XML::Parser::Expat does not like these handler to be set. So in order to
737 # use the various sets of handlers on XML::Parser or XML::Parser::Expat
738 # objects when needed, these ones have to be set only once, here, at
739 # XML::Parser level
74077µs722µs $self->setHandlers( Init => \&_twig_init, Final => \&_twig_final);
# spent 22µs making 7 calls to XML::Parser::setHandlers, avg 3µs/call
741
742720µs713µs $self->{twig_entity_list}= XML::Twig::Entity_list->new;
# spent 13µs making 7 calls to XML::Twig::Entity_list::new, avg 2µs/call
743713µs710µs $self->{twig_notation_list}= XML::Twig::Notation_list->new;
# spent 10µs making 7 calls to XML::Twig::Notation_list::new, avg 1µs/call
744
74572µs $self->{twig_id}= $ID;
74672µs $self->{twig_stored_spaces}='';
747
74872µs $self->{twig_autoflush}= 1; # auto flush by default
749
75072µs $self->{twig}= $self;
751713µs74µs if( $weakrefs) { weaken( $self->{twig}); }
# spent 4µs making 7 calls to Scalar::Util::weaken, avg 629ns/call
752
753723µs return $self;
754 }
755
756sub parse
757
# spent 70.4s (48µs+70.4) within XML::Twig::parse which was called 7 times, avg 10.1s/call: # 5 times (34µs+46.3ms) by Spreadsheet::ParseXLSX::_parse_xml at line 1033 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 9.28ms/call # once (8µs+70.4s) by Spreadsheet::ParseXLSX::_parse_sheet at line 447 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (6µs+7.19ms) by Spreadsheet::ParseXLSX::_parse_shared_strings at line 658 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm
{
75871µs my $t= shift;
759 # if called as a class method, calls nparse, which creates the twig then parses it
760714µs74µs if( !ref( $t) || !isa( $t, 'XML::Twig')) { return $t->nparse( @_); }
# spent 4µs making 7 calls to UNIVERSAL::isa, avg 643ns/call
761
762 # requires 5.006 at least (or the ${^UNICODE} causes a problem) # > perl 5.5
763 # trap underlying bug in IO::Handle (see RT #17500) # > perl 5.5
764 # croak if perl 5.8+, -CD (or PERL_UNICODE set to D) and parsing a pipe # > perl 5.5
76575µs if( $perl_version>=5.008 && ${^UNICODE} && (${^UNICODE} & 24) && isa( $_[0], 'GLOB') && -p $_[0] ) # > perl 5.5
766 { croak "cannot parse the output of a pipe when perl is set to use the UTF8 perlIO layer\n" # > perl 5.5
767 . "set the environment variable PERL_UNICODE or use the -C option (see perldoc perlrun)\n" # > perl 5.5
768 . "not to include 'D'"; # > perl 5.5
769 } # > perl 5.5
7701413µs770.4s $t= eval { $t->SUPER::parse( @_); };
# spent 70.4s making 7 calls to XML::Parser::parse, avg 10.1s/call
771
77273µs if( !$t
773 && $@=~m{(syntax error at line 1, column 0, byte 0|not well-formed \(invalid token\) at line 1, column 1, byte 1)}
774 && -f $_[0]
775 && ( ! ref( $_[0]) || ref( $_[0])) ne 'GLOB' # -f works on a filehandle, so this make sure $_[0] is a real file
776 )
777 { croak "you seem to have used the parse method on a filename ($_[0]), you probably want parsefile instead"; }
778718µs778µs return _checked_parse_result( $t, $@);
# spent 78µs making 7 calls to XML::Twig::_checked_parse_result, avg 11µs/call
779 }
780
781sub parsefile
782 { my $t= shift;
783 if( -f $_[0] && ! -s $_[0]) { return _checked_parse_result( undef, "empty file '$_[0]'"); }
784 $t= eval { $t->SUPER::parsefile( @_); };
785 return _checked_parse_result( $t, $@);
786 }
787
788sub _checked_parse_result
78972µs
# spent 78µs (17+61) within XML::Twig::_checked_parse_result which was called 7 times, avg 11µs/call: # 7 times (17µs+61µs) by XML::Twig::parse at line 778, avg 11µs/call
{ my( $t, $returned)= @_;
79071µs if( !$t)
791 { if( isa( $returned, 'XML::Twig') && $returned->{twig_finish_now})
792 { $t= $returned;
793 delete $t->{twig_finish_now};
794 return $t->_twig_final;
795 }
796 else
797 { _croak( $returned, 0); }
798 }
799
80074µs $active_twig= $t;
80177µs161µs return $t;
# spent 61µs making 1 call to XML::Twig::DESTROY
802 }
803
804sub active_twig { return $active_twig; }
805
806sub finish_now
807 { my $t= shift;
808 $t->{twig_finish_now}=1;
809 # XML::Parser 2.43 changed xpcroak in a way that caused test failures for XML::Twig
810 # the change was reverted in 2.44, but this is here to ensure that tests pass with 2.43
811 if( $XML::Parser::VERSION == 2.43)
81221.82ms230µs
# spent 18µs (5+13) within XML::Twig::BEGIN@812 which was called: # once (5µs+13µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 812
{ no warnings;
# spent 18µs making 1 call to XML::Twig::BEGIN@812 # spent 12µs making 1 call to warnings::unimport
813 $t->parser->{twig_error}= $t;
814 *XML::Parser::Expat::xpcroak= sub { die $_[0]->{twig_error}; };
815 die $t;
816 }
817 else
818 { die $t; }
819 }
820
821
822sub parsefile_inplace { shift->_parse_inplace( parsefile => @_); }
823sub parsefile_html_inplace { shift->_parse_inplace( parsefile_html => @_); }
824
825sub _parse_inplace
826 { my( $t, $method, $file, $suffix)= @_;
827 _use( 'File::Temp') || croak "need File::Temp to use inplace methods\n";
828 _use( 'File::Basename');
829
830
831 my $tmpdir= dirname( $file);
832 my( $tmpfh, $tmpfile)= File::Temp::tempfile( DIR => $tmpdir);
833 my $original_fh= select $tmpfh;
834
835 # we can only use binmode :utf8 if perl was compiled with useperlio
836 # might be a problem if keep_encoding used but the file is already in utf8
837 if( $perl_version > 5.006 && !$t->{twig_keep_encoding} && _use_perlio()) { binmode( $tmpfh, ":utf8" ); }
838
839 $t->$method( $file);
840
841 select $original_fh;
842 close $tmpfh;
843 my $mode= (stat( $file))[2] & oct(7777);
844 chmod $mode, $tmpfile or croak "cannot change temp file mode to $mode: $!";
845
846 if( $suffix)
847 { my $backup;
848 if( $suffix=~ m{\*}) { ($backup = $suffix) =~ s/\*/$file/g; }
849 else { $backup= $file . $suffix; }
850
851 rename( $file, $backup) or croak "cannot backup initial file ($file) to $backup: $!";
852 }
853 rename( $tmpfile, $file) or croak "cannot rename temp file ($tmpfile) to initial file ($file): $!";
854
855 return $t;
856 }
857
858
859sub parseurl
860 { my $t= shift;
861 $t->_parseurl( 0, @_);
862 }
863
864sub safe_parseurl
865 { my $t= shift;
866 $t->_parseurl( 1, @_);
867 }
868
869sub safe_parsefile_html
870 { my $t= shift;
871 eval { $t->parsefile_html( @_); };
872 return $@ ? $t->_reset_twig_after_error : $t;
873 }
874
875sub safe_parseurl_html
876 { my $t= shift;
877 _use( 'LWP::Simple') or croak "missing LWP::Simple";
878 eval { $t->parse_html( LWP::Simple::get( shift()), @_); } ;
879 return $@ ? $t->_reset_twig_after_error : $t;
880 }
881
882sub parseurl_html
883 { my $t= shift;
884 _use( 'LWP::Simple') or croak "missing LWP::Simple";
885 $t->parse_html( LWP::Simple::get( shift()), @_);
886 }
887
888
889# uses eval to catch the parser's death
890sub safe_parse_html
891 { my $t= shift;
892 eval { $t->parse_html( @_); } ;
893 return $@ ? $t->_reset_twig_after_error : $t;
894 }
895
896sub parsefile_html
897 { my $t= shift;
898 my $file= shift;
899 my $indent= $t->{ErrorContext} ? 1 : 0;
900 $t->set_empty_tag_style( 'html');
901 my $html2xml= $t->{use_tidy} ? \&_tidy_html : \&_html2xml;
902 my $options= $t->{use_tidy} ? $t->{tidy_options} || {} : { indent => $indent, html_doctype => $t->{html_doctype} };
903 $t->parse( $html2xml->( _slurp( $file), $options), @_);
904 return $t;
905 }
906
907sub parse_html
908 { my $t= shift;
909 my $options= ref $_[0] && ref $_[0] eq 'HASH' ? shift() : {};
910 my $use_tidy= exists $options->{use_tidy} ? $options->{use_tidy} : $t->{use_tidy};
911 my $content= shift;
912 my $indent= $t->{ErrorContext} ? 1 : 0;
913 $t->set_empty_tag_style( 'html');
914 my $html2xml= $use_tidy ? \&_tidy_html : \&_html2xml;
915 my $conv_options= $use_tidy ? $t->{tidy_options} || {} : { indent => $indent, html_doctype => $t->{html_doctype} };
916 $t->parse( $html2xml->( isa( $content, 'GLOB') ? _slurp_fh( $content) : $content, $conv_options), @_);
917 return $t;
918 }
919
920sub xparse
921 { my $t= shift;
922 my $to_parse= $_[0];
923 if( isa( $to_parse, 'GLOB')) { $t->parse( @_); }
924 elsif( $to_parse=~ m{^\s*<}) { $to_parse=~ m{<html}i ? $t->_parse_as_xml_or_html( @_)
925 : $t->parse( @_);
926 }
927 elsif( $to_parse=~ m{^\w+://.*\.html?$}) { _use( 'LWP::Simple') or croak "missing LWP::Simple";
928 $t->_parse_as_xml_or_html( LWP::Simple::get( shift()), @_);
929 }
930 elsif( $to_parse=~ m{^\w+://}) { _use( 'LWP::Simple') or croak "missing LWP::Simple";
931 my $doc= LWP::Simple::get( shift);
932 if( ! defined $doc) { $doc=''; }
933 my $xml_parse_ok= $t->safe_parse( $doc, @_);
934 if( $xml_parse_ok)
935 { return $xml_parse_ok; }
936 else
937 { my $diag= $@;
938 if( $doc=~ m{<html}i)
939 { $t->parse_html( $doc, @_); }
940 else
941 { croak $diag; }
942 }
943 }
944 elsif( $to_parse=~ m{\.html?$}) { my $content= _slurp( shift);
945 $t->_parse_as_xml_or_html( $content, @_);
946 }
947 else { $t->parsefile( @_); }
948 }
949
950sub _parse_as_xml_or_html
951 { my $t= shift;
952 if( _is_well_formed_xml( $_[0]))
953 { $t->parse( @_) }
954 else
955 { my $html2xml= $t->{use_tidy} ? \&_tidy_html : \&_html2xml;
956 my $options= $t->{use_tidy} ? $t->{tidy_options} || {} : { indent => 0, html_doctype => $t->{html_doctype} };
957 my $html= $html2xml->( $_[0], $options, @_);
958 if( _is_well_formed_xml( $html))
959 { $t->parse( $html); }
960 else
961 { croak $@; } # can't really test this because HTML::Parser or HTML::Tidy may change how they deal with bas HTML between versions
962 }
963 }
964
9651200ns{ my $parser;
966 sub _is_well_formed_xml
967 { $parser ||= XML::Parser->new;
968 eval { $parser->parse( $_[0]); };
969 return $@ ? 0 : 1;
970 }
971}
972
973sub nparse
9741300ns { my $class= shift;
975 my $to_parse= pop;
976 $class->new( @_)->xparse( $to_parse);
977 }
978
979sub nparse_pp { shift()->nparse( pretty_print => 'indented', @_); }
980sub nparse_e { shift()->nparse( error_context => 1, @_); }
981sub nparse_ppe { shift()->nparse( pretty_print => 'indented', error_context => 1, @_); }
982
983
984sub _html2xml
985 { my( $html, $options)= @_;
986 _use( 'HTML::TreeBuilder', '3.13') or croak "cannot parse HTML: missing HTML::TreeBuilder v >= 3.13\n";
987 my $tree= HTML::TreeBuilder->new;
988 $tree->ignore_ignorable_whitespace( 0);
989 $tree->ignore_unknown( 0);
990 $tree->no_space_compacting( 1);
991 $tree->store_comments( 1);
992 $tree->store_pis(1);
993 $tree->parse( $html);
994 $tree->eof;
995
996 my $xml='';
997 if( $options->{html_doctype} && exists $tree->{_decl} )
998 { my $decl= $tree->{_decl}->as_XML;
999
1000 # first try to fix declarations that are missing the SYSTEM part
1001 $decl =~ s{^\s*<!DOCTYPE \s+ ((?i)html) \s+ PUBLIC \s+ "([^"]*)" \s* >}
1002 { my $system= $HTML_DECL{$2} || $HTML_DECL{$DEFAULT_HTML_TYPE};
1003 qq{<!DOCTYPE $1 PUBLIC "$2" "$system">}
1004
1005 }xe;
1006
1007 # then check that the declaration looks OK (so it parses), if not remove it,
1008 # better to parse without the declaration than to die stupidly
1009 if( $decl =~ m{<!DOCTYPE \s+ (?i:HTML) (\s+ PUBLIC \s+ "[^"]*" \s+ (SYSTEM \s+)? "[^"]*")? \s*>}x # PUBLIC then SYSTEM
1010 || $decl =~ m{<!DOCTYPE \s+ (?i:HTML) \s+ SYSTEM \s+ "[^"]*" \s*>}x # just SYSTEM
1011 )
1012 { $xml= $decl; }
1013 }
1014
1015 $xml.= _as_XML( $tree);
1016
1017
1018 _fix_xml( $tree, \$xml);
1019
1020 if( $options->{indent}) { _indent_xhtml( \$xml); }
1021 $tree->delete;
1022 $xml=~ s{\s+$}{}s; # trim end
1023 return $xml;
1024 }
1025
1026sub _tidy_html
1027 { my( $html, $options)= @_;
1028 _use( 'HTML::Tidy') or croak "cannot cleanup HTML using HTML::Tidy (required by the use_tidy option): $@\n"; ;
1029 my $TIDY_DEFAULTS= { output_xhtml => 1, # duh!
1030 tidy_mark => 0, # do not add the "generated by tidy" comment
1031 numeric_entities => 1,
1032 char_encoding => 'utf8',
1033 bare => 1,
1034 clean => 1,
1035 doctype => 'transitional',
1036 fix_backslash => 1,
1037 merge_divs => 0,
1038 merge_spans => 0,
1039 sort_attributes => 'alpha',
1040 indent => 0,
1041 wrap => 0,
1042 break_before_br => 0,
1043 };
1044 $options ||= {};
1045 my $tidy_options= { %$TIDY_DEFAULTS, %$options};
1046 my $tidy = HTML::Tidy->new( $tidy_options);
1047 $tidy->ignore( type => 1, type => 2 ); # 1 is TIDY_WARNING, 2 is TIDY_ERROR, not clean
1048 my $xml= $tidy->clean( $html );
1049 return $xml;
1050 }
1051
1052
10531200ns{ my %xml_parser_encoding;
1054 sub _fix_xml
1055 { my( $tree, $xml)= @_; # $xml is a ref to the xml string
1056
1057 my $max_tries=5;
1058 my $add_decl;
1059
1060 while( ! _check_xml( $xml) && $max_tries--)
1061 {
1062 # a couple of fixes for weird HTML::TreeBuilder errors
1063 if( $@=~ m{^\s*xml (or text )?declaration not at start of (external )?entity}i)
1064 { $$xml=~ s{<\?xml.*?\?>}{}g;
1065 #warn " fixed xml declaration in the wrong place\n";
1066 }
1067 elsif( $@=~ m{undefined entity})
1068 { $$xml=~ s{&(amp;)?Amp;}{&amp;}g if $HTML::TreeBuilder::VERSION < 4.00;
1069 if( _use( 'HTML::Entities::Numbered')) { $$xml=name2hex_xml( $$xml); }
1070 $$xml=~ s{&(\w+);}{ my $ent= $1; if( $ent !~ m{^(amp|lt|gt|apos|quote)$}) { "&amp;$ent;" } }eg;
1071 }
1072 elsif( $@=~ m{&Amp; used in html})
1073 # if $Amp; is used instead of &amp; then HTML::TreeBuilder's as_xml is tripped (old version)
1074 { $$xml=~ s{&(amp;)?Amp;}{&amp;}g if $HTML::TreeBuilder::VERSION < 4.00;
1075 }
1076 elsif( $@=~ m{^\s*not well-formed \(invalid token\)})
1077 { if( $HTML::TreeBuilder::VERSION < 4.00)
1078 { $$xml=~ s{&(amp;)?Amp;}{&amp;}g;
1079 $$xml=~ s{(<[^>]* )(\d+=)"}{$1a$2"}g; # <table 1> comes out as <table 1="1">, "fix the attribute
1080 }
1081 my $q= '<img "="&#34;" '; # extracted so vim doesn't get confused
1082 if( _use( 'HTML::Entities::Numbered')) { $$xml=name2hex_xml( $$xml); }
1083 if( $$xml=~ m{$q})
1084 { $$xml=~ s{$q}{<img }g; # happens with <img src="foo.png"" ...
1085 }
1086 else
1087 { my $encoding= _encoding_from_meta( $tree);
1088 unless( keys %xml_parser_encoding) { %xml_parser_encoding= _xml_parser_encodings(); }
1089
1090 if( ! $add_decl)
1091 { if( $xml_parser_encoding{$encoding})
1092 { $add_decl=1; }
1093 elsif( $encoding eq 'euc-jp' && $xml_parser_encoding{'x-euc-jp-jisx0221'})
1094 { $encoding="x-euc-jp-jisx0221"; $add_decl=1;}
1095 elsif( $encoding eq 'shift-jis' && $xml_parser_encoding{'x-sjis-jisx0221'})
1096 { $encoding="x-sjis-jisx0221"; $add_decl=1;}
1097
1098 if( $add_decl)
1099 { $$xml=~ s{^(<\?xml.*?\?>)?}{<?xml version="1.0" encoding="$encoding"?>}s;
1100 #warn " added decl (encoding $encoding)\n";
1101 }
1102 else
1103 { $$xml=~ s{^(<\?xml.*?\?>)?}{}s;
1104 #warn " converting to utf8 from $encoding\n";
1105 $$xml= _to_utf8( $encoding, $$xml);
1106 }
1107 }
1108 else
1109 { $$xml=~ s{^(<\?xml.*?\?>)?}{}s;
1110 #warn " converting to utf8 from $encoding\n";
1111 $$xml= _to_utf8( $encoding, $$xml);
1112 }
1113 }
1114 }
1115 }
1116
1117 # some versions of HTML::TreeBuilder escape CDATA sections
1118 $$xml=~ s{(&lt;!\[CDATA\[.*?\]\]&gt;)}{_unescape_cdata( $1)}eg;
1119
1120 }
1121
1122 sub _xml_parser_encodings
1123 { my @encodings=( 'iso-8859-1'); # this one is included by default, there is no map for it in @INC
1124 foreach my $inc (@INC)
112521.27ms1480µs
# spent 480µs (307+173) within XML::Twig::BEGIN@1125 which was called: # once (307µs+173µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 1125
{ push @encodings, map { basename( $_, '.enc') } glob( File::Spec->catdir( $inc => XML => Parser => Encodings => '*.enc')); }
# spent 480µs making 1 call to XML::Twig::BEGIN@1125
1126 return map { $_ => 1 } @encodings;
1127 }
1128}
1129
1130
1131sub _unescape_cdata
11321100ns { my( $cdata)= @_;
1133 $cdata=~s{&lt;}{<}g;
1134 $cdata=~s{&gt;}{>}g;
1135 $cdata=~s{&amp;}{&}g;
1136 return $cdata;
1137 }
1138
1139sub _as_XML {
1140
1141 # fork of HTML::Element::as_XML, which is a little too buggy and inconsistent between versions for my liking
1142 my ($elt) = @_;
1143 my $xml= '';
1144 my $empty_element_map = $elt->_empty_element_map;
1145
1146 my ( $tag, $node, $start ); # per-iteration scratch
1147 $elt->traverse(
1148 sub {
1149 ( $node, $start ) = @_;
1150 if ( ref $node )
1151 { # it's an element
1152 $tag = $node->{'_tag'};
1153 if ($start)
1154 { # on the way in
1155 foreach my $att ( grep { ! m{^(_|/$)} } keys %$node )
1156 { # fix attribute names instead of dying
1157 my $new_att= $att;
1158 if( $att=~ m{^\d}) { $new_att= "a$att"; }
1159 $new_att=~ s{[^\w\d:_-]}{}g;
1160 $new_att ||= 'a';
1161 if( $new_att ne $att) { $node->{$new_att}= delete $node->{$att}; }
1162 }
1163
1164 if ( $empty_element_map->{$tag} && (!@{ $node->{'_content'} || []}) )
1165 { $xml.= $node->starttag_XML( undef, 1 ); }
1166 else
1167 { $xml.= $node->starttag_XML(undef); }
1168 }
1169 else
1170 { # on the way out
1171 unless ( $empty_element_map->{$tag} and !@{ $node->{'_content'} || [] } )
1172 { $xml.= $node->endtag_XML();
1173 } # otherwise it will have been an <... /> tag.
1174 }
1175 }
1176 elsif( $node=~ /<!\[CDATA\[/) # the content includes CDATA
1177 { foreach my $chunk (split /(<!\[CDATA\[.*?\]\]>)/s, $node) # chunks are CDATA sections or normal text
1178 { $xml.= $chunk =~ m{<!\[CDATA\[} ? $chunk : _xml_escape( $chunk); }
1179 }
1180 else # it's just text
1181 { $xml .= _xml_escape($node); }
1182 1; # keep traversing
1183 }
1184 );
1185 return $xml;
1186}
1187
1188sub _xml_escape
1189 { my( $html)= @_;
1190 $html =~ s{&(?! # An ampersand that isn't followed by...
1191 {&amp;}gx if 0; # Needs to be escaped to amp
1192 \#x[0-9a-fA-F]+; | # A hash mark, "x", hex digits and semicolon, or
1193 [\w]+; # A valid unicode entity name and semicolon
1194 )
1195 )
1196 }
1197
1198
1199 $html=~ s{&}{&amp;}g;
1200
1201 # in old versions of HTML::TreeBuilder &amp; can come out as &Amp;
1202 if( $HTML::TreeBuilder::VERSION && $HTML::TreeBuilder::VERSION <= 3.23) { $html=~ s{&Amp;}{&amp;}g; }
1203
1204 # simple character escapes
1205 $html =~ s/</&lt;/g;
1206 $html =~ s/>/&gt;/g;
1207 $html =~ s/"/&quot;/g;
1208 $html =~ s/'/&apos;/g;
1209
1210 return $html;
1211 }
1212
- -
1216sub _check_xml
1217 { my( $xml)= @_; # $xml is a ref to the xml string
1218 my $ok= eval { XML::Parser->new->parse( $$xml); };
1219 #if( $ok) { warn " parse OK\n"; }
1220 return $ok;
1221 }
1222
1223sub _encoding_from_meta
1224 { my( $tree)= @_;
1225 my $enc="iso-8859-1";
1226 my @meta= $tree->find( 'meta');
1227 foreach my $meta (@meta)
1228 { if( $meta->{'http-equiv'} && ($meta->{'http-equiv'} =~ m{^\s*content-type\s*}i)
1229 && $meta->{content} && ($meta->{content} =~ m{^\s*text/html\s*;\s*charset\s*=\s*(\S*)\s*}i)
1230 )
1231 { $enc= lc $1;
1232 #warn " encoding from meta tag is '$enc'\n";
1233 last;
1234 }
1235 }
1236 return $enc;
1237 }
1238
1239{ sub _to_utf8
1240 { my( $encoding, $string)= @_;
1241 local $SIG{__DIE__};
1242 if( _use( 'Encode'))
1243 { Encode::from_to( $string, $encoding => 'utf8', 0x0400); } # 0x0400 is Encode::FB_XMLCREF
1244 elsif( _use( 'Text::Iconv'))
1245 { my $converter = eval { Text::Iconv->new( $encoding => "utf8") };
1246 if( $converter) { $string= $converter->convert( $string); }
1247 }
1248 elsif( _use( 'Unicode::Map8') && _use( 'Unicode::String'))
1249 { my $map= Unicode::Map8->new( $encoding);
1250 $string= $map->tou( $string)->utf8;
1251 }
1252 $string=~ s{[\x00-\x08\x0B\x0C\x0E-\x1F]}{}g; # get rid of control chars, portable in 5.6
1253 return $string;
1254 }
1255}
1256
1257
1258sub _indent_xhtml
12591200ns { my( $xhtml)= @_; # $xhtml is a ref
1260 my %block_tag= map { $_ => 1 } qw( html
1261 head
1262 meta title link script base
1263 body
1264 h1 h2 h3 h4 h5 h6
1265 p br address blockquote pre
1266 ol ul li dd dl dt
1267 table tr td th tbody tfoot thead col colgroup caption
1268 div frame frameset hr
1269 );
1270
1271 my $level=0;
1272 $$xhtml=~ s{( (?:<!(?:--.*?-->|[CDATA[.*?]]>)) # ignore comments and CDATA sections
1273 { if( $2 && $block_tag{$2}) { my $indent= " " x $level;
1274 "\n$indent<$2$3";
1275 }
1276 elsif( $4 && $block_tag{$4}) { my $indent= " " x $level;
1277 $level++ unless( $4=~ m{/>});
1278 my $nl= $4 eq 'html' ? '' : "\n";
1279 "$nl$indent<$4";
1280 }
1281 elsif( $5 && $block_tag{$5}) { $level--; "</$5"; }
1282 else { $1; }
1283 }xesg;
1284
- -
1289 }
1290
1291
1292sub add_stylesheet
1293 { my( $t, $type, $href)= @_;
1294 my %text_type= map { $_ => 1 } qw( xsl css);
1295 my $ss= $t->{twig_elt_class}->new( $PI);
1296 if( $text_type{$type})
1297 { $ss->_set_pi( 'xml-stylesheet', qq{type="text/$type" href="$href"}); }
1298 else
1299 { croak "unsupported style sheet type '$type'"; }
1300
1301 $t->_add_cpi_outside_of_root( leading_cpi => $ss);
1302 return $t;
1303 }
1304
13051100ns{ my %used; # module => 1 if require ok, 0 otherwise
13061100ns my %disallowed; # for testing, refuses to _use modules in this hash
1307
1308 sub _disallow_use ## no critic (Subroutines::ProhibitNestedSubs);
1309 { my( @modules)= @_;
1310 $disallowed{$_}= 1 foreach (@modules);
1311 }
1312
1313 sub _allow_use ## no critic (Subroutines::ProhibitNestedSubs);
1314 { my( @modules)= @_;
1315 $disallowed{$_}= 0 foreach (@modules);
1316 }
1317
1318 sub _use ## no critic (Subroutines::ProhibitNestedSubs);
131972µs
# spent 2.49ms (1.59+902µs) within XML::Twig::_use which was called 7 times, avg 356µs/call: # 7 times (1.59ms+902µs) by XML::Twig::new at line 540, avg 356µs/call
{ my( $module, $version)= @_;
132072µs $version ||= 0;
132172µs if( $disallowed{$module}) { return 0; }
132279µs if( $used{$module}) { return 1; }
1323326µs12µs if( eval "require $module") { import $module; $used{$module}= 1; # no critic ProhibitStringyEval
# spent 2µs making 1 call to UNIVERSAL::import
# spent 66µs executing statements in string eval
13241300ns if( $version)
1325 {
1326 ## no critic (TestingAndDebugging::ProhibitNoStrict);
132725.26ms217µs
# spent 12µs (8+5) within XML::Twig::BEGIN@1327 which was called: # once (8µs+5µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 1327
no strict 'refs';
# spent 12µs making 1 call to XML::Twig::BEGIN@1327 # spent 4µs making 1 call to strict::unimport
1328 if( ${"${module}::VERSION"} >= $version ) { return 1; }
1329 else { return 0; }
1330 }
1331 else
133213µs { return 1; }
1333 }
1334 else { $used{$module}= 0; return 0; }
1335 }
1336}
1337
1338# used to solve the [n] predicates while avoiding getting the entire list
1339# needs a prototype to accept passing bare blocks
13401100nssub _first_n(&$@) ## no critic (Subroutines::ProhibitSubroutinePrototypes);
1341 { my $coderef= shift;
1342 my $n= shift;
1343 my $i=0;
1344 if( $n > 0)
1345 { foreach (@_) { if( &$coderef) { $i++; return $_ if( $i == $n); } } }
1346 elsif( $n < 0)
1347 { foreach (reverse @_) { if( &$coderef) { $i--; return $_ if( $i == $n); } } }
1348 else
1349 { croak "illegal position number 0"; }
1350 return undef;
1351 }
1352
1353sub _slurp_uri
1354 { my( $uri, $base)= @_;
1355 if( $uri=~ m{^\w+://}) { _use( 'LWP::Simple'); return LWP::Simple::get( $uri); }
1356 else { return _slurp( _based_filename( $uri, $base)); }
1357 }
1358
1359sub _based_filename
1360 { my( $filename, $base)= @_;
1361 # cf. XML/Parser.pm's file_ext_ent_handler
1362 if (defined($base) and not ($filename =~ m{^(?:[\\/]|\w+:)}))
1363 { my $newpath = $base;
1364 $newpath =~ s{[^\\/:]*$}{$filename};
1365 $filename = $newpath;
1366 }
1367 return $filename;
1368 }
1369
1370sub _slurp
1371 { my( $filename)= @_;
1372 my $to_slurp;
1373 open( $to_slurp, "<$filename") or croak "cannot open '$filename': $!";
1374 local $/= undef;
1375 my $content= <$to_slurp>;
1376 close $to_slurp;
1377 return $content;
1378 }
1379
1380sub _slurp_fh
1381 { my( $fh)= @_;
1382 local $/= undef;
1383 my $content= <$fh>;
1384 return $content;
1385 }
1386
1387# I should really add extra options to allow better configuration of the
1388# LWP::UserAgent object
1389# this method forks (except on VMS!)
1390# - the child gets the data and copies it to the pipe,
1391# - the parent reads the stream and sends it to XML::Parser
1392# the data is cut it chunks the size of the XML::Parser::Expat buffer
1393# the method returns the twig and the status
1394sub _parseurl
1395 { my( $t, $safe, $url, $agent)= @_;
1396 _use( 'LWP') || croak "LWP not available, needed to use parseurl methods";
1397 if( $^O ne 'VMS')
1398 { pipe( README, WRITEME) or croak "cannot create connected pipes: $!";
1399 if( my $pid= fork)
1400 { # parent code: parse the incoming file
1401 close WRITEME; # no need to write
1402 my $result= $safe ? $t->safe_parse( \*README) : $t->parse( \*README);
1403 close README;
1404 return $@ ? 0 : $t;
1405 }
1406 else
1407 { # child
1408 close README; # no need to read
1409 local $|=1;
1410 $agent ||= LWP::UserAgent->new;
1411 my $request = HTTP::Request->new( GET => $url);
1412 # _pass_url_content is called with chunks of data the same size as
1413 # the XML::Parser buffer
1414 my $response = $agent->request( $request,
1415 sub { _pass_url_content( \*WRITEME, @_); }, $BUFSIZE);
1416 $response->is_success or croak "$url ", $response->message;
1417 close WRITEME;
1418 CORE::exit(); # CORE is there for mod_perl (which redefines exit)
1419 }
1420 }
1421 else
1422 { # VMS branch (hard to test!)
1423 local $|=1;
1424 $agent ||= LWP::UserAgent->new;
1425 my $request = HTTP::Request->new( GET => $url);
1426 my $response = $agent->request( $request);
1427 $response->is_success or croak "$url ", $response->message;
1428 my $result= $safe ? $t->safe_parse($response->content) : $t->parse($response->content);
1429 return $@ ? 0 : $t;
1430 }
1431
1432 }
1433
1434# get the (hopefully!) XML data from the URL and
1435sub _pass_url_content
1436 { my( $fh, $data, $response, $protocol)= @_;
1437 print {$fh} $data;
1438 }
1439
1440sub add_options
1441 { my %args= map { $_, 1 } @_;
1442 %args= _normalize_args( %args);
1443 foreach (keys %args) { $valid_option{$_}++; }
1444 }
1445
1446sub _pretty_print_styles { return XML::Twig::Elt::_pretty_print_styles(); }
1447
1448sub _twig_store_internal_dtd
1449 {
1450 # warn " in _twig_store_internal_dtd...\n"; # DEBUG handler
1451 my( $p, $string)= @_;
1452 my $t= $p->{twig};
1453 if( $t->{twig_keep_encoding}) { $string= $p->original_string(); }
1454 $t->{twig_doctype}->{internal} .= $string;
1455 return;
1456 }
1457
1458sub _twig_stop_storing_internal_dtd
1459 { # warn " in _twig_stop_storing_internal_dtd...\n"; # DEBUG handler
1460 my $p= shift;
1461 if( @saved_default_handler && defined $saved_default_handler[1])
1462 { $p->setHandlers( @saved_default_handler); }
1463 else
1464 {
1465 $p->setHandlers( Default => undef);
1466 }
1467 $p->{twig}->{twig_doctype}->{internal}=~ s{^\s*\[}{};
1468 $p->{twig}->{twig_doctype}->{internal}=~ s{\]\s*$}{};
1469 return;
1470 }
1471
1472sub _twig_doctype_fin_print
1473 { # warn " in _twig_doctype_fin_print...\n"; # DEBUG handler
1474 my( $p)= shift;
1475 if( $p->{twig}->{twig_doctype}->{has_internal} && !$expat_1_95_2) { print ' ]>'; }
1476 return;
1477 }
1478
1479
1480sub _normalize_args
14817900ns
# spent 63µs within XML::Twig::_normalize_args which was called 7 times, avg 9µs/call: # 7 times (63µs+0s) by XML::Twig::new at line 454, avg 9µs/call
{ my %normalized_args;
148279µs while( my $key= shift )
14832335µs { $key= join '', map { ucfirst } split /_/, $key;
1484 #$key= "Twig".$key unless( substr( $key, 0, 4) eq 'Twig');
1485238µs $normalized_args{$key}= shift ;
1486 }
1487714µs return %normalized_args;
1488 }
1489
1490sub _is_fh { return unless $_[0]; return $_[0] if( isa( $_[0], 'GLOB') || isa( $_[0], 'IO::Scalar')); }
1491
1492sub _set_handler
1493217µs
# spent 8.48ms (382µs+8.10) within XML::Twig::_set_handler which was called 21 times, avg 404µs/call: # 11 times (212µs+5.88ms) by XML::Twig::_set_handlers at line 1863, avg 553µs/call # 10 times (170µs+2.22ms) by XML::Twig::setTwigRoots at line 1937, avg 239µs/call
{ my( $handlers, $whole_path, $handler)= @_;
1494
149521106µs4264µs my $H_SPECIAL = qr{($ALL|$DEFAULT|$COMMENT|$TEXT)};
# spent 51µs making 21 calls to CORE::regcomp, avg 2µs/call # spent 13µs making 21 calls to CORE::qr, avg 638ns/call
14962174µs4244µs my $H_PI = qr{(\?|$PI)\s*(([^\s]*)\s*)};
# spent 39µs making 21 calls to CORE::regcomp, avg 2µs/call # spent 4µs making 21 calls to CORE::qr, avg 214ns/call
14972118µs215µs my $H_LEVEL = qr{level \s* \( \s* ([0-9]+) \s* \)}x;
# spent 5µs making 21 calls to CORE::qr, avg 229ns/call
14982118µs214µs my $H_REGEXP = qr{\(\?([\^xism]*)(-[\^xism]*)?:(.*)\)}x;
# spent 4µs making 21 calls to CORE::qr, avg 214ns/call
149921729µs42697µs my $H_XPATH = qr{(/?/?$REG_TAG_PART? \s* ($REG_PREDICATE\s*)?)+}x;
# spent 692µs making 21 calls to CORE::regcomp, avg 33µs/call # spent 5µs making 21 calls to CORE::qr, avg 229ns/call
1500
1501212µs my $prev_handler;
1502
1503214µs my $cpath= $whole_path;
1504 #warn "\$cpath: '$cpath\n";
150521963µs42914µs while( $cpath && $cpath=~ s{^\s*($H_SPECIAL|$H_PI|$H_LEVEL|$H_REGEXP|$H_XPATH)\s*($|\|)}{})
# spent 792µs making 21 calls to CORE::regcomp, avg 38µs/call # spent 122µs making 21 calls to CORE::subst, avg 6µs/call
15062115µs { my $path= $1;
1507 #warn "\$cpath: '$cpath' - $path: '$path'\n";
15082113µs $prev_handler ||= $handlers->{handlers}->{string}->{$path} || undef; # $prev_handler gets the first found handler
1509
15102164µs1056.37ms _set_special_handler ( $handlers, $path, $handler, $prev_handler)
# spent 6.12ms making 21 calls to XML::Twig::_set_xpath_handler, avg 292µs/call # spent 92µs making 21 calls to XML::Twig::_set_pi_handler, avg 4µs/call # spent 88µs making 21 calls to XML::Twig::_set_special_handler, avg 4µs/call # spent 36µs making 21 calls to XML::Twig::_set_level_handler, avg 2µs/call # spent 32µs making 21 calls to XML::Twig::_set_regexp_handler, avg 2µs/call
1511 || _set_pi_handler ( $handlers, $path, $handler, $prev_handler)
1512 || _set_level_handler ( $handlers, $path, $handler, $prev_handler)
1513 || _set_regexp_handler ( $handlers, $path, $handler, $prev_handler)
1514 || _set_xpath_handler ( $handlers, $path, $handler, $prev_handler)
1515 || croak "unrecognized expression in handler: '$whole_path'";
1516
1517 # this both takes care of the simple (gi) handlers and store
1518 # the handler code reference for other handlers
15192121µs $handlers->{handlers}->{string}->{$path}= $handler;
1520 }
1521
1522212µs if( $cpath) { croak "unrecognized expression in handler: '$whole_path'"; }
1523
15242149µs return $prev_handler;
1525 }
1526
1527
1528sub _set_special_handler
1529217µs
# spent 88µs (48+40) within XML::Twig::_set_special_handler which was called 21 times, avg 4µs/call: # 21 times (48µs+40µs) by XML::Twig::_set_handler at line 1510, avg 4µs/call
{ my( $handlers, $path, $handler, $prev_handler)= @_;
15302164µs2240µs if( $path =~ m{^\s*($ALL|$DEFAULT|$COMMENT|$TEXT)\s*$}io )
# spent 24µs making 1 call to CORE::regcomp # spent 16µs making 21 calls to CORE::match, avg 786ns/call
1531 { $handlers->{handlers}->{$1}= $handler;
1532 return 1;
1533 }
1534 else
15352124µs { return 0; }
1536 }
1537
1538sub _set_xpath_handler
1539214µs
# spent 6.12ms (94µs+6.03) within XML::Twig::_set_xpath_handler which was called 21 times, avg 292µs/call: # 21 times (94µs+6.03ms) by XML::Twig::_set_handler at line 1510, avg 292µs/call
{ my( $handlers, $path, $handler, $prev_handler)= @_;
15402114µs215.96ms if( my $handler_data= _parse_xpath_handler( $path, $handler))
# spent 5.96ms making 21 calls to XML::Twig::_parse_xpath_handler, avg 284µs/call
15412120µs2172µs { _add_handler( $handlers, $handler_data, $path, $prev_handler);
# spent 72µs making 21 calls to XML::Twig::_add_handler, avg 3µs/call
15422128µs return 1;
1543 }
1544 else
1545 { return 0; }
1546 }
1547
1548sub _add_handler
15492110µs
# spent 72µs within XML::Twig::_add_handler which was called 21 times, avg 3µs/call: # 21 times (72µs+0s) by XML::Twig::_set_xpath_handler at line 1541, avg 3µs/call
{ my( $handlers, $handler_data, $path, $prev_handler)= @_;
1550
1551217µs my $tag= $handler_data->{tag};
15522111µs my @handlers= $handlers->{xpath_handler}->{$tag} ? @{$handlers->{xpath_handler}->{$tag}} : ();
1553
1554212µs if( $prev_handler) { @handlers= grep { $_->{path} ne $path } @handlers; }
1555
15562110µs push @handlers, $handler_data if( $handler_data->{handler});
1557
1558217µs if( @handlers > 1)
1559 { @handlers= sort { (($b->{score}->{type} || 0) <=> ($a->{score}->{type} || 0))
1560 || (($b->{score}->{anchored} || 0) <=> ($a->{score}->{anchored} || 0))
1561 || (($b->{score}->{steps} || 0) <=> ($a->{score}->{steps} || 0))
1562 || (($b->{score}->{predicates} || 0) <=> ($a->{score}->{predicates} || 0))
1563 || (($b->{score}->{tests} || 0) <=> ($a->{score}->{tests} || 0))
1564 || ($a->{path} cmp $b->{path})
1565 } @handlers;
1566 }
1567
15682131µs $handlers->{xpath_handler}->{$tag}= \@handlers;
1569 }
1570
1571sub _set_pi_handler
1572214µs
# spent 92µs (48+44) within XML::Twig::_set_pi_handler which was called 21 times, avg 4µs/call: # 21 times (48µs+44µs) by XML::Twig::_set_handler at line 1510, avg 4µs/call
{ my( $handlers, $path, $handler, $prev_handler)= @_;
1573 # PI conditions ( '?target' => \&handler or '?' => \&handler
1574 # or '#PItarget' => \&handler or '#PI' => \&handler)
15752174µs4244µs if( $path=~ /^\s*(?:\?|$PI)\s*(?:([^\s]*)\s*)$/)
# spent 36µs making 21 calls to CORE::regcomp, avg 2µs/call # spent 8µs making 21 calls to CORE::match, avg 381ns/call
1576 { my $target= $1 || '';
1577 # update the path_handlers count, knowing that
1578 # either the previous or the new handler can be undef
1579 $handlers->{pi_handlers}->{$1}= $handler;
1580 return 1;
1581 }
1582 else
15832120µs { return 0;
1584 }
1585 }
1586
1587sub _set_level_handler
1588214µs
# spent 36µs (31+4) within XML::Twig::_set_level_handler which was called 21 times, avg 2µs/call: # 21 times (31µs+4µs) by XML::Twig::_set_handler at line 1510, avg 2µs/call
{ my( $handlers, $path, $handler, $prev_handler)= @_;
15892120µs214µs if( $path =~ m{^ \s* level \s* \( \s* ([0-9]+) \s* \) \s* $}ox )
# spent 4µs making 21 calls to CORE::match, avg 210ns/call
1590 { my $level= $1;
1591 my $sub= sub { my( $stack)= @_; return( ($stack->[-1]->{$ST_TAG} !~ m{^#}) && (scalar @$stack == $level + 1) ) };
1592 my $handler_data= { tag=> '*', score => { type => $LEVEL_TRIGGER}, trigger => $sub,
1593 path => $path, handler => $handler, test_on_text => 0
1594 };
1595 _add_handler( $handlers, $handler_data, $path, $prev_handler);
1596 return 1;
1597 }
1598 else
15992118µs { return 0; }
1600 }
1601
1602sub _set_regexp_handler
1603214µs
# spent 32µs (29+3) within XML::Twig::_set_regexp_handler which was called 21 times, avg 2µs/call: # 21 times (29µs+3µs) by XML::Twig::_set_handler at line 1510, avg 2µs/call
{ my( $handlers, $path, $handler, $prev_handler)= @_;
1604 # if the expression was a regexp it is now a string (it was stringified when it became a hash key)
16052117µs213µs if( $path=~ m{^\(\?([\^xism]*)(?:-[\^xism]*)?:(.*)\)$})
# spent 3µs making 21 calls to CORE::match, avg 133ns/call
1606 { my $regexp= qr/(?$1:$2)/; # convert it back into a regexp
1607 my $sub= sub { my( $stack)= @_; return( $stack->[-1]->{$ST_TAG} =~ $regexp ) };
1608 my $handler_data= { tag=> '*', score => { type => $REGEXP_TRIGGER} , trigger => $sub,
1609 path => $path, handler => $handler, test_on_text => 0
1610 };
1611 _add_handler( $handlers, $handler_data, $path, $prev_handler);
1612 return 1;
1613 }
1614 else
16152116µs { return 0; }
1616 }
1617
16181100nsmy $DEBUG_HANDLER= 0; # 0 or 1 (output the handler checking code) or 2 (super verbose)
16191100nsmy $handler_string; # store the handler itself
1620sub _set_debug_handler { $DEBUG_HANDLER= shift; }
1621sub _warn_debug_handler { if( $DEBUG_HANDLER < 3) { warn @_; } else { $handler_string .= join( '', @_); } }
1622sub _return_debug_handler { my $string= $handler_string; $handler_string=''; return $string; }
1623
1624sub _parse_xpath_handler
1625215µs
# spent 5.96ms (3.22+2.74) within XML::Twig::_parse_xpath_handler which was called 21 times, avg 284µs/call: # 21 times (3.22ms+2.74ms) by XML::Twig::_set_xpath_handler at line 1540, avg 284µs/call
{ my( $xpath, $handler)= @_;
1626214µs my $xpath_original= $xpath;
1627
1628
1629213µs if( $DEBUG_HANDLER >=1) { _warn_debug_handler( "\n\nparsing path '$xpath'\n"); }
1630
1631213µs my $path_to_check= $xpath;
163221814µs42777µs $path_to_check=~ s{/?/?$REG_TAG_PART?\s*(?:$REG_PREDICATE\s*)?}{}g;
# spent 689µs making 21 calls to CORE::regcomp, avg 33µs/call # spent 87µs making 21 calls to CORE::subst, avg 4µs/call
1633213µs if( $DEBUG_HANDLER && $path_to_check=~ /\S/) { _warn_debug_handler( "left: $path_to_check\n"); }
16342121µs212µs return if( $path_to_check=~ /\S/);
# spent 2µs making 21 calls to CORE::match, avg 105ns/call
1635
16362125µs219µs (my $xpath_to_display= $xpath)=~ s{(["{}'\[\]\@\$])}{\\$1}g;
# spent 9µs making 21 calls to CORE::subst, avg 410ns/call
1637
1638213µs my @xpath_steps;
1639 my $last_token_is_sep;
1640
1641211.06ms421.02ms while( $xpath=~ s{^\s*
# spent 989µs making 21 calls to CORE::regcomp, avg 47µs/call # spent 32µs making 21 calls to CORE::subst, avg 2µs/call
1642 {}x
1643 | (?:$REG_TAG_PART\s*(?:$REG_PREDICATE\s*)?) # tag name and optional predicate
1644 | (?:$REG_PREDICATE) # just a predicate
1645 )
1646 }
1647
1648 )
1649 { # check that we have alternating separators and steps
16503311µs if( $2) # found a separator
16516700ns { if( $last_token_is_sep) { return 0; } # 2 separators in a row
16526700ns $last_token_is_sep= 1;
1653 }
1654 else
1655276µs { if( defined( $last_token_is_sep) && !$last_token_is_sep) { return 0; } # 2 steps in a row
1656274µs $last_token_is_sep= 0;
1657 }
1658
165933119µs6646µs push @xpath_steps, $1;
# spent 31µs making 33 calls to CORE::regcomp, avg 948ns/call # spent 14µs making 33 calls to CORE::subst, avg 439ns/call
1660 }
1661212µs if( $last_token_is_sep) { return 0; } # expression cannot end with a separator
1662
1663213µs my $i=-1;
1664
16652129µs2129µs my $perlfunc= _join_n( $NO_WARNINGS . ';',
# spent 29µs making 21 calls to XML::Twig::_join_n, avg 1µs/call
1666 q|my( $stack)= @_; |,
1667 q|my @current_elts= (scalar @$stack); |,
1668 q|my @new_current_elts; |,
1669 q|my $elt; |,
1670 ($DEBUG_HANDLER >= 1) && (qq#warn q{checking path '$xpath_to_display'\n};#),
1671 );
1672
1673
1674213µs my $last_tag='';
16752126µs218µs my $anchored= $xpath_original=~ m{^\s*/(?!/)} ? 1 : 0;
# spent 8µs making 21 calls to CORE::match, avg 400ns/call
16762118µs my $score={ type => $XPATH_TRIGGER, anchored => $anchored };
1677219µs my $flag= { test_on_text => 0 };
1678213µs my $sep='/'; # '/' or '//'
16792121µs while( my $xpath_step= pop @xpath_steps)
168027381µs54331µs { my( $tag, $predicate)= $xpath_step =~ m{^($REG_TAG_PART)?(?:\[(.*)\])?\s*$};
# spent 292µs making 27 calls to CORE::regcomp, avg 11µs/call # spent 39µs making 27 calls to CORE::match, avg 1µs/call
16812710µs $score->{steps}++;
1682273µs $tag||='*';
1683
1684276µs my $warn_empty_stack= $DEBUG_HANDLER >= 2 ? qq{warn "return with empty stack\\n";} : '';
1685
1686273µs if( $predicate)
1687 { if( $DEBUG_HANDLER >= 2) { _warn_debug_handler( "predicate is: '$predicate'\n"); }
1688 # changes $predicate (from an XPath expression to a Perl one)
1689 if( $predicate=~ m{^\s*$REG_NUMBER\s*$}) { croak "position selector [$predicate] not supported on twig_handlers"; }
1690 _parse_predicate_in_handler( $predicate, $flag, $score);
1691 if( $DEBUG_HANDLER >= 2) { _warn_debug_handler( "predicate becomes: '$predicate'\n"); }
1692 }
1693
16942717µs27120µs my $tag_cond= _tag_cond( $tag);
# spent 120µs making 27 calls to XML::Twig::_tag_cond, avg 4µs/call
16952713µs my $cond= join( " && ", grep { $_ } $tag_cond, $predicate) || 1;
1696
1697273µs if( $css_sel && $tag=~ m{\.}) { $tag=~s{\.[^.]*$}{}; $tag ||='*'; }
16982724µs275µs $tag=~ s{(.)#.+$}{$1};
# spent 5µs making 27 calls to CORE::subst, avg 196ns/call
1699
1700275µs $last_tag ||= $tag;
1701
17022746µs2718µs if( $sep eq '/')
# spent 18µs making 27 calls to XML::Twig::_join_n, avg 667ns/call
1703 {
1704 $perlfunc .= sprintf( _join_n( q#foreach my $current_elt (@current_elts) #,
1705 q# { next if( !$current_elt); #,
1706 q# $current_elt--; #,
1707 q# $elt= $stack->[$current_elt]; #,
1708 q# if( %s) { push @new_current_elts, $current_elt;} #,
1709 q# } #,
1710 ),
1711 $cond
1712 );
1713 }
1714 elsif( $sep eq '//')
1715 {
1716 $perlfunc .= sprintf( _join_n( q#foreach my $current_elt (@current_elts) #,
1717 q# { next if( !$current_elt); #,
1718 q# $current_elt--; #,
1719 q# my $candidate= $current_elt; #,
1720 q# while( $candidate >=0) #,
1721 q# { $elt= $stack->[$candidate]; #,
1722 q# if( %s) { push @new_current_elts, $candidate;} #,
1723 q# $candidate--; #,
1724 q# } #,
1725 q# } #,
1726 ),
1727 $cond
1728 );
1729 }
1730275µs my $warn= $DEBUG_HANDLER >= 2 ? _join_n( qq#warn qq%fail at cond '$cond'%;#) : '';
17312722µs2713µs $perlfunc .= sprintf( _join_n( q#unless( @new_current_elts) { %s return 0; } #,
# spent 13µs making 27 calls to XML::Twig::_join_n, avg 474ns/call
1732 q#@current_elts= @new_current_elts; #,
1733 q#@new_current_elts=(); #,
1734 ),
1735 $warn
1736 );
1737
17382718µs $sep= pop @xpath_steps;
1739 }
1740
1741212µs if( $anchored) # there should be a better way, but this works
1742 {
1743 my $warn= $DEBUG_HANDLER >= 2 ? _join_n( qq#warn qq{fail, stack not empty};#) : '';
1744 $perlfunc .= sprintf( _join_n( q#if( ! grep { $_ == 0 } @current_elts) { %s return 0;}#), $warn);
1745 }
1746
1747213µs $perlfunc.= qq{warn "handler for '$xpath_to_display' triggered\\n";\n} if( $DEBUG_HANDLER >=2);
1748215µs $perlfunc.= qq{return q{$xpath_original};\n};
1749212µs _warn_debug_handler( "\nperlfunc:\n$perlfunc\n") if( $DEBUG_HANDLER>=1);
175021654µs my $s= eval "sub { $perlfunc }";
# spent 269ms executing statements in 2 string evals (merged)
# includes 149ms spent executing 31218 calls to 3 subs defined therein. # spent 246ms executing statements in 2 string evals (merged)
# includes 136ms spent executing 36362 calls to 3 subs defined therein. # spent 374µs executing statements in 4 string evals (merged)
# includes 46µs spent executing 8 calls to 5 subs defined therein. # spent 221µs executing statements in 2 string evals (merged)
# includes 11µs spent executing 2 calls to 3 subs defined therein. # spent 189µs executing statements in 2 string evals (merged)
# includes 24µs spent executing 4 calls to 3 subs defined therein. # spent 186µs executing statements in 2 string evals (merged)
# includes 24µs spent executing 4 calls to 3 subs defined therein. # spent 169µs executing statements in 2 string evals (merged)
# includes 12µs spent executing 2 calls to 3 subs defined therein. # spent 169µs executing statements in 2 string evals (merged)
# includes 13µs spent executing 2 calls to 3 subs defined therein. # spent 166µs executing statements in 2 string evals (merged)
# includes 12µs spent executing 2 calls to 3 subs defined therein. # spent 146µs executing statements in string eval
# includes 47µs spent executing 16 calls to 2 subs defined therein.
1751213µs if( $@)
1752 { croak "wrong handler condition '$xpath' ($@);" }
1753
1754214µs _warn_debug_handler( "last tag: '$last_tag', test_on_text: '$flag->{test_on_text}'\n") if( $DEBUG_HANDLER >=1);
1755212µs _warn_debug_handler( "score: ", join( ' ', map { "$_: $score->{$_}" } sort keys %$score), "\n") if( $DEBUG_HANDLER >=1);
175621111µs return { tag=> $last_tag, score => $score, trigger => $s, path => $xpath_original, handler => $handler, test_on_text => $flag->{test_on_text} };
1757 }
1758
17597586µs
# spent 60µs within XML::Twig::_join_n which was called 75 times, avg 796ns/call: # 27 times (18µs+0s) by XML::Twig::_parse_xpath_handler at line 1702, avg 667ns/call # 27 times (13µs+0s) by XML::Twig::_parse_xpath_handler at line 1731, avg 474ns/call # 21 times (29µs+0s) by XML::Twig::_parse_xpath_handler at line 1665, avg 1µs/call
sub _join_n { return join( "\n", @_, ''); }
1760
1761# the "tag" part can be <tag>, <tag>.<class> or <tag>#<id> (where tag can be *, or start with # for hidden tags)
1762sub _tag_cond
1763275µs
# spent 120µs (117+3) within XML::Twig::_tag_cond which was called 27 times, avg 4µs/call: # 27 times (117µs+3µs) by XML::Twig::_parse_xpath_handler at line 1694, avg 4µs/call
{ my( $full_tag)= @_;
1764
1765273µs my( $tag, $class, $id);
17662727µs273µs if( $full_tag=~ m{^(.+)#(.+)$})
# spent 3µs making 27 calls to CORE::match, avg 115ns/call
1767 { ($tag, $id)= ($1, $2); } # <tag>#<id>
1768 else
1769278µs { ( $tag, $class)= $css_sel ? $full_tag=~ m{^(.*?)(?:\.([^.]*))?$} : ($full_tag, undef); }
1770
17712715µs my $tag_cond = $tag && $tag ne '*' ? qq#(\$elt->{'$ST_TAG'} eq "$tag")# : '';
1772275µs my $id_cond = defined $id ? qq#(\$elt->{id} eq "$id")# : '';
1773274µs my $class_cond = defined $class ? qq#(\$elt->{class}=~ m{(^| )$class( |\$)})# : '';
1774
17752734µs my $full_cond= join( ' && ', grep { $_ } ( $tag_cond, $class_cond, $id_cond));
1776
17772729µs return $full_cond;
1778 }
1779
1780# input: the predicate ($_[0]) which will be changed in place
1781# flags, a hashref with various flags (like test_on_text)
1782# the score
1783sub _parse_predicate_in_handler
1784 { my( $flag, $score)= @_[1..2];
1785 $_[0]=~ s{( ($REG_STRING) # strings
1786 { my( $token, $str, $att_re_name, $att_re_regexp, $att, $bare_att, $num_test, $alpha_test, $func, $str_regexp, $str_test_alpha, $str_test_num, $and_or, $tag)
1787 = ( $1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14);
1788
1789 $score->{predicates}++;
1790
1791 # store tests on text (they are not always allowed)
1792 if( $func || $str_regexp || $str_test_num || $str_test_alpha ) { $flag->{test_on_text}= 1; }
1793
1794 if( defined $str) { $token }
1795 elsif( $tag) { qq{(\$elt->{'$ST_ELT'} && \$elt->{'$ST_ELT'}->has_child( '$tag'))} }
1796 elsif( $att) { $att=~ m{^#} ? qq{ (\$elt->{'$ST_ELT'} && \$elt->{'$ST_ELT'}->{att}->{'$att'})}
1797 : qq{\$elt->{'$att'}}
1798 }
1799 elsif( $att_re_name) { $att_re_name=~ m{^#} ? qq{ (\$elt->{'$ST_ELT'} && \$elt->{'$ST_ELT'}->{att}->{'$att_re_name'}$att_re_regexp)}
1800 : qq{\$elt->{'$att_re_name'}$att_re_regexp}
1801 }
1802 # for some reason Devel::Cover flags the following lines as not tested. They are though.
1803 elsif( $bare_att) { $bare_att=~ m{^#} ? qq{(\$elt->{'$ST_ELT'} && defined(\$elt->{'$ST_ELT'}->{att}->{'$bare_att'}))}
1804 : qq{defined( \$elt->{'$bare_att'})}
1805 }
1806 elsif( $num_test && ($num_test eq '=') ) { "==" } # others tests are unchanged
1807 elsif( $alpha_test) { $PERL_ALPHA_TEST{$alpha_test} }
1808 elsif( $func && $func=~ m{^string})
1809 { "\$elt->{'$ST_ELT'}->text"; }
1810 elsif( $str_regexp && $str_regexp =~ m{string\(\s*($REG_TAG_NAME)\s*\)\s*($REG_MATCH)\s*($REG_REGEXP)})
1811 { "defined( _first_n { \$_->text $2 $3 } 1, \$elt->{'$ST_ELT'}->_children( '$1'))"; }
1812 elsif( $str_test_alpha && $str_test_alpha =~ m{string\(\s*($REG_TAG_NAME)\s*\)\s*($REG_COMP)\s*($REG_STRING)})
1813 { my( $tag, $op, $str)= ($1, $2, $3);
1814 $str=~ s{(?<=.)'(?=.)}{\\'}g; # escape a quote within the string
1815 $str=~ s{^"}{'};
1816 $str=~ s{"$}{'};
1817 "defined( _first_n { \$_->text $PERL_ALPHA_TEST{$op} $str } 1, \$elt->{'$ST_ELT'}->children( '$tag'))"; }
1818 elsif( $str_test_num && $str_test_num =~ m{string\(\s*($REG_TAG_NAME)\s*\)\s*($REG_COMP)\s*($REG_NUMBER)})
1819 { my $test= ($2 eq '=') ? '==' : $2;
1820 "defined( _first_n { \$_->text $test $3 } 1, \$elt->{'$ST_ELT'}->children( '$1'))";
1821 }
1822 elsif( $and_or) { $score->{tests}++; $and_or eq 'and' ? '&&' : '||' ; }
1823 else { $token; }
1824 }gexs;
1825
- -
1841 }
1842
1843
1844sub setCharHandler
1845 { my( $t, $handler)= @_;
1846 $t->{twig_char_handler}= $handler;
1847 }
1848
1849
1850sub _reset_handlers
185122µs
# spent 6µs within XML::Twig::_reset_handlers which was called 2 times, avg 3µs/call: # once (4µs+0s) by XML::Twig::setTwigHandlers at line 1878 # once (2µs+0s) by XML::Twig::setTwigRoots at line 1929
{ my $handlers= shift;
18522700ns delete $handlers->{handlers};
18532300ns delete $handlers->{path_handlers};
18542500ns delete $handlers->{subpath_handlers};
18552500ns $handlers->{attcond_handlers_exp}=[] if( $handlers->{attcond_handlers});
185624µs delete $handlers->{attcond_handlers};
1857 }
1858
1859sub _set_handlers
18602600ns
# spent 6.11ms (22µs+6.09) within XML::Twig::_set_handlers which was called 2 times, avg 3.05ms/call: # once (6µs+3.79ms) by XML::Twig::setTwigHandlers at line 1879 # once (16µs+2.29ms) by XML::Twig::setTwigRoots at line 1930
{ my $handlers= shift || return;
18612300ns my $set_handlers= {};
186222µs foreach my $path (keys %{$handlers})
18631111µs116.09ms { _set_handler( $set_handlers, $path, $handlers->{$path}); }
# spent 6.09ms making 11 calls to XML::Twig::_set_handler, avg 553µs/call
1864
186523µs return $set_handlers;
1866 }
1867
1868
1869sub setTwigHandler
1870 { my( $t, $path, $handler)= @_;
1871 $t->{twig_handlers} ||={};
1872 return _set_handler( $t->{twig_handlers}, $path, $handler);
1873 }
1874
1875sub setTwigHandlers
18761300ns
# spent 3.81ms (8µs+3.80) within XML::Twig::setTwigHandlers which was called: # once (8µs+3.80ms) by XML::Twig::new at line 477
{ my( $t, $handlers)= @_;
18771600ns my $previous_handlers= $t->{twig_handlers} || undef;
187812µs14µs _reset_handlers( $t->{twig_handlers});
# spent 4µs making 1 call to XML::Twig::_reset_handlers
187914µs13.80ms $t->{twig_handlers}= _set_handlers( $handlers);
# spent 3.80ms making 1 call to XML::Twig::_set_handlers
188012µs return $previous_handlers;
1881 }
1882
1883sub setStartTagHandler
1884 { my( $t, $path, $handler)= @_;
1885 $t->{twig_starttag_handlers}||={};
1886 return _set_handler( $t->{twig_starttag_handlers}, $path, $handler);
1887 }
1888
1889sub setStartTagHandlers
1890 { my( $t, $handlers)= @_;
1891 my $previous_handlers= $t->{twig_starttag_handlers} || undef;
1892 _reset_handlers( $t->{twig_starttag_handlers});
1893 $t->{twig_starttag_handlers}= _set_handlers( $handlers);
1894 return $previous_handlers;
1895 }
1896
1897sub setIgnoreEltsHandler
1898 { my( $t, $path, $action)= @_;
1899 $t->{twig_ignore_elts_handlers}||={};
1900 return _set_handler( $t->{twig_ignore_elts_handlers}, $path, $action );
1901 }
1902
1903sub setIgnoreEltsHandlers
1904 { my( $t, $handlers)= @_;
1905 my $previous_handlers= $t->{twig_ignore_elts_handlers};
1906 _reset_handlers( $t->{twig_ignore_elts_handlers});
1907 $t->{twig_ignore_elts_handlers}= _set_handlers( $handlers);
1908 return $previous_handlers;
1909 }
1910
1911sub setEndTagHandler
1912 { my( $t, $path, $handler)= @_;
1913 $t->{twig_endtag_handlers}||={};
1914 return _set_handler( $t->{twig_endtag_handlers}, $path,$handler);
1915 }
1916
1917sub setEndTagHandlers
1918 { my( $t, $handlers)= @_;
1919 my $previous_handlers= $t->{twig_endtag_handlers};
1920 _reset_handlers( $t->{twig_endtag_handlers});
1921 $t->{twig_endtag_handlers}= _set_handlers( $handlers);
1922 return $previous_handlers;
1923 }
1924
1925# a little more complex: set the twig_handlers only if a code ref is given
1926sub setTwigRoots
19271300ns
# spent 4.78ms (61µs+4.72) within XML::Twig::setTwigRoots which was called: # once (61µs+4.72ms) by XML::Twig::new at line 562
{ my( $t, $handlers)= @_;
19281400ns my $previous_roots= $t->{twig_roots};
192912µs12µs _reset_handlers($t->{twig_roots});
# spent 2µs making 1 call to XML::Twig::_reset_handlers
193014µs12.31ms $t->{twig_roots}= _set_handlers( $handlers);
# spent 2.31ms making 1 call to XML::Twig::_set_handlers
1931
193212µs19µs _check_illegal_twig_roots_handlers( $t->{twig_roots});
# spent 9µs making 1 call to XML::Twig::_check_illegal_twig_roots_handlers
1933
193411µs foreach my $path (keys %{$handlers})
19351018µs { $t->{twig_handlers}||= {};
1936 _set_handler( $t->{twig_handlers}, $path, $handlers->{$path})
19371031µs202.40ms if( ref($handlers->{$path}) && isa( $handlers->{$path}, 'CODE'));
# spent 2.39ms making 10 calls to XML::Twig::_set_handler, avg 239µs/call # spent 6µs making 10 calls to UNIVERSAL::isa, avg 600ns/call
1938 }
193912µs return $previous_roots;
1940 }
1941
1942sub _check_illegal_twig_roots_handlers
19431300ns
# spent 9µs within XML::Twig::_check_illegal_twig_roots_handlers which was called: # once (9µs+0s) by XML::Twig::setTwigRoots at line 1932
{ my( $handlers)= @_;
194412µs foreach my $tag_handlers (values %{$handlers->{xpath_handler}})
1945102µs { foreach my $handler_data (@$tag_handlers)
1946103µs { if( my $type= $handler_data->{test_on_text})
1947 { croak "string() condition not supported on twig_roots option"; }
1948 }
1949 }
195012µs return;
1951 }
1952
1953
1954# just store the reference to the expat object in the twig
1955sub _twig_init
1956
# spent 44µs (33+10) within XML::Twig::_twig_init which was called 7 times, avg 6µs/call: # 7 times (33µs+10µs) by XML::Parser::parse at line 182 of XML/Parser.pm, avg 6µs/call
{ # warn " in _twig_init...\n"; # DEBUG handler
1957
195871µs my $p= shift;
195972µs my $t=$p->{twig};
1960
196172µs if( $t->{twig_parsing} ) { croak "cannot reuse a twig that is already parsing"; }
196272µs $t->{twig_parsing}=1;
1963
196472µs $t->{twig_parser}= $p;
1965712µs74µs if( $weakrefs) { weaken( $t->{twig_parser}); }
# spent 4µs making 7 calls to Scalar::Util::weaken, avg 557ns/call
1966
1967 # in case they had been created by a previous parse
196871µs delete $t->{twig_dtd};
196971µs delete $t->{twig_doctype};
19707900ns delete $t->{twig_xmldecl};
19717600ns delete $t->{twig_root};
1972
1973 # if needed set the output filehandle
197476µs76µs $t->_set_fh_to_twig_output_fh();
# spent 6µs making 7 calls to XML::Twig::_set_fh_to_twig_output_fh, avg 929ns/call
197579µs return;
1976 }
1977
1978# uses eval to catch the parser's death
1979sub safe_parse
1980 { my $t= shift;
1981 eval { $t->parse( @_); } ;
1982 return $@ ? $t->_reset_twig_after_error : $t;
1983 }
1984
1985sub safe_parsefile
1986 { my $t= shift;
1987 eval { $t->parsefile( @_); } ;
1988 return $@ ? $t->_reset_twig_after_error : $t;
1989 }
1990
1991# restore a twig in a proper state so it can be reused for a new parse
1992sub _reset_twig
1993 { my $t= shift;
1994 $t->{twig_parsing}= 0;
1995 delete $t->{twig_current};
1996 delete $t->{extra_data};
1997 delete $t->{twig_dtd};
1998 delete $t->{twig_in_pcdata};
1999 delete $t->{twig_in_cdata};
2000 delete $t->{twig_stored_space};
2001 delete $t->{twig_entity_list};
2002 $t->root->delete if( $t->root);
2003 delete $t->{twig_root};
2004 return $t;
2005 }
2006
2007sub _reset_twig_after_error
2008 { my $t= shift;
2009 $t->_reset_twig;
2010 return undef;
2011 }
2012
2013
2014sub _add_or_discard_stored_spaces
201572873886.7ms
# spent 599ms within XML::Twig::_add_or_discard_stored_spaces which was called 728738 times, avg 822ns/call: # 364369 times (309ms+0s) by XML::Twig::_twig_end at line 2307, avg 849ns/call # 364369 times (290ms+0s) by XML::Twig::_twig_start at line 2047, avg 795ns/call
{ my $t= shift;
2016
2017728738119ms $t->{twig_right_after_root}=0; #XX
2018
2019728738118ms my $current= $t->{twig_current} or return; # ugly hack, with ignore on, twig_current can disappear
20207287311.71s return unless length $t->{twig_stored_spaces};
2021 my $current_gi= $XML::Twig::index2gi[$current->{'gi'}];
2022
2023 if( ! $t->{twig_discard_all_spaces})
2024 { if( ! defined( $t->{twig_space_policy}->{$current_gi}))
2025 { $t->{twig_space_policy}->{$current_gi}= _space_policy( $t, $current_gi); }
2026 if( $t->{twig_space_policy}->{$current_gi} || ($t->{twig_stored_spaces}!~ m{\n}) || $t->{twig_preserve_space})
2027 { _insert_pcdata( $t, $t->{twig_stored_spaces} ); }
2028 }
2029
2030 $t->{twig_stored_spaces}='';
2031
2032 return;
2033 }
2034
2035# the default twig handlers, which build the tree
2036sub _twig_start
2037
# spent 35.2s (9.97+25.2) within XML::Twig::_twig_start which was called 364369 times, avg 97µs/call: # 330576 times (9.05s+23.3s) by XML::Parser::Expat::ParseString at line 486 of XML/Parser/Expat.pm, avg 98µs/call # 33792 times (916ms+1.90s) by XML::Twig::_twig_start_check_roots at line 4147, avg 83µs/call # once (33µs+203µs) by XML::Twig::_twig_start_check_roots at line 4162
{ # warn " in _twig_start...\n"; # DEBUG handler
2038
2039 #foreach my $s (@_) { next if ref $s; warn "$s: ", is_utf8( $s) ? "has flag" : "FLAG NOT SET"; } # YYY
2040
2041364369193ms my ($p, $gi, @att)= @_;
204236436963.7ms my $t=$p->{twig};
2043
2044 # empty the stored pcdata (space stored in case they are really part of
2045 # a pcdata element) or stored it if the space policy dictates so
2046 # create a pcdata element with the spaces if need be
2047364369159ms364369290ms _add_or_discard_stored_spaces( $t);
# spent 290ms making 364369 calls to XML::Twig::_add_or_discard_stored_spaces, avg 795ns/call
204836436940.8ms my $parent= $t->{twig_current};
2049
2050 # if we were parsing PCDATA then we exit the pcdata
205136436954.3ms if( $t->{twig_in_pcdata})
2052 { $t->{twig_in_pcdata}= 0;
2053 delete $parent->{'twig_current'};
2054 $parent= $parent->{parent};
2055 }
2056
2057 # if we choose to keep the encoding then we need to parse the tag
205836436997.0ms if( my $func = $t->{parse_start_tag})
2059 { ($gi, @att)= &$func($p->original_string); }
2060 elsif( $t->{twig_entities_in_attribute})
2061 {
2062 ($gi,@att)= _parse_start_tag( $p->recognized_string);
2063 $t->{twig_entities_in_attribute}=0;
2064 }
2065
2066 # if we are using an external DTD, we need to fill the default attributes
206736436948.0ms if( $t->{twig_read_external_dtd}) { _fill_default_atts( $t, $gi, \@att); }
2068
2069 # filter the input data if need be
207036436972.0ms if( my $filter= $t->{twig_input_filter})
2071 { $gi= $filter->( $gi);
2072 foreach my $att (@att) { $att= $filter->($att); }
2073 }
2074
207536436928.0ms my $ns_decl;
2076364369272ms36436919.6s if( $t->{twig_map_xmlns})
# spent 19.6s making 364369 calls to XML::Twig::_replace_ns, avg 54µs/call
2077 { $ns_decl= _replace_ns( $t, \$gi, \@att); }
2078
2079364369340ms3643691.82s my $elt= $t->{twig_elt_class}->new( $gi);
# spent 1.82s making 364369 calls to XML::Twig::Elt::new, avg 5µs/call
2080364369229ms3643691.69s $elt->set_atts( @att);
# spent 1.69s making 364369 calls to XML::Twig::Elt::set_atts, avg 5µs/call
2081
2082 # now we can store the tag and atts
2083364369360ms my $context= { $ST_TAG => $gi, $ST_ELT => $elt, @att};
208436436935.4ms $context->{$ST_NS}= $ns_decl if $ns_decl;
2085364369813ms364369122ms if( $weakrefs) { weaken( $context->{$ST_ELT}); }
# spent 122ms making 364369 calls to Scalar::Util::weaken, avg 334ns/call
2086364369108ms push @{$t->{_twig_context_stack}}, $context;
2087
208836436992.5ms delete $parent->{'twig_current'} if( $parent);
208936436965.4ms $t->{twig_current}= $elt;
209036436978.5ms $elt->{'twig_current'}=1;
2091
209236436971.1ms if( $parent)
209336436261.4ms { my $prev_sibling= $parent->{last_child};
209436436245.9ms if( $prev_sibling)
209518752940.1ms { $prev_sibling->{next_sibling}= $elt;
2096375058355ms18752923.1ms $elt->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ;
# spent 23.1ms making 187529 calls to Scalar::Util::weaken, avg 123ns/call
2097 }
2098
2099728724868ms36436263.4ms $elt->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $elt->{parent});} ;
# spent 63.4ms making 364362 calls to Scalar::Util::weaken, avg 174ns/call
210036436289.6ms unless( $parent->{first_child}) { $parent->{first_child}= $elt; }
21011093086820ms36436276.1ms delete $parent->{empty}; $parent->{last_child}=$elt; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ;
# spent 76.1ms making 364362 calls to Scalar::Util::weaken, avg 209ns/call
2102 }
2103 else
2104 { # processing root
210577µs724µs $t->set_root( $elt);
# spent 24µs making 7 calls to XML::Twig::set_root, avg 3µs/call
2106 # call dtd handler if need be
2107 $t->{twig_dtd_handler}->($t, $t->{twig_dtd})
210872µs if( defined $t->{twig_dtd_handler});
2109
2110 # set this so we can catch external entities
2111 # (the handler was modified during DTD processing)
211276µs19µs if( $t->{twig_default_print})
# spent 9µs making 1 call to XML::Parser::Expat::setHandlers
2113 { $p->setHandlers( Default => \&_twig_print); }
2114 elsif( $t->{twig_roots})
2115 { $p->setHandlers( Default => sub { return }); }
2116 else
211765µs630µs { $p->setHandlers( Default => \&_twig_default); }
# spent 30µs making 6 calls to XML::Parser::Expat::setHandlers, avg 5µs/call
2118 }
2119
21203643691.08s7287381.53s $elt->{empty}= $p->recognized_string=~ m{/\s*>$}s ? 1 : 0;
# spent 1.31s making 364369 calls to XML::Parser::Expat::recognized_string, avg 4µs/call # spent 216ms making 364369 calls to CORE::match, avg 593ns/call
2121
212236436959.7ms $elt->{extra_data}= $t->{extra_data} if( $t->{extra_data});
212336436977.8ms $t->{extra_data}='';
2124
2125 # if the element is ID-ed then store that info
212636436966.5ms my $id= $elt->{'att'}->{$ID};
212736436950.2ms if( defined $id)
2128 { $t->{twig_id_list}->{$id}= $elt;
2129 if( $weakrefs) { weaken( $t->{twig_id_list}->{$id}); }
2130 }
2131
2132 # call user handler if need be
213336436954.6ms if( $t->{twig_starttag_handlers})
2134 { # call all appropriate handlers
2135 my @handlers= _handler( $t, $t->{twig_starttag_handlers}, $gi);
2136
2137 local $_= $elt;
2138
2139 foreach my $handler ( @handlers)
2140 { $handler->($t, $elt) || last; }
2141 # call _all_ handler if needed
2142 if( my $all= $t->{twig_starttag_handlers}->{handlers}->{$ALL})
2143 { $all->($t, $elt); }
2144 }
2145
2146 # check if the tag is in the list of tags to be ignored
214736436951.6ms if( $t->{twig_ignore_elts_handlers})
2148 { my @handlers= _handler( $t, $t->{twig_ignore_elts_handlers}, $gi);
2149 # only the first handler counts, it contains the action (discard/print/string)
2150 if( @handlers) { my $action= shift @handlers; $t->ignore( $elt, $action); }
2151 }
2152
215336436952.7ms if( $elt->{'att'}->{'xml:space'} && ( $elt->{'att'}->{'xml:space'} eq 'preserve')) { $t->{twig_preserve_space}++; }
2154
2155
2156364369847ms return;
2157 }
2158
2159sub _replace_ns
216039816771.4ms
# spent 22.1s (5.90+16.2) within XML::Twig::_replace_ns which was called 398167 times, avg 55µs/call: # 364369 times (5.31s+14.3s) by XML::Twig::_twig_start at line 2076, avg 54µs/call # 33798 times (587ms+1.91s) by XML::Twig::_twig_start_check_roots at line 4134, avg 74µs/call
{ my( $t, $gi, $atts)= @_;
216139816728.6ms my $decls;
2162398167474ms796334396ms foreach my $new_prefix ( $t->parser->new_ns_prefixes)
# spent 243ms making 398167 calls to XML::Parser::Expat::new_ns_prefixes, avg 611ns/call # spent 153ms making 398167 calls to XML::Twig::parser, avg 383ns/call
21632824µs5640µs { my $uri= $t->parser->expand_ns_prefix( $new_prefix);
# spent 33µs making 28 calls to XML::Parser::Expat::expand_ns_prefix, avg 1µs/call # spent 7µs making 28 calls to XML::Twig::parser, avg 243ns/call
2164 # replace the prefix if it is mapped
21652811µs $decls->{$new_prefix}= $uri;
2166285µs if( !$t->{twig_keep_original_prefix} && (my $mapped_prefix= $t->{twig_map_xmlns}->{$uri}))
2167 { $new_prefix= $mapped_prefix; }
2168 # now put the namespace declaration back in the element
21692816µs if( $new_prefix eq '#default')
2170 { push @$atts, "xmlns" => $uri; }
2171 else
21722211µs { push @$atts, "xmlns:$new_prefix" => $uri; }
2173 }
2174
217539816792.8ms if( $t->{twig_keep_original_prefix})
2176 { # things become more complex: we need to find the original prefix
2177 # and store both prefixes
2178398167251ms39816711.3s my $ns_info= $t->_ns_info( $$gi);
# spent 11.3s making 398167 calls to XML::Twig::_ns_info, avg 28µs/call
217939816728.1ms my $map_att;
2180398167104ms if( $ns_info->{mapped_prefix})
2181364375151ms { $$gi= "$ns_info->{mapped_prefix}:$$gi";
2182364375170ms $map_att->{$ns_info->{mapped_prefix}}= $ns_info->{prefix};
2183 }
218439816746.5ms my $att_name=1;
2185398167148ms foreach( @$atts)
21861395024399ms { if( $att_name)
2187 {
2188697512272ms6975124.50s my $ns_info= $t->_ns_info( $_);
# spent 4.50s making 697512 calls to XML::Twig::_ns_info, avg 6µs/call
218969751276.6ms if( $ns_info->{mapped_prefix})
2190156208.03ms { $_= "$ns_info->{mapped_prefix}:$_";
2191156209.58ms $map_att->{$ns_info->{mapped_prefix}}= $ns_info->{prefix};
2192 }
2193697512168ms $att_name=0;
2194 }
2195 else
219669751250.5ms { $att_name=1; }
2197 }
2198398167227ms push @$atts, '#original_gi', $map_att if( $map_att);
2199 }
2200 else
2201 { $$gi= $t->_replace_prefix( $$gi);
2202 my $att_name=1;
2203 foreach( @$atts)
2204 { if( $att_name) { $_= $t->_replace_prefix( $_); $att_name=0; }
2205 else { $att_name=1; }
2206 }
2207 }
2208398167785ms return $decls;
2209 }
2210
2211
2212# extract prefix, local_name, uri, mapped_prefix from a name
2213# will only work if called from a start or end tag handler
2214sub _ns_info
22151095679164ms
# spent 15.8s (6.34+9.44) within XML::Twig::_ns_info which was called 1095679 times, avg 14µs/call: # 697512 times (3.26s+1.24s) by XML::Twig::_replace_ns at line 2188, avg 6µs/call # 398167 times (3.09s+8.20s) by XML::Twig::_replace_ns at line 2178, avg 28µs/call
{ my( $t, $name)= @_;
2216109567987.4ms my $ns_info={};
22171095679414ms1095679254ms my $p= $t->parser;
# spent 254ms making 1095679 calls to XML::Twig::parser, avg 231ns/call
22181095679631ms10956791.29s $ns_info->{uri}= $p->namespace( $name);
# spent 1.29s making 1095679 calls to XML::Parser::Expat::namespace, avg 1µs/call
221910956791.40s return $ns_info unless( $ns_info->{uri});
2220
2221379995331ms3799957.90s $ns_info->{prefix}= _a_proper_ns_prefix( $p, $ns_info->{uri});
# spent 7.90s making 379995 calls to XML::Twig::_a_proper_ns_prefix, avg 21µs/call
2222379995234ms $ns_info->{mapped_prefix}= $t->{twig_map_xmlns}->{$ns_info->{uri}} || $ns_info->{prefix};
2223
2224379995688ms return $ns_info;
2225 }
2226
2227sub _a_proper_ns_prefix
222838000167.4ms
# spent 7.90s (5.08+2.82) within XML::Twig::_a_proper_ns_prefix which was called 380001 times, avg 21µs/call: # 379995 times (5.08s+2.82s) by XML::Twig::_ns_info at line 2221, avg 21µs/call # 6 times (37µs+48µs) by XML::Twig::_replace_prefix at line 2434, avg 14µs/call
{ my( $p, $uri)= @_;
2229380001226ms3800011.51s foreach my $prefix ($p->current_ns_prefixes)
# spent 1.51s making 380001 calls to XML::Parser::Expat::current_ns_prefixes, avg 4µs/call
223015206611.66s15206611.31s { if( $p->expand_ns_prefix( $prefix) eq $uri)
# spent 1.31s making 1520661 calls to XML::Parser::Expat::expand_ns_prefix, avg 864ns/call
2231 { return $prefix; }
2232 }
2233 return;
2234 }
2235
2236# returns the uri bound to a prefix in the original document
2237# only works in a handler
2238# can be used to deal with xsi:type attributes
2239sub original_uri
2240 { my( $t, $prefix)= @_;
2241 my $ST_NS = '##ns' ;
2242 foreach my $ns (map { $_->{$ST_NS} if $_->{$ST_NS} } reverse @{$t->{_twig_context_stack}})
2243 { return $ns->{$prefix} || next; }
2244 return;
2245 }
2246
2247
2248sub _fill_default_atts
2249 { my( $t, $gi, $atts)= @_;
2250 my $dtd= $t->{twig_dtd};
2251 my $attlist= $dtd->{att}->{$gi};
2252 my %value= @$atts;
2253 foreach my $att (keys %$attlist)
2254 { if( !exists( $value{$att})
2255 && exists( $attlist->{$att}->{default})
2256 && ( $attlist->{$att}->{default} ne '#IMPLIED')
2257 )
2258 { # the quotes are included in the default, so we need to remove them
2259 my $default_value= substr( $attlist->{$att}->{default}, 1, -1);
2260 push @$atts, $att, $default_value;
2261 }
2262 }
2263 return;
2264 }
2265
2266
2267# the default function to parse a start tag (in keep_encoding mode)
2268# can be overridden with the parse_start_tag method
2269# only works for 1-byte character sets
2270sub _parse_start_tag
2271 { my $string= shift;
2272 my( $gi, @atts);
2273
2274 # get the gi (between < and the first space, / or > character)
2275 #if( $string=~ s{^<\s*([^\s>/]*)[\s>/]*}{}s)
2276 if( $string=~ s{^<\s*($REG_TAG_NAME)\s*[\s>/]}{}s)
2277 { $gi= $1; }
2278 else
2279 { croak "error parsing tag '$string'"; }
2280 while( $string=~ s{^([^\s=]*)\s*=\s*(["'])(.*?)\2\s*}{}s)
2281 { push @atts, $1, $3; }
2282 return $gi, @atts;
2283 }
2284
2285sub set_root
228672µs
# spent 24µs (22+2) within XML::Twig::set_root which was called 7 times, avg 3µs/call: # 7 times (22µs+2µs) by XML::Twig::_twig_start at line 2105, avg 3µs/call
{ my( $t, $elt)= @_;
228773µs $t->{twig_root}= $elt;
228872µs if( $elt)
228973µs { $elt->{twig}= $t;
2290711µs72µs if( $weakrefs) { weaken( $elt->{twig}); }
# spent 2µs making 7 calls to Scalar::Util::weaken, avg 329ns/call
2291 }
229279µs return $t;
2293 }
2294
2295sub _twig_end
2296
# spent 25.4s (5.66+19.7) within XML::Twig::_twig_end which was called 364369 times, avg 70µs/call: # 364368 times (5.66s+19.7s) by XML::Parser::Expat::ParseString at line 486 of XML/Parser/Expat.pm, avg 70µs/call # once (11µs+10µs) by XML::Twig::_twig_end_check_roots at line 4216
{ # warn " in _twig_end...\n"; # DEBUG handler
229736436959.5ms my ($p, $gi) = @_;
2298
229936436962.8ms my $t=$p->{twig};
2300
230136436990.0ms if( $t->{twig_in_pcdata} && (my $text_handler= $t->{TwigHandlers}->{$TEXT}) )
2302 { local $_= $t->{twig_current}; $text_handler->( $t, $_) if $_;
2303 }
2304
2305364369233ms3643692.69s if( $t->{twig_map_xmlns}) { $gi= $t->_replace_prefix( $gi); }
# spent 2.69s making 364369 calls to XML::Twig::_replace_prefix, avg 7µs/call
2306
2307364369156ms364369309ms _add_or_discard_stored_spaces( $t);
# spent 309ms making 364369 calls to XML::Twig::_add_or_discard_stored_spaces, avg 849ns/call
2308
2309 # the new twig_current is the parent
231036436945.4ms my $elt= $t->{twig_current};
231136436952.8ms delete $elt->{'twig_current'};
2312
2313 # if we were parsing PCDATA then we exit the pcdata too
231436436971.4ms if( $t->{twig_in_pcdata})
2315 {
231612729219.8ms $t->{twig_in_pcdata}= 0;
231712729231.3ms $elt= $elt->{parent} if($elt->{parent});
231812729218.4ms delete $elt->{'twig_current'};
2319 }
2320
2321 # parent is the new current element
232236436948.0ms my $parent= $elt->{parent};
232336436945.0ms $t->{twig_current}= $parent;
2324
232536436962.2ms if( $parent)
232636436272.2ms { $parent->{'twig_current'}=1;
2327 # twig_to_be_normalized
232836436259.3ms if( $parent->{twig_to_be_normalized}) { $parent->normalize; $parent->{twig_to_be_normalized}=0; }
2329 }
2330
233136436947.4ms if( $t->{extra_data})
2332 { $elt->_set_extra_data_before_end_tag( $t->{extra_data});
2333 $t->{extra_data}='';
2334 }
2335
233636436982.5ms if( $t->{twig_handlers})
2337 { # look for handlers
2338364007205ms3640071.05s my @handlers= _handler( $t, $t->{twig_handlers}, $gi);
# spent 1.05s making 364007 calls to XML::Twig::_handler, avg 3µs/call
2339
2340364007117ms if( $t->{twig_tdh})
2341 { if( @handlers) { push @{$t->{twig_handlers_to_trigger}}, [ $elt, \@handlers ]; }
2342 if( my $all= $t->{twig_handlers}->{handlers}->{$ALL})
2343 { push @{$t->{twig_handlers_to_trigger}}, [ $elt, [$all] ]; }
2344 }
2345 else
2346 {
234736400746.9ms local $_= $elt; # so we can use $_ in the handlers
2348
234936400794.6ms foreach my $handler ( @handlers)
23503380731.1ms3380713.8s { $handler->($t, $elt) || last; }
2351 # call _all_ handler if needed
235236400788.1ms my $all= $t->{twig_handlers}->{handlers}->{$ALL};
235336400732.0ms if( $all)
2354 { $all->($t, $elt); }
235536400775.5ms if( @handlers || $all) { $t->{twig_right_after_root}=0; }
2356 }
2357 }
2358
2359 # if twig_roots is set for the element then set appropriate handler
2360364369269ms363976180ms if( $t->{twig_root_depth} and ($p->depth == $t->{twig_root_depth}) )
# spent 180ms making 363976 calls to XML::Parser::Expat::depth, avg 494ns/call
2361337928.14ms { if( $t->{twig_default_print})
2362 { # select the proper fh (and store the currently selected one)
2363 $t->_set_fh_to_twig_output_fh();
2364 if( !$p->depth==1) { $t->{twig_right_after_root}=1; } #XX
2365 if( $t->{twig_keep_encoding})
2366 { $p->setHandlers( %twig_handlers_roots_print_original); }
2367 else
2368 { $p->setHandlers( %twig_handlers_roots_print); }
2369 }
2370 else
23713379250.0ms337921.66s { $p->setHandlers( %twig_handlers_roots); }
# spent 1.66s making 33792 calls to XML::Parser::Expat::setHandlers, avg 49µs/call
2372 }
2373
237436436962.4ms if( $elt->{'att'}->{'xml:space'} && ( $elt->{'att'}->{'xml:space'} eq 'preserve')) { $t->{twig_preserve_space}--; }
2375
2376364369271ms pop @{$t->{_twig_context_stack}};
2377364369995ms return;
2378 }
2379
2380sub _trigger_tdh
2381 { my( $t)= @_;
2382
2383 if( @{$t->{twig_handlers_to_trigger}})
2384 { my @handlers_to_trigger_now= sort { $a->[0]->cmp( $b->[0]) } @{$t->{twig_handlers_to_trigger}};
2385 foreach my $elt_handlers (@handlers_to_trigger_now)
2386 { my( $handled_elt, $handlers_to_trigger)= @$elt_handlers;
2387 foreach my $handler ( @$handlers_to_trigger)
2388 { local $_= $handled_elt; $handler->($t, $handled_elt) || last; }
2389 }
2390 }
2391 return;
2392 }
2393
2394# return the list of handler that can be activated for an element
2395# (either of CODE ref's or 1's for twig_roots)
2396
2397sub _handler
239839780678.9ms
# spent 1.46s (1.18+285ms) within XML::Twig::_handler which was called 397806 times, avg 4µs/call: # 364007 times (908ms+145ms) by XML::Twig::_twig_end at line 2338, avg 3µs/call # 33799 times (269ms+139ms) by XML::Twig::_twig_start_check_roots at line 4143, avg 12µs/call
{ my( $t, $handlers, $gi)= @_;
2399
240039780663.4ms my @found_handlers=();
240139780627.9ms my $found_handler;
2402
2403397806353ms foreach my $handler ( map { @$_ } grep { $_ } $handlers->{xpath_handler}->{$gi}, $handlers->{xpath_handler}->{'*'})
24046759915.3ms { my $trigger= $handler->{trigger};
24056759975.2ms67599285ms if( my $found_path= $trigger->( $t->{_twig_context_stack}))
# spent 149ms making 31216 calls to XML::Twig::__ANON__[(eval 114)[XML/Twig.pm:1750]:26], avg 5µs/call # spent 136ms making 36360 calls to XML::Twig::__ANON__[(eval 109)[XML/Twig.pm:1750]:26], avg 4µs/call # spent 41µs making 15 calls to XML::Twig::__ANON__[(eval 102)[XML/Twig.pm:1750]:17], avg 3µs/call # spent 22µs making 4 calls to XML::Twig::__ANON__[(eval 106)[XML/Twig.pm:1750]:17], avg 6µs/call # spent 12µs making 2 calls to XML::Twig::__ANON__[(eval 111)[XML/Twig.pm:1750]:17], avg 6µs/call # spent 12µs making 2 calls to XML::Twig::__ANON__[(eval 110)[XML/Twig.pm:1750]:17], avg 6µs/call
24066759910.7ms { my $found_handler= $handler->{handler};
24076759912.7ms push @found_handlers, $found_handler;
2408 }
2409 }
2410
2411 # if no handler found call default handler if defined
2412397806115ms if( !@found_handlers && defined $handlers->{handlers}->{$DEFAULT})
2413 { push @found_handlers, $handlers->{handlers}->{$DEFAULT}; }
2414
241539780642.0ms if( @found_handlers and $t->{twig_do_not_chain_handlers})
2416 { @found_handlers= ($found_handlers[0]); }
2417
2418397806706ms return @found_handlers; # empty if no handler found
2419
2420 }
2421
2422
2423sub _replace_prefix
242436436954.4ms
# spent 2.69s (2.12+567ms) within XML::Twig::_replace_prefix which was called 364369 times, avg 7µs/call: # 364369 times (2.12s+567ms) by XML::Twig::_twig_end at line 2305, avg 7µs/call
{ my( $t, $name)= @_;
2425364369196ms364369118ms my $p= $t->parser;
# spent 118ms making 364369 calls to XML::Twig::parser, avg 325ns/call
2426364369185ms364369448ms my $uri= $p->namespace( $name);
# spent 448ms making 364369 calls to XML::Parser::Expat::namespace, avg 1µs/call
2427 # try to get the namespace from default if none is found (for attributes)
2428 # this should probably be an option
242936436947.1ms if( !$uri and( $name!~/^xml/)) { $uri= $p->expand_ns_prefix( '#default'); }
243036436943.6ms if( $uri)
24313643691.02s { if (my $mapped_prefix= $t->{twig_map_xmlns}->{$uri} || $DEFAULT_URI2NS{$uri})
2432 { return "$mapped_prefix:$name"; }
2433 else
243465µs684µs { my $prefix= _a_proper_ns_prefix( $p, $uri);
# spent 84µs making 6 calls to XML::Twig::_a_proper_ns_prefix, avg 14µs/call
243561µs if( $prefix eq '#default') { $prefix=''; }
2436610µs return $prefix ? "$prefix:$name" : $name;
2437 }
2438 }
2439 else
2440 { return $name; }
2441 }
2442
2443
2444sub _twig_char
2445
# spent 1.91s (829ms+1.09) within XML::Twig::_twig_char which was called 127292 times, avg 15µs/call: # 127292 times (829ms+1.09s) by XML::Parser::Expat::ParseString at line 486 of XML/Parser/Expat.pm, avg 15µs/call
{ # warn " in _twig_char...\n"; # DEBUG handler
2446
244712729221.3ms my ($p, $string)= @_;
244812729223.7ms my $t=$p->{twig};
2449
245012729223.8ms if( $t->{twig_keep_encoding})
2451 { if( !$t->{twig_in_cdata})
2452 { $string= $p->original_string(); }
2453 else
2454 {
245523.66ms212µs
# spent 10µs (8+2) within XML::Twig::BEGIN@2455 which was called: # once (8µs+2µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 2455
use bytes; # > perl 5.5
# spent 10µs making 1 call to XML::Twig::BEGIN@2455 # spent 2µs making 1 call to bytes::import
2456 if( length( $string) < 1024)
2457 { $string= $p->original_string(); }
2458 else
2459 { #warn "dodgy case";
2460 # TODO original_string does not hold the entire string, but $string is wrong
2461 # I believe due to a bug in XML::Parser
2462 # for now, we use the original string, even if it means that it's been converted to utf8
2463 }
2464 }
2465 }
2466
246712729222.3ms if( $t->{twig_input_filter}) { $string= $t->{twig_input_filter}->( $string); }
246812729219.5ms if( $t->{twig_char_handler}) { $string= $t->{twig_char_handler}->( $string); }
2469
247012729217.9ms my $elt= $t->{twig_current};
2471
247212729239.7ms if( $t->{twig_in_cdata})
2473 { # text is the continuation of a previously created cdata
2474 $elt->{cdata}.= $t->{twig_stored_spaces} . $string;
2475 }
2476 elsif( $t->{twig_in_pcdata})
2477 { # text is the continuation of a previously created pcdata
2478 if( $t->{extra_data})
2479 { $elt->_push_extra_data_in_pcdata( $t->{extra_data}, length( $elt->{pcdata}));
2480 $t->{extra_data}='';
2481 }
2482 $elt->{pcdata}.= $string;
2483 }
2484 else
2485 {
2486 # text is just space, which might be discarded later
2487127292298ms12729280.4ms if( $string=~/\A\s*\Z/s)
# spent 80.4ms making 127292 calls to CORE::match, avg 632ns/call
2488 {
2489 if( $t->{extra_data})
2490 { # we got extra data (comment, pi), lets add the spaces to it
2491 $t->{extra_data} .= $string;
2492 }
2493 else
2494 { # no extra data, just store the spaces
2495 $t->{twig_stored_spaces}.= $string;
2496 }
2497 }
2498 else
2499127292123ms1272921.00s { my $new_elt= _insert_pcdata( $t, $t->{twig_stored_spaces}.$string);
# spent 1.00s making 127292 calls to XML::Twig::_insert_pcdata, avg 8µs/call
250012729216.4ms delete $elt->{'twig_current'};
250112729222.4ms $new_elt->{'twig_current'}=1;
250212729218.4ms $t->{twig_current}= $new_elt;
250312729220.3ms $t->{twig_in_pcdata}=1;
250412729228.9ms if( $t->{extra_data})
2505 { $new_elt->_push_extra_data_in_pcdata( $t->{extra_data}, 0);
2506 $t->{extra_data}='';
2507 }
2508 }
2509 }
2510127292243ms return;
2511 }
2512
2513sub _twig_cdatastart
2514 { # warn " in _twig_cdatastart...\n"; # DEBUG handler
2515
2516 my $p= shift;
2517 my $t=$p->{twig};
2518
2519 $t->{twig_in_cdata}=1;
2520 my $cdata= $t->{twig_elt_class}->new( $CDATA);
2521 my $twig_current= $t->{twig_current};
2522
2523 if( $t->{twig_in_pcdata})
2524 { # create the node as a sibling of the PCDATA
2525 $cdata->{prev_sibling}=$twig_current; if( $XML::Twig::weakrefs) { weaken( $cdata->{prev_sibling});} ;
2526 $twig_current->{next_sibling}= $cdata;
2527 my $parent= $twig_current->{parent};
2528 $cdata->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $cdata->{parent});} ;
2529 delete $parent->{empty}; $parent->{last_child}=$cdata; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ;
2530 $t->{twig_in_pcdata}=0;
2531 }
2532 else
2533 { # we have to create a PCDATA element if we need to store spaces
2534 if( $t->_space_policy($XML::Twig::index2gi[$twig_current->{'gi'}]) && $t->{twig_stored_spaces})
2535 { _insert_pcdata( $t, $t->{twig_stored_spaces}); }
2536 $t->{twig_stored_spaces}='';
2537
2538 # create the node as a child of the current element
2539 $cdata->{parent}=$twig_current; if( $XML::Twig::weakrefs) { weaken( $cdata->{parent});} ;
2540 if( my $prev_sibling= $twig_current->{last_child})
2541 { $cdata->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $cdata->{prev_sibling});} ;
2542 $prev_sibling->{next_sibling}= $cdata;
2543 }
2544 else
2545 { $twig_current->{first_child}= $cdata; }
2546 delete $twig_current->{empty}; $twig_current->{last_child}=$cdata; if( $XML::Twig::weakrefs) { weaken( $twig_current->{last_child});} ;
2547
2548 }
2549
2550 delete $twig_current->{'twig_current'};
2551 $t->{twig_current}= $cdata;
2552 $cdata->{'twig_current'}=1;
2553 if( $t->{extra_data}) { $cdata->set_extra_data( $t->{extra_data}); $t->{extra_data}='' };
2554 return;
2555 }
2556
2557sub _twig_cdataend
2558 { # warn " in _twig_cdataend...\n"; # DEBUG handler
2559
2560 my $p= shift;
2561 my $t=$p->{twig};
2562
2563 $t->{twig_in_cdata}=0;
2564
2565 my $elt= $t->{twig_current};
2566 delete $elt->{'twig_current'};
2567 my $cdata= $elt->{cdata};
2568 $elt->{cdata}= $cdata;
2569
2570 push @{$t->{_twig_context_stack}}, { $ST_TAG => $CDATA };
2571
2572 if( $t->{twig_handlers})
2573 { # look for handlers
2574 my @handlers= _handler( $t, $t->{twig_handlers}, $CDATA);
2575 local $_= $elt; # so we can use $_ in the handlers
2576 foreach my $handler ( @handlers) { $handler->($t, $elt) || last; }
2577 }
2578
2579 pop @{$t->{_twig_context_stack}};
2580
2581 $elt= $elt->{parent};
2582 $t->{twig_current}= $elt;
2583 $elt->{'twig_current'}=1;
2584
2585 $t->{twig_long_cdata}=0;
2586 return;
2587 }
2588
2589sub _pi_elt_handlers
2590 { my( $t, $pi)= @_;
2591 my $pi_handlers= $t->{twig_handlers}->{pi_handlers} || return;
2592 foreach my $handler ( $pi_handlers->{$pi->{target}}, $pi_handlers->{''})
2593 { if( $handler) { local $_= $pi; $handler->( $t, $pi) || last; } }
2594 }
2595
2596sub _pi_text_handler
2597 { my( $t, $target, $data)= @_;
2598 if( my $handler= $t->{twig_handlers}->{pi_handlers}->{$target})
2599 { return $handler->( $t, $target, $data); }
2600 if( my $handler= $t->{twig_handlers}->{pi_handlers}->{''})
2601 { return $handler->( $t, $target, $data); }
2602 return defined( $data) && $data ne '' ? "<?$target $data?>" : "<?$target?>" ;
2603 }
2604
2605sub _comment_elt_handler
2606 { my( $t, $comment)= @_;
2607 if( my $handler= $t->{twig_handlers}->{handlers}->{$COMMENT})
2608 { local $_= $comment; $handler->($t, $comment); }
2609 }
2610
2611sub _comment_text_handler
2612 { my( $t, $comment)= @_;
2613 if( my $handler= $t->{twig_handlers}->{handlers}->{$COMMENT})
2614 { $comment= $handler->($t, $comment);
2615 if( !defined $comment || $comment eq '') { return ''; }
2616 }
2617 return "<!--$comment-->";
2618 }
2619
- -
2622sub _twig_comment
2623 { # warn " in _twig_comment...\n"; # DEBUG handler
2624
2625 my( $p, $comment_text)= @_;
2626 my $t=$p->{twig};
2627
2628 if( $t->{twig_keep_encoding}) { $comment_text= substr( $p->original_string(), 4, -3); }
2629
2630 $t->_twig_pi_comment( $p, $COMMENT, $t->{twig_keep_comments}, $t->{twig_process_comments},
2631 '_set_comment', '_comment_elt_handler', '_comment_text_handler', $comment_text
2632 );
2633 return;
2634 }
2635
2636sub _twig_pi
2637 { # warn " in _twig_pi...\n"; # DEBUG handler
2638
2639 my( $p, $target, $data)= @_;
2640 my $t=$p->{twig};
2641
2642 if( $t->{twig_keep_encoding})
2643 { my $pi_text= substr( $p->original_string(), 2, -2);
2644 ($target, $data)= split( /\s+/, $pi_text, 2);
2645 }
2646
2647 $t->_twig_pi_comment( $p, $PI, $t->{twig_keep_pi}, $t->{twig_process_pi},
2648 '_set_pi', '_pi_elt_handlers', '_pi_text_handler', $target, $data
2649 );
2650 return;
2651 }
2652
2653sub _twig_pi_comment
2654 { my( $t, $p, $type, $keep, $process, $set, $elt_handler, $text_handler, @parser_args)= @_;
2655
2656 if( $t->{twig_input_filter})
2657 { foreach my $arg (@parser_args) { $arg= $t->{twig_input_filter}->( $arg); } }
2658
2659 # if pi/comments are to be kept then we piggyback them to the current element
2660 if( $keep)
2661 { # first add spaces
2662 if( $t->{twig_stored_spaces})
2663 { $t->{extra_data}.= $t->{twig_stored_spaces};
2664 $t->{twig_stored_spaces}= '';
2665 }
2666
2667 my $extra_data= $t->$text_handler( @parser_args);
2668 $t->{extra_data}.= $extra_data;
2669
2670 }
2671 elsif( $process)
2672 {
2673 my $twig_current= $t->{twig_current}; # defined unless we are outside of the root
2674
2675 my $elt= $t->{twig_elt_class}->new( $type);
2676 $elt->$set( @parser_args);
2677 if( $t->{extra_data})
2678 { $elt->set_extra_data( $t->{extra_data});
2679 $t->{extra_data}='';
2680 }
2681
2682 unless( $t->root)
2683 { $t->_add_cpi_outside_of_root( leading_cpi => $elt);
2684 }
2685 elsif( $t->{twig_in_pcdata})
2686 { # create the node as a sibling of the PCDATA
2687 $elt->paste_after( $twig_current);
2688 $t->{twig_in_pcdata}=0;
2689 }
2690 elsif( $twig_current)
2691 { # we have to create a PCDATA element if we need to store spaces
2692 if( $t->_space_policy($XML::Twig::index2gi[$twig_current->{'gi'}]) && $t->{twig_stored_spaces})
2693 { _insert_pcdata( $t, $t->{twig_stored_spaces}); }
2694 $t->{twig_stored_spaces}='';
2695 # create the node as a child of the current element
2696 $elt->paste_last_child( $twig_current);
2697 }
2698 else
2699 { $t->_add_cpi_outside_of_root( trailing_cpi => $elt); }
2700
2701 if( $twig_current)
2702 { delete $twig_current->{'twig_current'};
2703 my $parent= $elt->{parent};
2704 $t->{twig_current}= $parent;
2705 $parent->{'twig_current'}=1;
2706 }
2707
2708 $t->$elt_handler( $elt);
2709 }
2710
2711 }
2712
2713
2714# add a comment or pi before the first element
2715sub _add_cpi_outside_of_root
2716 { my($t, $type, $elt)= @_; # $type is 'leading_cpi' or 'trailing_cpi'
2717 $t->{$type} ||= $t->{twig_elt_class}->new( '#CPI');
2718 # create the node as a child of the current element
2719 $elt->paste_last_child( $t->{$type});
2720 return $t;
2721 }
2722
2723sub _twig_final
2724
# spent 88µs (65+23) within XML::Twig::_twig_final which was called 7 times, avg 13µs/call: # 7 times (65µs+23µs) by XML::Parser::parse at line 199 of XML/Parser.pm, avg 13µs/call
{ # warn " in _twig_final...\n"; # DEBUG handler
2725
272671µs my $p= shift;
2727725µs712µs my $t= $p->isa( 'XML::Twig') ? $p : $p->{twig};
# spent 12µs making 7 calls to UNIVERSAL::isa, avg 2µs/call
2728
2729 # store trailing data
273072µs if( $t->{extra_data}) { $t->{trailing_cpi_text} = $t->{extra_data}; $t->{extra_data}=''; }
273175µs $t->{trailing_spaces}= $t->{twig_stored_spaces} || '';
27321413µs73µs my $s= $t->{twig_stored_spaces}; $s=~s{\n}{\\n}g;
# spent 3µs making 7 calls to CORE::subst, avg 386ns/call
273372µs if( $t->{twig_stored_spaces}) { my $s= $t->{twig_stored_spaces}; }
2734
2735 # restore the selected filehandle if needed
273677µs78µs $t->_set_fh_to_selected_fh();
# spent 8µs making 7 calls to XML::Twig::_set_fh_to_selected_fh, avg 1µs/call
2737
273871µs $t->_trigger_tdh if( $t->{twig_tdh});
2739
274071µs select $t->{twig_original_selected_fh} if($t->{twig_original_selected_fh}); # probably dodgy
2741
274272µs if( exists $t->{twig_autoflush_data})
2743 { my @args;
2744 push @args, $t->{twig_autoflush_data}->{fh} if( $t->{twig_autoflush_data}->{fh});
2745 push @args, @{$t->{twig_autoflush_data}->{args}} if( $t->{twig_autoflush_data}->{args});
2746 $t->flush( @args);
2747 delete $t->{twig_autoflush_data};
2748 $t->root->delete if $t->root;
2749 }
2750
2751 # tries to clean-up (probably not very well at the moment)
2752 #undef $p->{twig};
275373µs undef $t->{twig_parser};
275472µs delete $t->{twig_parsing};
275577µs @{$t}{ qw( twig_parser twig_parsing _twig_context_stack twig_current) }=();
2756
2757712µs return $t;
2758 }
2759
2760sub _insert_pcdata
276112729222.5ms
# spent 1.00s (968ms+36.8ms) within XML::Twig::_insert_pcdata which was called 127292 times, avg 8µs/call: # 127292 times (968ms+36.8ms) by XML::Twig::_twig_char at line 2499, avg 8µs/call
{ my( $t, $string)= @_;
2762 # create a new PCDATA element
276312729218.8ms my $parent= $t->{twig_current}; # always defined
27641272929.94ms my $elt;
276512729232.0ms if( exists $t->{twig_alt_elt_class})
2766 { $elt= $t->{twig_elt_class}->new( $PCDATA);
2767 $elt->{pcdata}= $string;
2768 }
2769 else
2770127292126ms { $elt= bless( { gi => $XML::Twig::gi2index{$PCDATA}, pcdata => $string }, 'XML::Twig::Elt'); }
2771
277212729216.3ms my $prev_sibling= $parent->{last_child};
277312729232.0ms if( $prev_sibling)
2774 { $prev_sibling->{next_sibling}= $elt;
2775 $elt->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ;
2776 }
2777 else
277812729226.4ms { $parent->{first_child}= $elt; }
2779
2780254584306ms12729222.7ms $elt->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $elt->{parent});} ;
# spent 22.7ms making 127292 calls to Scalar::Util::weaken, avg 178ns/call
2781381876311ms12729214.1ms delete $parent->{empty}; $parent->{last_child}=$elt; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ;
# spent 14.1ms making 127292 calls to Scalar::Util::weaken, avg 111ns/call
278212729222.3ms $t->{twig_stored_spaces}='';
2783127292234ms return $elt;
2784 }
2785
2786sub _space_policy
2787 { my( $t, $gi)= @_;
2788 my $policy;
2789 $policy=0 if( $t->{twig_discard_spaces});
2790 $policy=1 if( $t->{twig_keep_spaces});
2791 $policy=1 if( $t->{twig_keep_spaces_in}
2792 && $t->{twig_keep_spaces_in}->{$gi});
2793 $policy=0 if( $t->{twig_discard_spaces_in}
2794 && $t->{twig_discard_spaces_in}->{$gi});
2795 return $policy;
2796 }
2797
2798
2799sub _twig_entity
2800 { # warn " in _twig_entity...\n"; # DEBUG handler
2801 my( $p, $name, $val, $sysid, $pubid, $ndata, $param)= @_;
2802 my $t=$p->{twig};
2803
2804 #{ no warnings; my $base= $p->base; warn "_twig_entity called: expand: '$t->{twig_expand_external_ents}', base: '$base', name: '$name', val: '$val', sysid: '$sysid', pubid: '$pubid', ndata: '$ndata', param: '$param'\n";}
2805
2806 my $missing_entity=0;
2807
2808 if( $sysid)
2809 { if($ndata)
2810 { if( ! -f _based_filename( $sysid, $p->base)) { $missing_entity= 1; }
2811 }
2812 else
2813 { if( $t->{twig_expand_external_ents})
2814 { $val= eval { _slurp_uri( $sysid, $p->base) };
2815 if( ! defined $val)
2816 { if( $t->{twig_extern_ent_nofail})
2817 { $missing_entity= 1; }
2818 else
2819 { _croak( "cannot load SYSTEM entity '$name' from '$sysid': $@", 3); }
2820 }
2821 }
2822 }
2823 }
2824
2825 my $ent=XML::Twig::Entity->new( $name, $val, $sysid, $pubid, $ndata, $param);
2826 if( $missing_entity) { $t->{twig_missing_system_entities}->{$name}= $ent; }
2827
2828 my $entity_list= $t->entity_list;
2829 if( $entity_list) { $entity_list->add( $ent); }
2830
2831 if( $parser_version > 2.27)
2832 { # this is really ugly, but with some versions of XML::Parser the value
2833 # of the entity is not properly returned by the default handler
2834 my $ent_decl= $ent->text;
2835 if( $t->{twig_keep_encoding})
2836 { if( defined $ent->{val} && ($ent_decl !~ /["']/))
2837 { my $val= $ent->{val};
2838 $ent_decl .= $val =~ /"/ ? qq{'$val' } : qq{"$val" };
2839 }
2840 # for my solaris box (perl 5.6.1, XML::Parser 2.31, expat?)
2841 $t->{twig_doctype}->{internal}=~ s{<!ENTITY\s+$name\s+$}{substr( $ent_decl, 0, -1)}e;
2842 }
2843 $t->{twig_doctype}->{internal} .= $ent_decl
2844 unless( $t->{twig_doctype}->{internal}=~ m{<!ENTITY\s+$name\s+});
2845 }
2846
2847 return;
2848 }
2849
2850sub _twig_notation
2851 { my( $p, $name, $base, $sysid, $pubid ) = @_;
2852 my $t = $p->{twig};
2853
2854 my $notation = XML::Twig::Notation->new( $name, $base, $sysid, $pubid );
2855 my $notation_list = $t->notation_list();
2856 if( $notation_list ) { $notation_list->add( $notation ); }
2857
2858 # internal should get the recognized_string, but XML::Parser does not provide it
2859 # so we need to re-create it ( $notation->text) and stick it there.
2860 $t->{twig_doctype}->{internal} .= $notation->text;
2861
2862 return;
2863 }
2864
2865
2866sub _twig_extern_ent
2867 { # warn " in _twig_extern_ent...I (", $_[0]->original_string, ")\n"; # DEBUG handler
2868 my( $p, $base, $sysid, $pubid)= @_;
2869 my $t= $p->{twig};
2870 if( $t->{twig_no_expand})
2871 { my $ent_name= $t->{twig_keep_encoding} ? $p->original_string : $p->recognized_string;
2872 _twig_insert_ent( $t, $ent_name);
2873 return '';
2874 }
2875 my $ent_content= eval { $t->{twig_ext_ent_handler}->( $p, $base, $sysid) };
2876 if( ! defined $ent_content)
2877 {
2878 my $ent_name = $p->recognized_string;
2879 my $file = _based_filename( $sysid, $base);
2880 my $error_message= "cannot expand $ent_name - cannot load '$file'";
2881 if( $t->{twig_extern_ent_nofail}) { return "<!-- $error_message -->"; }
2882 else { _croak( $error_message); }
2883 }
2884 return $ent_content;
2885 }
2886
2887# I use this so I can change the $Carp::CarpLevel (which determines how many call frames to skip when reporting an error)
2888sub _croak
2889 { my( $message, $level)= @_;
2890 $Carp::CarpLevel= $level || 0;
2891 croak $message;
2892 }
2893
2894sub _twig_xmldecl
2895
# spent 32µs within XML::Twig::_twig_xmldecl which was called 7 times, avg 5µs/call: # 7 times (32µs+0s) by XML::Parser::Expat::ParseString at line 486 of XML/Parser/Expat.pm, avg 5µs/call
{ # warn " in _twig_xmldecl...\n"; # DEBUG handler
2896
289772µs my $p= shift;
289873µs my $t=$p->{twig};
289974µs $t->{twig_xmldecl}||={}; # could have been set by set_output_encoding
290076µs $t->{twig_xmldecl}->{version}= shift;
290174µs $t->{twig_xmldecl}->{encoding}= shift;
290273µs $t->{twig_xmldecl}->{standalone}= shift;
2903714µs return;
2904 }
2905
2906sub _twig_doctype
2907 { # warn " in _twig_doctype...\n"; # DEBUG handler
2908 my( $p, $name, $sysid, $pub, $internal)= @_;
2909 my $t=$p->{twig};
2910 $t->{twig_doctype}||= {}; # create
2911 $t->{twig_doctype}->{name}= $name; # always there
2912 $t->{twig_doctype}->{sysid}= $sysid; #
2913 $t->{twig_doctype}->{pub}= $pub; #
2914
2915 # now let's try to cope with XML::Parser 2.28 and above
2916 if( $parser_version > 2.27)
2917 { @saved_default_handler= $p->setHandlers( Default => \&_twig_store_internal_dtd,
2918 Entity => \&_twig_entity,
2919 );
2920 $p->setHandlers( DoctypeFin => \&_twig_stop_storing_internal_dtd);
2921 $t->{twig_doctype}->{internal}='';
2922 }
2923 else
2924 { $internal||='';
2925
2926 $internal=~ s{^\s*\[}{};
2927 $internal=~ s{]\s*$}{};
2928 $t->{twig_doctype}->{internal}=$internal;
2929 }
2930
2931 # now check if we want to get the DTD info
2932 if( $t->{twig_read_external_dtd} && $sysid)
2933 { # let's build a fake document with an internal DTD
2934 if( $t->{DTDBase})
2935 { _use( 'File::Spec');
2936 $sysid=File::Spec->catfile($t->{DTDBase}, $sysid);
2937 }
2938 my $dtd= _slurp_uri( $sysid);
2939 # if the DTD includes an XML declaration, it needs to be moved before the DOCTYPE bit
2940 if( $dtd=~ s{^(\s*<\?xml(\s+\w+\s*=\s*("[^"]*"|'[^']*'))*\s*\?>)}{})
2941 { $dtd= "$1<!DOCTYPE $name [$dtd]><$name/>"; }
2942 else
2943 { $dtd= "<!DOCTYPE $name [$dtd]><$name/>"; }
2944
2945 $t->save_global_state(); # save the globals (they will be reset by the following new)
2946 my $t_dtd= XML::Twig->new( load_DTD => 1, ParseParamEnt => 1, error_context => $t->{ErrorContext} || 0); # create a temp twig
2947 $t_dtd->parse( $dtd); # parse it
2948 $t->{twig_dtd}= $t_dtd->{twig_dtd}; # grab the dtd info
2949 #$t->{twig_dtd_is_external}=1;
2950 $t->entity_list->_add_list( $t_dtd->entity_list) if( $t_dtd->entity_list); # grab the entity info
2951 $t->notation_list->_add_list( $t_dtd->notation_list) if( $t_dtd->notation_list); # grab the notation info
2952 $t->restore_global_state();
2953 }
2954 return;
2955 }
2956
2957sub _twig_element
2958 { # warn " in _twig_element...\n"; # DEBUG handler
2959
2960 my( $p, $name, $model)= @_;
2961 my $t=$p->{twig};
2962 $t->{twig_dtd}||= {}; # may create the dtd
2963 $t->{twig_dtd}->{model}||= {}; # may create the model hash
2964 $t->{twig_dtd}->{elt_list}||= []; # ordered list of elements
2965 push @{$t->{twig_dtd}->{elt_list}}, $name; # store the elt
2966 $t->{twig_dtd}->{model}->{$name}= $model; # store the model
2967 if( ($parser_version > 2.27) && ($t->{twig_doctype}->{internal}=~ m{(^|>)\s*$}) )
2968 { my $text= $XML::Twig::Elt::keep_encoding ? $p->original_string : $p->recognized_string;
2969 unless( $text)
2970 { # this version of XML::Parser does not return the text in the *_string method
2971 # we need to rebuild it
2972 $text= "<!ELEMENT $name $model>";
2973 }
2974 $t->{twig_doctype}->{internal} .= $text;
2975 }
2976 return;
2977 }
2978
2979sub _twig_attlist
2980 { # warn " in _twig_attlist...\n"; # DEBUG handler
2981
2982 my( $p, $gi, $att, $type, $default, $fixed)= @_;
2983 #warn "in attlist: gi: '$gi', att: '$att', type: '$type', default: '$default', fixed: '$fixed'\n";
2984 my $t=$p->{twig};
2985 $t->{twig_dtd}||= {}; # create dtd if need be
2986 $t->{twig_dtd}->{$gi}||= {}; # create elt if need be
2987 #$t->{twig_dtd}->{$gi}->{att}||= {}; # create att if need be
2988 if( ($parser_version > 2.27) && ($t->{twig_doctype}->{internal}=~ m{(^|>)\s*$}) )
2989 { my $text= $XML::Twig::Elt::keep_encoding ? $p->original_string : $p->recognized_string;
2990 unless( $text)
2991 { # this version of XML::Parser does not return the text in the *_string method
2992 # we need to rebuild it
2993 my $att_decl="$att $type";
2994 $att_decl .= " #FIXED" if( $fixed);
2995 $att_decl .= " $default" if( defined $default);
2996 # 2 cases: there is already an attlist on that element or not
2997 if( $t->{twig_dtd}->{att}->{$gi})
2998 { # there is already an attlist, add to it
2999 $t->{twig_doctype}->{internal}=~ s{(<!ATTLIST\s*$gi )(.*?)\n?>}
3000 { "$1$2\n" . ' ' x length( $1) . "$att_decl\n>"}es;
3001 }
3002 else
3003 { # create the attlist
3004 $t->{twig_doctype}->{internal}.= "<!ATTLIST $gi $att_decl>"
3005 }
3006 }
3007 }
3008 $t->{twig_dtd}->{att}->{$gi}->{$att}= {} ;
3009 $t->{twig_dtd}->{att}->{$gi}->{$att}->{type}= $type;
3010 $t->{twig_dtd}->{att}->{$gi}->{$att}->{default}= $default if( defined $default);
3011 $t->{twig_dtd}->{att}->{$gi}->{$att}->{fixed}= $fixed;
3012 return;
3013 }
3014
3015sub _twig_default
3016
# spent 23µs (18+5) within XML::Twig::_twig_default which was called 6 times, avg 4µs/call: # 6 times (18µs+5µs) by XML::Parser::Expat::ParseString at line 486 of XML/Parser/Expat.pm, avg 4µs/call
{ # warn " in _twig_default...\n"; # DEBUG handler
3017
301862µs my( $p, $string)= @_;
3019
302061µs my $t= $p->{twig};
3021
3022 # we need to process the data in 2 cases: entity, or spaces after the closing tag
3023
3024 # after the closing tag (no twig_current and root has been created)
302563µs if( ! $t->{twig_current} && $t->{twig_root} && $string=~ m{^\s+$}m) { $t->{twig_stored_spaces} .= $string; }
3026
3027 # process only if we have an entity
3028619µs65µs if( $string=~ m{^&([^;]*);$})
# spent 5µs making 6 calls to CORE::match, avg 867ns/call
3029 { # the entity has to be pure pcdata, or we have a problem
3030 if( ($p->original_string=~ m{^<}) && ($p->original_string=~ m{>$}) )
3031 { # string is a tag, entity is in an attribute
3032 $t->{twig_entities_in_attribute}=1 if( $t->{twig_do_not_escape_amp_in_atts});
3033 }
3034 else
3035 { my $ent;
3036 if( $t->{twig_keep_encoding})
3037 { _twig_char( $p, $string);
3038 $ent= substr( $string, 1, -1);
3039 }
3040 else
3041 { $ent= _twig_insert_ent( $t, $string);
3042 }
3043
3044 return $ent;
3045 }
3046 }
3047 }
3048
3049sub _twig_insert_ent
3050 {
3051 my( $t, $string)=@_;
3052
3053 my $twig_current= $t->{twig_current};
3054
3055 my $ent= $t->{twig_elt_class}->new( $ENT);
3056 $ent->{ent}= $string;
3057
3058 _add_or_discard_stored_spaces( $t);
3059
3060 if( $t->{twig_in_pcdata})
3061 { # create the node as a sibling of the #PCDATA
3062
3063 $ent->{prev_sibling}=$twig_current; if( $XML::Twig::weakrefs) { weaken( $ent->{prev_sibling});} ;
3064 $twig_current->{next_sibling}= $ent;
3065 my $parent= $twig_current->{parent};
3066 $ent->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $ent->{parent});} ;
3067 delete $parent->{empty}; $parent->{last_child}=$ent; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ;
3068 # the twig_current is now the parent
3069 delete $twig_current->{'twig_current'};
3070 $t->{twig_current}= $parent;
3071 # we left pcdata
3072 $t->{twig_in_pcdata}=0;
3073 }
3074 else
3075 { # create the node as a child of the current element
3076 $ent->{parent}=$twig_current; if( $XML::Twig::weakrefs) { weaken( $ent->{parent});} ;
3077 if( my $prev_sibling= $twig_current->{last_child})
3078 { $ent->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $ent->{prev_sibling});} ;
3079 $prev_sibling->{next_sibling}= $ent;
3080 }
3081 else
3082 { if( $twig_current) { $twig_current->{first_child}= $ent; } }
3083 if( $twig_current) { delete $twig_current->{empty}; $twig_current->{last_child}=$ent; if( $XML::Twig::weakrefs) { weaken( $twig_current->{last_child});} ; }
3084 }
3085
3086 # meant to trigger entity handler, does not seem to be activated at this time
3087 #if( my $handler= $t->{twig_handlers}->{gi}->{$ENT})
3088 # { local $_= $ent; $handler->( $t, $ent); }
3089
3090 return $ent;
3091 }
3092
3093sub parser
309418582433.08s
# spent 524ms within XML::Twig::parser which was called 1858243 times, avg 282ns/call: # 1095679 times (254ms+0s) by XML::Twig::_ns_info at line 2217, avg 231ns/call # 398167 times (153ms+0s) by XML::Twig::_replace_ns at line 2162, avg 383ns/call # 364369 times (118ms+0s) by XML::Twig::_replace_prefix at line 2425, avg 325ns/call # 28 times (7µs+0s) by XML::Twig::_replace_ns at line 2163, avg 243ns/call
{ return $_[0]->{twig_parser}; }
3095
3096# returns the declaration text (or a default one)
3097sub xmldecl
3098 { my $t= shift;
3099 return '' unless( $t->{twig_xmldecl} || $t->{output_encoding});
3100 my $decl_string;
3101 my $decl= $t->{twig_xmldecl};
3102 if( $decl)
3103 { my $version= $decl->{version};
3104 $decl_string= q{<?xml};
3105 $decl_string .= qq{ version="$version"};
3106
3107 # encoding can either have been set (in $decl->{output_encoding})
3108 # or come from the document (in $decl->{encoding})
3109 if( $t->{output_encoding})
3110 { my $encoding= $t->{output_encoding};
3111 $decl_string .= qq{ encoding="$encoding"};
3112 }
3113 elsif( $decl->{encoding})
3114 { my $encoding= $decl->{encoding};
3115 $decl_string .= qq{ encoding="$encoding"};
3116 }
3117
3118 if( defined( $decl->{standalone}))
3119 { $decl_string .= q{ standalone="};
3120 $decl_string .= $decl->{standalone} ? "yes" : "no";
3121 $decl_string .= q{"};
3122 }
3123
3124 $decl_string .= "?>\n";
3125 }
3126 else
3127 { my $encoding= $t->{output_encoding};
3128 $decl_string= qq{<?xml version="1.0" encoding="$encoding"?>};
3129 }
3130
3131 my $output_filter= XML::Twig::Elt::output_filter();
3132 return $output_filter ? $output_filter->( $decl_string) : $decl_string;
3133 }
3134
3135sub set_doctype
3136 { my( $t, $name, $system, $public, $internal)= @_;
3137 $t->{twig_doctype}= {} unless defined $t->{twig_doctype};
3138 my $doctype= $t->{twig_doctype};
3139 $doctype->{name} = $name if( defined $name);
3140 $doctype->{sysid} = $system if( defined $system);
3141 $doctype->{pub} = $public if( defined $public);
3142 $doctype->{internal} = $internal if( defined $internal);
3143 }
3144
3145sub doctype_name
3146 { my $t= shift;
3147 my $doctype= $t->{twig_doctype} or return '';
3148 return $doctype->{name} || '';
3149 }
3150
3151sub system_id
3152 { my $t= shift;
3153 my $doctype= $t->{twig_doctype} or return '';
3154 return $doctype->{sysid} || '';
3155 }
3156
3157sub public_id
3158 { my $t= shift;
3159 my $doctype= $t->{twig_doctype} or return '';
3160 return $doctype->{pub} || '';
3161 }
3162
3163sub internal_subset
3164 { my $t= shift;
3165 my $doctype= $t->{twig_doctype} or return '';
3166 return $doctype->{internal} || '';
3167 }
3168
3169# return the dtd object
3170sub dtd
3171 { my $t= shift;
3172 return $t->{twig_dtd};
3173 }
3174
3175# return an element model, or the list of element models
3176sub model
3177 { my $t= shift;
3178 my $elt= shift;
3179 return $t->dtd->{model}->{$elt} if( $elt);
3180 return (sort keys %{$t->dtd->{model}});
3181 }
3182
3183
3184# return the entity_list object
3185sub entity_list
3186 { my $t= shift;
3187 return $t->{twig_entity_list};
3188 }
3189
3190# return the list of entity names
3191sub entity_names
3192 { my $t= shift;
3193 return $t->entity_list->entity_names;
3194 }
3195
3196# return the entity object
3197sub entity
3198 { my $t= shift;
3199 my $entity_name= shift;
3200 return $t->entity_list->ent( $entity_name);
3201 }
3202
3203# return the notation_list object
3204sub notation_list
3205 { my $t= shift;
3206 return $t->{twig_notation_list};
3207 }
3208
3209# return the list of notation names
3210sub notation_names
3211 { my $t= shift;
3212 return $t->notation_list->notation_names;
3213 }
3214
3215# return the notation object
3216sub notation
3217 { my $t= shift;
3218 my $notation_name= shift;
3219 return $t->notation_list->notation( $notation_name);
3220 }
3221
- -
3225sub print_prolog
3226 { my $t= shift;
3227 my $fh= isa( $_[0], 'GLOB') || isa( $_[0], 'IO::Scalar') ? shift : $t->{twig_output_fh} || select() || \*STDOUT;
3228 ## no critic (TestingAndDebugging::ProhibitNoStrict);
322921.38ms216µs
# spent 12µs (8+4) within XML::Twig::BEGIN@3229 which was called: # once (8µs+4µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 3229
no strict 'refs';
# spent 12µs making 1 call to XML::Twig::BEGIN@3229 # spent 4µs making 1 call to strict::unimport
3230 print {$fh} $t->prolog( @_);
3231 }
3232
3233sub prolog
3234 { my $t= shift;
3235 if( $t->{no_prolog}){ return ''; }
3236
3237 return $t->{no_prolog} ? ''
3238 : defined $t->{no_dtd_output} ? $t->xmldecl
3239 : $t->xmldecl . $t->doctype( @_);
3240 }
3241
3242sub doctype
3243 { my $t= shift;
3244 my %args= _normalize_args( @_);
3245 my $update_dtd = $args{UpdateDTD} || '';
3246 my $doctype_text='';
3247
3248 my $doctype= $t->{twig_doctype};
3249
3250 if( $doctype)
3251 { $doctype_text .= qq{<!DOCTYPE $doctype->{name}} if( $doctype->{name});
3252 $doctype_text .= qq{ PUBLIC "$doctype->{pub}"} if( $doctype->{pub});
3253 $doctype_text .= qq{ SYSTEM} if( $doctype->{sysid} && !$doctype->{pub});
3254 $doctype_text .= qq{ "$doctype->{sysid}"} if( $doctype->{sysid});
3255 }
3256
3257 if( $update_dtd)
3258 { if( $doctype)
3259 { my $internal=$doctype->{internal};
3260 # awful hack, but at least it works a little better that what was there before
3261 if( $internal)
3262 { # remove entity and notation declarations (they will be re-generated from the updated entity list)
3263 $internal=~ s{<! \s* ENTITY \s+ $REG_TAG_NAME \s+ ( ("[^"]*"|'[^']*') \s* | SYSTEM [^>]*) >\s*}{}xg;
3264 $internal=~ s{<! \s* NOTATION .*? >\s*}{}sxg;
3265 $internal=~ s{^\n}{};
3266 }
3267 $internal .= $t->entity_list->text ||'' if( $t->entity_list);
3268 $internal .= $t->notation_list->text ||'' if( $t->notation_list);
3269 if( $internal) { $doctype_text .= "[\n$internal]>\n"; }
3270 }
3271 elsif( !$t->{'twig_dtd'} && ( keys %{$t->entity_list} || keys %{$t->notation_list} ) )
3272 { $doctype_text .= "<!DOCTYPE " . $t->root->gi . " [\n" . $t->entity_list->text . $t->notation_list->text . "\n]>";}
3273 else
3274 { $doctype_text= $t->{twig_dtd};
3275 $doctype_text .= $t->dtd_text;
3276 }
3277 }
3278 elsif( $doctype)
3279 { if( my $internal= $doctype->{internal})
3280 { # add opening and closing brackets if not already there
3281 # plus some spaces and newlines for a nice formating
3282 # I test it here because I can't remember which version of
3283 # XML::Parser need it or not, nor guess which one will in the
3284 # future, so this about the best I can do
3285 $internal=~ s{^\s*(\[\s*)?}{ [\n};
3286 $internal=~ s{\s*(\]\s*(>\s*)?)?\s*$}{\n]>\n};
3287
3288 # XML::Parser does not include the NOTATION declarations in the DTD
3289 # at least in the current version. So put them back
3290 #if( $t->notation_list && $internal !~ m{<!\s*NOTATION})
3291 # { $internal=~ s{(\n]>\n)$}{ "\n" . $t->notation_list->text . $1}es; }
3292
3293 $doctype_text .= $internal;
3294 }
3295 }
3296
3297 if( $doctype_text)
3298 {
3299 # terrible hack, as I can't figure out in which case the darn prolog
3300 # should get an extra > (depends on XML::Parser and expat versions)
3301 $doctype_text=~ s/(>\s*)*$/>\n/; # if($doctype_text);
3302
3303 my $output_filter= XML::Twig::Elt::output_filter();
3304 return $output_filter ? $output_filter->( $doctype_text) : $doctype_text;
3305 }
3306 else
3307 { return $doctype_text; }
3308 }
3309
3310sub _leading_cpi
3311 { my $t= shift;
3312 my $leading_cpi= $t->{leading_cpi} || return '';
3313 return $leading_cpi->sprint( 1);
3314 }
3315
3316sub _trailing_cpi
3317 { my $t= shift;
3318 my $trailing_cpi= $t->{trailing_cpi} || return '';
3319 return $trailing_cpi->sprint( 1);
3320 }
3321
3322sub _trailing_cpi_text
3323 { my $t= shift;
3324 return $t->{trailing_cpi_text} || '';
3325 }
3326
3327sub print_to_file
3328 { my( $t, $filename)= (shift, shift);
3329 my $out_fh;
3330# open( $out_fh, ">$filename") or _croak( "cannot create file $filename: $!"); # < perl 5.8
3331 my $mode= $t->{twig_keep_encoding} && ! _use_perlio() ? '>' : '>:utf8'; # >= perl 5.8
3332 open( $out_fh, $mode, $filename) or _croak( "cannot create file $filename: $!"); # >= perl 5.8
3333 $t->print( $out_fh, @_);
3334 close $out_fh;
3335 return $t;
3336 }
3337
3338# probably only works on *nix (at least the chmod bit)
3339# first print to a temporary file, then rename that file to the desired file name, then change permissions
3340# to the original file permissions (or to the current umask)
3341sub safe_print_to_file
3342 { my( $t, $filename)= (shift, shift);
3343 my $perm= -f $filename ? (stat $filename)[2] & 07777 : ~umask() ;
3344 XML::Twig::_use( 'File::Temp') || croak "need File::Temp to use safe_print_to_file\n";
3345 my $tmpdir= dirname( $filename);
3346 my( $fh, $tmpfilename) = File::Temp::tempfile( DIR => $tmpdir);
3347 $t->print_to_file( $tmpfilename, @_);
3348 rename( $tmpfilename, $filename) or unlink $tmpfilename && _croak( "cannot move temporary file to $filename: $!");
3349 chmod $perm, $filename;
3350 return $t;
3351 }
3352
3353
3354sub print
3355 { my $t= shift;
3356 my $fh= isa( $_[0], 'GLOB') || isa( $_[0], 'IO::Scalar') ? shift : undef;
3357 my %args= _normalize_args( @_);
3358
3359 my $old_select = defined $fh ? select $fh : undef;
3360 my $old_pretty = defined ($args{PrettyPrint}) ? $t->set_pretty_print( $args{PrettyPrint}) : undef;
3361 my $old_empty_tag = defined ($args{EmptyTags}) ? $t->set_empty_tag_style( $args{EmptyTags}) : undef;
3362
3363 #if( !$t->{encoding} || lc( $t->{encoding}) eq 'utf-8') { my $out= $fh || \*STDOUT; binmode $out, ':utf8'; }
3364
3365 if( $perl_version > 5.006 && ! $t->{twig_keep_encoding} && _use_perlio() ) { binmode( $fh || \*STDOUT, ":utf8" ); }
3366
3367 print $t->prolog( %args) . $t->_leading_cpi( %args);
3368 $t->{twig_root}->print;
3369 print $t->_trailing_cpi # trailing comments and pi's (elements, in 'process' mode)
3370 . $t->_trailing_cpi_text # trailing comments and pi's (in 'keep' mode)
3371 . ( ($t->{twig_keep_spaces}||'') && ($t->{trailing_spaces} || ''))
3372 ;
3373
3374
3375 $t->set_pretty_print( $old_pretty) if( defined $old_pretty);
3376 $t->set_empty_tag_style( $old_empty_tag) if( defined $old_empty_tag);
3377 if( $fh) { select $old_select; }
3378
3379 return $t;
3380 }
3381
3382
3383sub flush
3384 { my $t= shift;
3385
3386 $t->_trigger_tdh if $t->{twig_tdh};
3387
3388 return if( $t->{twig_completely_flushed});
3389
3390 my $fh= isa( $_[0], 'GLOB') || isa( $_[0], 'IO::Scalar') ? shift : undef;
3391 my $old_select= defined $fh ? select $fh : undef;
3392 my $up_to= ref $_[0] ? shift : undef;
3393 my %args= _normalize_args( @_);
3394
3395 my $old_pretty;
3396 if( defined $args{PrettyPrint})
3397 { $old_pretty= $t->set_pretty_print( $args{PrettyPrint});
3398 delete $args{PrettyPrint};
3399 }
3400
3401 my $old_empty_tag_style;
3402 if( $args{EmptyTags})
3403 { $old_empty_tag_style= $t->set_empty_tag_style( $args{EmptyTags});
3404 delete $args{EmptyTags};
3405 }
3406
3407
3408 # the "real" last element processed, as _twig_end has closed it
3409 my $last_elt;
3410 my $flush_trailing_data=0;
3411 if( $up_to)
3412 { $last_elt= $up_to; }
3413 elsif( $t->{twig_current})
3414 { $last_elt= $t->{twig_current}->{last_child}; }
3415 else
3416 { $last_elt= $t->{twig_root};
3417 $flush_trailing_data=1;
3418 $t->{twig_completely_flushed}=1;
3419 }
3420
3421 # flush the DTD unless it has ready flushed (ie root has been flushed)
3422 my $elt= $t->{twig_root};
3423 unless( $elt->{'flushed'})
3424 { # store flush info so we can auto-flush later
3425 if( $t->{twig_autoflush})
3426 { $t->{twig_autoflush_data}={};
3427 $t->{twig_autoflush_data}->{fh} = $fh if( $fh);
3428 $t->{twig_autoflush_data}->{args} = \@_ if( @_);
3429 }
3430 $t->print_prolog( %args);
3431 print $t->_leading_cpi;
3432 }
3433
3434 while( $elt)
3435 { my $next_elt;
3436 if( $last_elt && $last_elt->in( $elt))
3437 {
3438 unless( $elt->{'flushed'})
3439 { # just output the front tag
3440 print $elt->start_tag();
3441 $elt->{'flushed'}=1;
3442 }
3443 $next_elt= $elt->{first_child};
3444 }
3445 else
3446 { # an element before the last one or the last one,
3447 $next_elt= $elt->{next_sibling};
3448 $elt->_flush();
3449 $elt->delete;
3450 last if( $last_elt && ($elt == $last_elt));
3451 }
3452 $elt= $next_elt;
3453 }
3454
3455 if( $flush_trailing_data)
3456 { print $t->_trailing_cpi # trailing comments and pi's (elements, in 'process' mode)
3457 , $t->_trailing_cpi_text # trailing comments and pi's (in 'keep' mode)
3458 }
3459
3460 select $old_select if( defined $old_select);
3461 $t->set_pretty_print( $old_pretty) if( defined $old_pretty);
3462 $t->set_empty_tag_style( $old_empty_tag_style) if( defined $old_empty_tag_style);
3463
3464 if( my $ids= $t->{twig_id_list})
3465 { while( my ($id, $elt)= each %$ids)
3466 { if( ! defined $elt)
3467 { delete $t->{twig_id_list}->{$id} }
3468 }
3469 }
3470
3471 return $t;
3472 }
3473
3474
3475# flushes up to an element
3476# this method just reorders the arguments and calls flush
3477sub flush_up_to
3478 { my $t= shift;
3479 my $up_to= shift;
3480 if( isa( $_[0], 'GLOB') || isa( $_[0], 'IO::Scalar'))
3481 { my $fh= shift;
3482 $t->flush( $fh, $up_to, @_);
3483 }
3484 else
3485 { $t->flush( $up_to, @_); }
3486
3487 return $t;
3488 }
3489
3490
3491# same as print except the entire document text is returned as a string
3492sub sprint
3493 { my $t= shift;
3494 my %args= _normalize_args( @_);
3495
3496 my $old_pretty;
3497 if( defined $args{PrettyPrint})
3498 { $old_pretty= $t->set_pretty_print( $args{PrettyPrint});
3499 delete $args{PrettyPrint};
3500 }
3501
3502 my $old_empty_tag_style;
3503 if( defined $args{EmptyTags})
3504 { $old_empty_tag_style= $t->set_empty_tag_style( $args{EmptyTags});
3505 delete $args{EmptyTags};
3506 }
3507
3508 my $string= $t->prolog( %args) # xml declaration and doctype
3509 . $t->_leading_cpi( %args) # leading comments and pi's in 'process' mode
3510 . ( ($t->{twig_root} && $t->{twig_root}->sprint) || '')
3511 . $t->_trailing_cpi # trailing comments and pi's (elements, in 'process' mode)
3512 . $t->_trailing_cpi_text # trailing comments and pi's (in 'keep' mode)
3513 ;
3514 if( $t->{twig_keep_spaces} && $t->{trailing_spaces}) { $string .= $t->{trailing_spaces}; }
3515
3516 $t->set_pretty_print( $old_pretty) if( defined $old_pretty);
3517 $t->set_empty_tag_style( $old_empty_tag_style) if( defined $old_empty_tag_style);
3518
3519 return $string;
3520 }
3521
3522
3523# this method discards useless elements in a tree
3524# it does the same thing as a flush except it does not print it
3525# the second argument is an element, the last purged element
3526# (this argument is usually set through the purge_up_to method)
3527sub purge
3528338075.05ms
# spent 1.17s (317ms+856ms) within XML::Twig::purge which was called 33807 times, avg 35µs/call: # 18180 times (155ms+413ms) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:302] at line 301 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 31µs/call # 15608 times (162ms+442ms) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 441 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 39µs/call # 15 times (98µs+269µs) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:655] at line 654 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 24µs/call # once (11µs+24µs) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:246] at line 245 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (7µs+18µs) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:338] at line 337 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (6µs+17µs) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:268] at line 267 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (6µs+16µs) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:313] at line 312 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm
{ my $t= shift;
3529338074.81ms my $up_to= shift;
3530
3531338075.61ms $t->_trigger_tdh if $t->{twig_tdh};
3532
3533 # the "real" last element processed, as _twig_end has closed it
3534338072.60ms my $last_elt;
35353380712.8ms if( $up_to)
3536 { $last_elt= $up_to; }
3537 elsif( $t->{twig_current})
3538 { $last_elt= $t->{twig_current}->{last_child}; }
3539 else
3540 { $last_elt= $t->{twig_root}; }
3541
3542338077.10ms my $elt= $t->{twig_root};
3543
3544338074.96ms while( $elt)
3545676144.31ms { my $next_elt;
35466761440.3ms67614203ms if( $last_elt && $last_elt->in( $elt))
# spent 203ms making 67614 calls to XML::Twig::Elt::in, avg 3µs/call
3547338076.99ms { $elt->{'flushed'}=1;
3548338075.93ms $next_elt= $elt->{first_child};
3549 }
3550 else
3551 { # an element before the last one or the last one,
3552338075.80ms $next_elt= $elt->{next_sibling};
35533380719.3ms33807653ms $elt->delete;
# spent 653ms making 33807 calls to XML::Twig::Elt::delete, avg 19µs/call
35543380721.4ms last if( $last_elt && ($elt == $last_elt) );
3555 }
3556338079.37ms $elt= $next_elt;
3557 }
3558
3559338077.80ms if( my $ids= $t->{twig_id_list})
3560 { while( my ($id, $elt)= each %$ids) { if( ! defined $elt) { delete $t->{twig_id_list}->{$id} } } }
3561
35623380767.6ms return $t;
3563 }
3564
3565# flushes up to an element. This method just calls purge
3566sub purge_up_to
3567 { my $t= shift;
3568 return $t->purge( @_);
3569 }
3570
3571sub root
35723439µs
# spent 20µs within XML::Twig::root which was called 34 times, avg 582ns/call: # 16 times (10µs+0s) by XML::Twig::get_xpath at line 3691, avg 625ns/call # 16 times (8µs+0s) by XML::Twig::descendants at line 3758, avg 494ns/call # once (1µs+0s) by XML::Twig::_twig_end_check_roots at line 4217 # once (700ns+0s) by XML::Twig::_twig_start_check_roots at line 4163
{ return $_[0]->{twig_root}; }
3573
3574sub normalize
3575 { return $_[0]->root->normalize; }
3576
3577
3578# create accessor methods on attribute names
357910s{ my %accessor; # memorize accessor names so re-creating them won't trigger an error
3580sub att_accessors
3581 {
3582 my $twig_or_class= shift;
3583 my $elt_class= ref $twig_or_class ? $twig_or_class->{twig_elt_class}
3584 : 'XML::Twig::Elt'
3585 ;
3586 ## no critic (TestingAndDebugging::ProhibitNoStrict);
35872169µs215µs
# spent 11µs (7+4) within XML::Twig::BEGIN@3587 which was called: # once (7µs+4µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 3587
no strict 'refs';
# spent 11µs making 1 call to XML::Twig::BEGIN@3587 # spent 4µs making 1 call to strict::unimport
3588 foreach my $att (@_)
3589 { _croak( "attempt to redefine existing method $att using att_accessors")
3590 if( $elt_class->can( $att) && !$accessor{$att});
3591
3592 if( !$accessor{$att})
3593 { *{"$elt_class\::$att"}=
3594 sub
3595 :lvalue # > perl 5.5
3596 { my $elt= shift;
3597 if( @_) { $elt->{att}->{$att}= $_[0]; }
3598 $elt->{att}->{$att};
3599 };
3600 $accessor{$att}=1;
3601 }
3602 }
3603 return $twig_or_class;
3604 }
3605}
3606
36072300ns{ my %accessor; # memorize accessor names so re-creating them won't trigger an error
3608sub elt_accessors
3609 {
3610 my $twig_or_class= shift;
3611 my $elt_class= ref $twig_or_class ? $twig_or_class->{twig_elt_class}
3612 : 'XML::Twig::Elt'
3613 ;
3614
3615 # if arg is a hash ref, it's exp => name, otherwise it's a list of tags
3616 my %exp_to_alias= ref( $_[0]) && isa( $_[0], 'HASH') ? %{$_[0]}
3617 : map { $_ => $_ } @_;
3618 ## no critic (TestingAndDebugging::ProhibitNoStrict);
36192159µs212µs
# spent 9µs (6+4) within XML::Twig::BEGIN@3619 which was called: # once (6µs+4µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 3619
no strict 'refs';
# spent 9µs making 1 call to XML::Twig::BEGIN@3619 # spent 4µs making 1 call to strict::unimport
3620 while( my( $alias, $exp)= each %exp_to_alias )
3621 { if( $elt_class->can( $alias) && !$accessor{$alias})
3622 { _croak( "attempt to redefine existing method $alias using elt_accessors"); }
3623
3624 if( !$accessor{$alias})
3625 { *{"$elt_class\::$alias"}=
3626 sub
3627 { my $elt= shift;
3628 return wantarray ? $elt->children( $exp) : $elt->first_child( $exp);
3629 };
3630 $accessor{$alias}=1;
3631 }
3632 }
3633 return $twig_or_class;
3634 }
3635}
3636
36372300ns{ my %accessor; # memorize accessor names so re-creating them won't trigger an error
3638sub field_accessors
3639 {
3640 my $twig_or_class= shift;
3641 my $elt_class= ref $twig_or_class ? $twig_or_class->{twig_elt_class}
3642 : 'XML::Twig::Elt'
3643 ;
3644 my %exp_to_alias= ref( $_[0]) && isa( $_[0], 'HASH') ? %{$_[0]}
3645 : map { $_ => $_ } @_;
3646
3647 ## no critic (TestingAndDebugging::ProhibitNoStrict);
36482944µs212µs
# spent 9µs (6+3) within XML::Twig::BEGIN@3648 which was called: # once (6µs+3µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 3648
no strict 'refs';
# spent 9µs making 1 call to XML::Twig::BEGIN@3648 # spent 3µs making 1 call to strict::unimport
3649 while( my( $alias, $exp)= each %exp_to_alias )
3650 { if( $elt_class->can( $alias) && !$accessor{$alias})
3651 { _croak( "attempt to redefine existing method $exp using field_accessors"); }
3652 if( !$accessor{$alias})
3653 { *{"$elt_class\::$alias"}=
3654 sub
3655 { my $elt= shift;
3656 $elt->field( $exp)
3657 };
3658 $accessor{$alias}=1;
3659 }
3660 }
3661 return $twig_or_class;
3662 }
3663}
3664
3665sub first_elt
36661100ns { my( $t, $cond)= @_;
3667 my $root= $t->root || return undef;
3668 return $root if( $root->passes( $cond));
3669 return $root->next_elt( $cond);
3670 }
3671
3672sub last_elt
3673 { my( $t, $cond)= @_;
3674 my $root= $t->root || return undef;
3675 return $root->last_descendant( $cond);
3676 }
3677
3678sub next_n_elt
3679 { my( $t, $offset, $cond)= @_;
3680 $offset -- if( $t->root->matches( $cond) );
3681 return $t->root->next_n_elt( $offset, $cond);
3682 }
3683
3684sub get_xpath
3685162µs
# spent 12.4ms (82µs+12.3) within XML::Twig::get_xpath which was called 16 times, avg 775µs/call: # once (4µs+4.71ms) by Spreadsheet::ParseXLSX::_parse_styles at line 821 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (8µs+1.71ms) by Spreadsheet::ParseXLSX::_extract_files at line 963 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+1.06ms) by Spreadsheet::ParseXLSX::_parse_themes at line 672 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+1.01ms) by Spreadsheet::ParseXLSX::_parse_styles at line 910 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+531µs) by Spreadsheet::ParseXLSX::_parse_styles at line 853 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+510µs) by Spreadsheet::ParseXLSX::_parse_styles at line 856 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (12µs+451µs) by Spreadsheet::ParseXLSX::_parse_workbook at line 204 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+450µs) by Spreadsheet::ParseXLSX::_parse_styles at line 826 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+372µs) by Spreadsheet::ParseXLSX::_parse_workbook at line 199 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+287µs) by Spreadsheet::ParseXLSX::_parse_workbook at line 136 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+256µs) by Spreadsheet::ParseXLSX::_extract_files at line 985 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+249µs) by Spreadsheet::ParseXLSX::_extract_files at line 1010 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+241µs) by Spreadsheet::ParseXLSX::_parse_workbook at line 137 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (5µs+228µs) by Spreadsheet::ParseXLSX::_extract_files at line 981 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (4µs+213µs) by Spreadsheet::ParseXLSX::_extract_files at line 983 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (7µs+44µs) by Spreadsheet::ParseXLSX::_extract_files at line 991 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm
{ my $twig= shift;
36861650µs1626µs if( isa( $_[0], 'ARRAY'))
# spent 26µs making 16 calls to UNIVERSAL::isa, avg 2µs/call
3687 { my $elt_array= shift;
3688 return _unique_elts( map { $_->get_xpath( @_) } @$elt_array);
3689 }
3690 else
36911654µs3212.3ms { return $twig->root->get_xpath( @_); }
# spent 12.3ms making 16 calls to XML::Twig::Elt::get_xpath, avg 768µs/call # spent 10µs making 16 calls to XML::Twig::root, avg 625ns/call
3692 }
3693
3694# get a list of elts and return a sorted list of unique elts
3695sub _unique_elts
36969373µs932.91ms
# spent 1.56ms (60µs+1.50) within XML::Twig::_unique_elts which was called 16 times, avg 97µs/call: # 2 times (6µs+700ns) by XML::Twig::Elt::__ANON__[(eval 62)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 62)[XML/Twig.pm:7113], avg 3µs/call # once (6µs+543µs) by XML::Twig::Elt::__ANON__[(eval 68)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 68)[XML/Twig.pm:7113] # once (7µs+529µs) by XML::Twig::Elt::__ANON__[(eval 97)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 97)[XML/Twig.pm:7113] # once (6µs+366µs) by XML::Twig::Elt::__ANON__[(eval 70)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 70)[XML/Twig.pm:7113] # once (3µs+54µs) by XML::Twig::Elt::__ANON__[(eval 87)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 87)[XML/Twig.pm:7113] # once (5µs+700ns) by XML::Twig::Elt::__ANON__[(eval 58)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 58)[XML/Twig.pm:7113] # once (4µs+700ns) by XML::Twig::Elt::__ANON__[(eval 129)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 129)[XML/Twig.pm:7113] # once (4µs+500ns) by XML::Twig::Elt::__ANON__[(eval 60)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 60)[XML/Twig.pm:7113] # once (3µs+300ns) by XML::Twig::Elt::__ANON__[(eval 64)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 64)[XML/Twig.pm:7113] # once (3µs+300ns) by XML::Twig::Elt::__ANON__[(eval 61)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 61)[XML/Twig.pm:7113] # once (3µs+300ns) by XML::Twig::Elt::__ANON__[(eval 66)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 66)[XML/Twig.pm:7113] # once (3µs+300ns) by XML::Twig::Elt::__ANON__[(eval 103)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 103)[XML/Twig.pm:7113] # once (3µs+300ns) by XML::Twig::Elt::__ANON__[(eval 63)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 63)[XML/Twig.pm:7113] # once (2µs+300ns) by XML::Twig::Elt::__ANON__[(eval 76)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 76)[XML/Twig.pm:7113] # once (2µs+300ns) by XML::Twig::Elt::__ANON__[(eval 85)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 85)[XML/Twig.pm:7113]
{ my @sorted= sort { $a ->cmp( $b) } @_;
# spent 1.50ms making 16 calls to CORE::sort, avg 94µs/call # spent 1.42ms making 77 calls to XML::Twig::Elt::cmp, avg 18µs/call
3697162µs my @unique;
36981623µs while( my $current= shift @sorted)
3699 { push @unique, $current unless( @unique && ($unique[-1] == $current)); }
37001621µs return @unique;
3701 }
3702
3703sub findvalue
3704 { my $twig= shift;
3705 if( isa( $_[0], 'ARRAY'))
3706 { my $elt_array= shift;
3707 return join( '', map { $_->findvalue( @_) } @$elt_array);
3708 }
3709 else
3710 { return $twig->root->findvalue( @_); }
3711 }
3712
3713sub findvalues
3714 { my $twig= shift;
3715 if( isa( $_[0], 'ARRAY'))
3716 { my $elt_array= shift;
3717 return map { $_->findvalues( @_) } @$elt_array;
3718 }
3719 else
3720 { return $twig->root->findvalues( @_); }
3721 }
3722
3723sub set_id_seed
3724 { my $t= shift;
3725 XML::Twig::Elt->set_id_seed( @_);
3726 return $t;
3727 }
3728
3729# return an array ref to an index, or undef
3730sub index
3731 { my( $twig, $name, $index)= @_;
3732 return defined( $index) ? $twig->{_twig_index}->{$name}->[$index] : $twig->{_twig_index}->{$name};
3733 }
3734
3735# return a list with just the root
3736# if a condition is given then return an empty list unless the root matches
3737sub children
3738 { my( $t, $cond)= @_;
3739 my $root= $t->root;
3740 unless( $cond && !($root->passes( $cond)) )
3741 { return ($root); }
3742 else
3743 { return (); }
3744 }
3745
3746sub _children { return ($_[0]->root); }
3747
3748# weird, but here for completude
3749# used to solve (non-sensical) /doc[1] XPath queries
3750sub child
3751 { my $t= shift;
3752 my $nb= shift;
3753 return ($t->children( @_))[$nb];
3754 }
3755
3756sub descendants
3757166µs
# spent 6.13ms (84µs+6.05) within XML::Twig::descendants which was called 16 times, avg 383µs/call: # 2 times (10µs+34µs) by XML::Twig::Elt::__ANON__[(eval 62)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 62)[XML/Twig.pm:7113], avg 22µs/call # once (5µs+3.87ms) by XML::Twig::Elt::__ANON__[(eval 70)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 70)[XML/Twig.pm:7113] # once (8µs+468µs) by XML::Twig::Elt::__ANON__[(eval 58)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 58)[XML/Twig.pm:7113] # once (4µs+371µs) by XML::Twig::Elt::__ANON__[(eval 85)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 85)[XML/Twig.pm:7113] # once (5µs+268µs) by XML::Twig::Elt::__ANON__[(eval 68)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 68)[XML/Twig.pm:7113] # once (5µs+179µs) by XML::Twig::Elt::__ANON__[(eval 87)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 87)[XML/Twig.pm:7113] # once (9µs+163µs) by XML::Twig::Elt::__ANON__[(eval 129)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 129)[XML/Twig.pm:7113] # once (5µs+164µs) by XML::Twig::Elt::__ANON__[(eval 76)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 76)[XML/Twig.pm:7113] # once (4µs+163µs) by XML::Twig::Elt::__ANON__[(eval 97)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 97)[XML/Twig.pm:7113] # once (5µs+124µs) by XML::Twig::Elt::__ANON__[(eval 64)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 64)[XML/Twig.pm:7113] # once (4µs+109µs) by XML::Twig::Elt::__ANON__[(eval 103)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 103)[XML/Twig.pm:7113] # once (4µs+102µs) by XML::Twig::Elt::__ANON__[(eval 66)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 66)[XML/Twig.pm:7113] # once (6µs+12µs) by XML::Twig::Elt::__ANON__[(eval 60)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 60)[XML/Twig.pm:7113] # once (4µs+11µs) by XML::Twig::Elt::__ANON__[(eval 61)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 61)[XML/Twig.pm:7113] # once (4µs+11µs) by XML::Twig::Elt::__ANON__[(eval 63)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 63)[XML/Twig.pm:7113]
{ my( $t, $cond)= @_;
37581610µs168µs my $root= $t->root;
# spent 8µs making 16 calls to XML::Twig::root, avg 494ns/call
37591616µs165.17ms if( $root->passes( $cond) )
# spent 5.17ms making 16 calls to XML::Twig::Elt::passes, avg 323µs/call
3760 { return ($root, $root->descendants( $cond)); }
3761 else
37621642µs16870µs { return ( $root->descendants( $cond)); }
# spent 870µs making 16 calls to XML::Twig::Elt::descendants, avg 54µs/call
3763 }
3764
3765sub simplify { my $t= shift; $t->root->simplify( @_); }
3766sub subs_text { my $t= shift; $t->root->subs_text( @_); }
3767sub trim { my $t= shift; $t->root->trim( @_); }
3768
3769
3770sub set_keep_encoding
377172µs
# spent 26µs (18+8) within XML::Twig::set_keep_encoding which was called 7 times, avg 4µs/call: # 7 times (18µs+8µs) by XML::Twig::new at line 655, avg 4µs/call
{ my( $t, $keep)= @_;
377272µs $t->{twig_keep_encoding}= $keep;
377372µs $t->{NoExpand}= $keep;
3774711µs78µs return XML::Twig::Elt::set_keep_encoding( $keep);
# spent 8µs making 7 calls to XML::Twig::Elt::set_keep_encoding, avg 1µs/call
3775 }
3776
3777sub set_expand_external_entities
3778711µs78µs
# spent 20µs (11+8) within XML::Twig::set_expand_external_entities which was called 7 times, avg 3µs/call: # 7 times (11µs+8µs) by XML::Twig::new at line 538, avg 3µs/call
{ return XML::Twig::Elt::set_expand_external_entities( @_); }
# spent 8µs making 7 calls to XML::Twig::Elt::set_expand_external_entities, avg 1µs/call
3779
3780sub escape_gt
3781 { my $t= shift; $t->{twig_escape_gt}= 1; return XML::Twig::Elt::escape_gt( @_); }
3782
3783sub do_not_escape_gt
3784 { my $t= shift; $t->{twig_escape_gt}= 0; return XML::Twig::Elt::do_not_escape_gt( @_); }
3785
3786sub elt_id
3787 { return $_[0]->{twig_id_list}->{$_[1]}; }
3788
3789# change it in ALL twigs at the moment
3790sub change_gi
3791 { my( $twig, $old_gi, $new_gi)= @_;
3792 my $index;
3793 return unless($index= $XML::Twig::gi2index{$old_gi});
3794 $XML::Twig::index2gi[$index]= $new_gi;
3795 delete $XML::Twig::gi2index{$old_gi};
3796 $XML::Twig::gi2index{$new_gi}= $index;
3797 return $twig;
3798 }
3799
3800
3801# builds the DTD from the stored (possibly updated) data
3802sub dtd_text
3803 { my $t= shift;
3804 my $dtd= $t->{twig_dtd};
3805 my $doctype= $t->{twig_doctype} or return '';
3806 my $string= "<!DOCTYPE ".$doctype->{name};
3807
3808 $string .= " [\n";
3809
3810 foreach my $gi (@{$dtd->{elt_list}})
3811 { $string.= "<!ELEMENT $gi ".$dtd->{model}->{$gi}.">\n" ;
3812 if( $dtd->{att}->{$gi})
3813 { my $attlist= $dtd->{att}->{$gi};
3814 $string.= "<!ATTLIST $gi\n";
3815 foreach my $att ( sort keys %{$attlist})
3816 {
3817 if( $attlist->{$att}->{fixed})
3818 { $string.= " $att $attlist->{$att}->{type} #FIXED $attlist->{$att}->{default}"; }
3819 else
3820 { $string.= " $att $attlist->{$att}->{type} $attlist->{$att}->{default}"; }
3821 $string.= "\n";
3822 }
3823 $string.= ">\n";
3824 }
3825 }
3826 $string.= $t->entity_list->text if( $t->entity_list);
3827 $string.= "\n]>\n";
3828 return $string;
3829 }
3830
3831# prints the DTD from the stored (possibly updated) data
3832sub dtd_print
3833 { my $t= shift;
3834 my $fh= isa( $_[0], 'GLOB') || isa( $_[0], 'IO::Scalar') ? shift : undef;
3835 if( $fh) { print $fh $t->dtd_text; }
3836 else { print $t->dtd_text; }
3837 return $t;
3838 }
3839
3840# build the subs that call directly expat
3841BEGIN
384211µs
# spent 29µs within XML::Twig::BEGIN@3842 which was called: # once (29µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 3858
{ my @expat_methods= qw( depth in_element within_element context
3843 current_line current_column current_byte
3844 recognized_string original_string
3845 xpcroak xpcarp
3846 base current_element element_index
3847 xml_escape
3848 position_in_context);
384913µs foreach my $method (@expat_methods)
3850 {
3851 ## no critic (TestingAndDebugging::ProhibitNoStrict);
3852270µs214µs
# spent 10µs (6+4) within XML::Twig::BEGIN@3852 which was called: # once (6µs+4µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 3852
no strict 'refs';
# spent 10µs making 1 call to XML::Twig::BEGIN@3852 # spent 4µs making 1 call to strict::unimport
3853 *{$method}= sub { my $t= shift;
3854 _croak( "calling $method after parsing is finished") unless( $t->{twig_parsing});
3855 return $t->{twig_parser}->$method(@_);
38561625µs };
3857 }
385811.21ms129µs }
# spent 29µs making 1 call to XML::Twig::BEGIN@3842
3859
3860sub path
3861 { my( $t, $gi)= @_;
3862 if( $t->{twig_map_xmlns})
3863 { return "/" . join( "/", map { $t->_replace_prefix( $_)} ($t->{twig_parser}->context, $gi)); }
3864 else
3865 { return "/" . join( "/", ($t->{twig_parser}->context, $gi)); }
3866 }
3867
3868sub finish
3869 { my $t= shift;
3870 return $t->{twig_parser}->finish;
3871 }
3872
3873# just finish the parse by printing the rest of the document
3874sub finish_print
3875 { my( $t, $fh)= @_;
3876 my $old_fh;
3877 unless( defined $fh)
3878 { $t->_set_fh_to_twig_output_fh(); }
3879 elsif( defined $fh)
3880 { $old_fh= select $fh;
3881 $t->{twig_original_selected_fh}= $old_fh if( $old_fh);
3882 }
3883
3884 my $p=$t->{twig_parser};
3885 if( $t->{twig_keep_encoding})
3886 { $p->setHandlers( %twig_handlers_finish_print); }
3887 else
3888 { $p->setHandlers( %twig_handlers_finish_print_original); }
3889 return $t;
3890 }
3891
3892710µs75µs
# spent 14µs (9+5) within XML::Twig::set_remove_cdata which was called 7 times, avg 2µs/call: # 7 times (9µs+5µs) by XML::Twig::new at line 675, avg 2µs/call
sub set_remove_cdata { return XML::Twig::Elt::set_remove_cdata( @_); }
# spent 5µs making 7 calls to XML::Twig::Elt::set_remove_cdata, avg 729ns/call
3893
3894sub output_filter { return XML::Twig::Elt::output_filter( @_); }
3895710µs725µs
# spent 34µs (9+25) within XML::Twig::set_output_filter which was called 7 times, avg 5µs/call: # 7 times (9µs+25µs) by XML::Twig::new at line 668, avg 5µs/call
sub set_output_filter { return XML::Twig::Elt::set_output_filter( @_); }
# spent 25µs making 7 calls to XML::Twig::Elt::set_output_filter, avg 4µs/call
3896
3897sub output_text_filter { return XML::Twig::Elt::output_text_filter( @_); }
389879µs720µs
# spent 28µs (9+20) within XML::Twig::set_output_text_filter which was called 7 times, avg 4µs/call: # 7 times (9µs+20µs) by XML::Twig::new at line 682, avg 4µs/call
sub set_output_text_filter { return XML::Twig::Elt::set_output_text_filter( @_); }
# spent 20µs making 7 calls to XML::Twig::Elt::set_output_text_filter, avg 3µs/call
3899
3900sub set_input_filter
3901 { my( $t, $input_filter)= @_;
3902 my $old_filter= $t->{twig_input_filter};
3903 if( !$input_filter || isa( $input_filter, 'CODE') )
3904 { $t->{twig_input_filter}= $input_filter; }
3905 elsif( $input_filter eq 'latin1')
3906 { $t->{twig_input_filter}= latin1(); }
3907 elsif( $filter{$input_filter})
3908 { $t->{twig_input_filter}= $filter{$input_filter}; }
3909 else
3910 { _croak( "invalid input filter: $input_filter"); }
3911
3912 return $old_filter;
3913 }
3914
3915sub set_empty_tag_style
3916 { return XML::Twig::Elt::set_empty_tag_style( @_); }
3917
3918sub set_pretty_print
3919 { return XML::Twig::Elt::set_pretty_print( @_); }
3920
3921sub set_quote
392278µs711µs
# spent 22µs (11+11) within XML::Twig::set_quote which was called 7 times, avg 3µs/call: # 7 times (11µs+11µs) by XML::Twig::new at line 720, avg 3µs/call
{ return XML::Twig::Elt::set_quote( @_); }
# spent 11µs making 7 calls to XML::Twig::Elt::set_quote, avg 2µs/call
3923
3924sub set_indent
3925 { return XML::Twig::Elt::set_indent( @_); }
3926
3927sub set_keep_atts_order
39281410µs77µs
# spent 17µs (10+7) within XML::Twig::set_keep_atts_order which was called 7 times, avg 2µs/call: # 7 times (10µs+7µs) by XML::Twig::new at line 692, avg 2µs/call
{ shift; return XML::Twig::Elt::set_keep_atts_order( @_); }
# spent 7µs making 7 calls to XML::Twig::Elt::set_keep_atts_order, avg 971ns/call
3929
3930sub keep_atts_order
3931 { return XML::Twig::Elt::keep_atts_order( @_); }
3932
3933sub set_do_not_escape_amp_in_atts
3934724µs77µs
# spent 17µs (11+7) within XML::Twig::set_do_not_escape_amp_in_atts which was called 7 times, avg 2µs/call: # 7 times (11µs+7µs) by XML::Twig::new at line 554, avg 2µs/call
{ return XML::Twig::Elt::set_do_not_escape_amp_in_atts( @_); }
# spent 7µs making 7 calls to XML::Twig::Elt::set_do_not_escape_amp_in_atts, avg 943ns/call
3935
3936# save and restore package globals (the ones in XML::Twig::Elt)
3937# should probably return the XML::Twig object itself, but instead
3938# returns the state (as a hashref) for backward compatibility
3939sub save_global_state
3940 { my $t= shift;
3941 return $t->{twig_saved_state}= XML::Twig::Elt::global_state();
3942 }
3943
3944sub restore_global_state
3945 { my $t= shift;
3946 XML::Twig::Elt::set_global_state( $t->{twig_saved_state});
3947 }
3948
3949sub global_state
3950 { return XML::Twig::Elt::global_state(); }
3951
3952sub set_global_state
3953 { return XML::Twig::Elt::set_global_state( $_[1]); }
3954
3955sub dispose
3956 { my $t= shift;
3957 $t->DESTROY;
3958 return;
3959 }
3960
3961sub DESTROY
396261µs
# spent 584µs (125+459) within XML::Twig::DESTROY which was called 6 times, avg 97µs/call: # 3 times (49µs+305µs) by Spreadsheet::ParseXLSX::_parse_workbook at line 208 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 118µs/call # 2 times (32µs+137µs) by Spreadsheet::ParseXLSX::_extract_files at line 1013 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 85µs/call # once (44µs+18µs) by XML::Twig::_checked_parse_result at line 801
{ my $t= shift;
3963623µs12460µs if( $t->{twig_root} && isa( $t->{twig_root}, 'XML::Twig::Elt'))
# spent 456µs making 6 calls to XML::Twig::Elt::delete, avg 76µs/call # spent 4µs making 6 calls to UNIVERSAL::isa, avg 600ns/call
3964 { $t->{twig_root}->delete }
3965
3966 # added to break circular references
396763µs undef $t->{twig};
396862µs undef $t->{twig_root}->{twig} if( $t->{twig_root});
396962µs undef $t->{twig_parser};
3970
3971688µs undef %$t;# prevents memory leaks (especially when using mod_perl)
3972611µs undef $t;
3973 }
3974
3975# return true if perl was compiled using perlio
3976# if perl is not available return true, these days perlio should be used
3977sub _use_perlio
3978 { my $perl= _this_perl();
3979 return $perl ? grep /useperlio=define/, `$perl -V` : 1;
3980 }
3981
3982# returns the parth to the perl executable (if available)
3983sub _this_perl
3984 { # straight from perlvar
3985 my $secure_perl_path= $Config{perlpath};
3986 if ($^O ne 'VMS')
3987 { $secure_perl_path .= $Config{_exe} unless $secure_perl_path =~ m/$Config{_exe}$/i; }
3988 if( ! -f $secure_perl_path) { $secure_perl_path= ''; } # when perl is not available (PDK)
3989 return $secure_perl_path;
3990 }
3991
3992#
3993# non standard handlers
3994#
3995
3996# kludge: expat 1.95.2 calls both Default AND Doctype handlers
3997# so if the default handler finds '<!DOCTYPE' then it must
3998# unset itself (_twig_print_doctype will reset it)
3999sub _twig_print_check_doctype
4000 { # warn " in _twig_print_check_doctype...\n"; # DEBUG handler
4001
4002 my $p= shift;
4003 my $string= $p->recognized_string();
4004 if( $string eq '<!DOCTYPE')
4005 {
4006 $p->setHandlers( Default => undef);
4007 $p->setHandlers( Entity => undef);
4008 $expat_1_95_2=1;
4009 }
4010 else
4011 { print $string; }
4012
4013 return;
4014 }
4015
4016
4017sub _twig_print
4018 { # warn " in _twig_print...\n"; # DEBUG handler
4019 my $p= shift;
4020 if( $expat_1_95_2 && ($p->recognized_string eq '[') && !$p->{twig}->{expat_1_95_2_seen_bracket})
4021 { # otherwise the opening square bracket of the doctype gets printed twice
4022 $p->{twig}->{expat_1_95_2_seen_bracket}=1;
4023 }
4024 else
4025 { if( $p->{twig}->{twig_right_after_root})
4026 { my $s= $p->recognized_string(); print $s if $s=~ m{\S}; }
4027 else
4028 { print $p->recognized_string(); }
4029 }
4030 return;
4031 }
4032# recognized_string does not seem to work for entities, go figure!
4033# so this handler is used to print them anyway
4034sub _twig_print_entity
4035 { # warn " in _twig_print_entity...\n"; # DEBUG handler
4036 my $p= shift;
4037 XML::Twig::Entity->new( @_)->print;
4038 }
4039
4040# kludge: expat 1.95.2 calls both Default AND Doctype handlers
4041# so if the default handler finds '<!DOCTYPE' then it must
4042# unset itself (_twig_print_doctype will reset it)
4043sub _twig_print_original_check_doctype
4044 { # warn " in _twig_print_original_check_doctype...\n"; # DEBUG handler
4045
4046 my $p= shift;
4047 my $string= $p->original_string();
4048 if( $string eq '<!DOCTYPE')
4049 { $p->setHandlers( Default => undef);
4050 $p->setHandlers( Entity => undef);
4051 $expat_1_95_2=1;
4052 }
4053 else
4054 { print $string; }
4055
4056 return;
4057 }
4058
4059sub _twig_print_original
4060 { # warn " in _twig_print_original...\n"; # DEBUG handler
4061 my $p= shift;
4062 print $p->original_string();
4063 return;
4064 }
4065
4066
4067sub _twig_print_original_doctype
4068 { # warn " in _twig_print_original_doctype...\n"; # DEBUG handler
4069
4070 my( $p, $name, $sysid, $pubid, $internal)= @_;
4071 if( $name)
4072 { # with recent versions of XML::Parser original_string does not work,
4073 # hence we need to rebuild the doctype declaration
4074 my $doctype='';
4075 $doctype .= qq{<!DOCTYPE $name} if( $name);
4076 $doctype .= qq{ PUBLIC "$pubid"} if( $pubid);
4077 $doctype .= qq{ SYSTEM} if( $sysid && !$pubid);
4078 $doctype .= qq{ "$sysid"} if( $sysid);
4079 $doctype .= ' [' if( $internal && !$expat_1_95_2) ;
4080 $doctype .= qq{>} unless( $internal || $expat_1_95_2);
4081 $p->{twig}->{twig_doctype}->{has_internal}=$internal;
4082 print $doctype;
4083 }
4084 $p->setHandlers( Default => \&_twig_print_original);
4085 return;
4086 }
4087
4088sub _twig_print_doctype
4089 { # warn " in _twig_print_doctype...\n"; # DEBUG handler
4090 my( $p, $name, $sysid, $pubid, $internal)= @_;
4091 if( $name)
4092 { # with recent versions of XML::Parser original_string does not work,
4093 # hence we need to rebuild the doctype declaration
4094 my $doctype='';
4095 $doctype .= qq{<!DOCTYPE $name} if( $name);
4096 $doctype .= qq{ PUBLIC "$pubid"} if( $pubid);
4097 $doctype .= qq{ SYSTEM} if( $sysid && !$pubid);
4098 $doctype .= qq{ "$sysid"} if( $sysid);
4099 $doctype .= ' [' if( $internal) ;
4100 $doctype .= qq{>} unless( $internal || $expat_1_95_2);
4101 $p->{twig}->{twig_doctype}->{has_internal}=$internal;
4102 print $doctype;
4103 }
4104 $p->setHandlers( Default => \&_twig_print);
4105 return;
4106 }
4107
4108
4109sub _twig_print_original_default
4110 { # warn " in _twig_print_original_default...\n"; # DEBUG handler
4111 my $p= shift;
4112 print $p->original_string();
4113 return;
4114 }
4115
4116# account for the case where the element is empty
4117sub _twig_print_end_original
4118 { # warn " in _twig_print_end_original...\n"; # DEBUG handler
4119 my $p= shift;
4120 print $p->original_string();
4121 return;
4122 }
4123
4124sub _twig_start_check_roots
4125
# spent 8.21s (720ms+7.49) within XML::Twig::_twig_start_check_roots which was called 33799 times, avg 243µs/call: # 33799 times (720ms+7.49s) by XML::Parser::Expat::ParseString at line 486 of XML/Parser/Expat.pm, avg 243µs/call
{ # warn " in _twig_start_check_roots...\n"; # DEBUG handler
4126337994.60ms my $p= shift;
4127337998.37ms my $gi= shift;
4128
4129337997.52ms my $t= $p->{twig};
4130
41313379985.8ms3379928.9ms my $fh= $t->{twig_output_fh} || select() || \*STDOUT;
# spent 28.9ms making 33799 calls to CORE::select, avg 856ns/call
4132
4133337993.31ms my $ns_decl;
41343379958.4ms675972.51s unless( $p->depth == 0)
# spent 2.49s making 33798 calls to XML::Twig::_replace_ns, avg 74µs/call # spent 21.4ms making 33799 calls to XML::Parser::Expat::depth, avg 633ns/call
4135 { if( $t->{twig_map_xmlns}) { $ns_decl= _replace_ns( $t, \$gi, \@_); }
4136 }
4137
41383379946.1ms my $context= { $ST_TAG => $gi, @_};
4139337993.39ms $context->{$ST_NS}= $ns_decl if $ns_decl;
41403379910.8ms push @{$t->{_twig_context_stack}}, $context;
41413379924.1ms my %att= @_;
4142
41433379924.8ms33799409ms if( _handler( $t, $t->{twig_roots}, $gi))
# spent 409ms making 33799 calls to XML::Twig::_handler, avg 12µs/call
41443379255.3ms337921.70s { $p->setHandlers( %twig_handlers); # restore regular handlers
# spent 1.70s making 33792 calls to XML::Parser::Expat::setHandlers, avg 50µs/call
41453379224.7ms3379220.3ms $t->{twig_root_depth}= $p->depth;
# spent 20.3ms making 33792 calls to XML::Parser::Expat::depth, avg 600ns/call
4146337929.42ms pop @{$t->{_twig_context_stack}}; # will be pushed back in _twig_start
41473379222.5ms337922.81s _twig_start( $p, $gi, @_);
# spent 2.81s making 33792 calls to XML::Twig::_twig_start, avg 83µs/call
414833792119ms return;
4149 }
4150
4151 # $tag will always be true if it needs to be printed (the tag string is never empty)
415273µs my $tag= $t->{twig_default_print} ? $t->{twig_keep_encoding} ? $p->original_string
4153 : $p->recognized_string
4154 : '';
4155
415676µs73µs if( $p->depth == 0)
# spent 3µs making 7 calls to XML::Parser::Expat::depth, avg 471ns/call
4157 {
4158 ## no critic (TestingAndDebugging::ProhibitNoStrict);
41592107µs214µs
# spent 10µs (6+4) within XML::Twig::BEGIN@4159 which was called: # once (6µs+4µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 4159
no strict 'refs';
# spent 10µs making 1 call to XML::Twig::BEGIN@4159 # spent 4µs making 1 call to strict::unimport
41601300ns print {$fh} $tag if( $tag);
41611500ns pop @{$t->{_twig_context_stack}}; # will be pushed back in _twig_start
416212µs1236µs _twig_start( $p, $gi, @_);
# spent 236µs making 1 call to XML::Twig::_twig_start
416312µs1700ns $t->root->{'flushed'}=1; # or the root start tag gets output the first time we flush
# spent 700ns making 1 call to XML::Twig::root
4164 }
4165 elsif( $t->{twig_starttag_handlers})
4166 { # look for start tag handlers
4167
4168 my @handlers= _handler( $t, $t->{twig_starttag_handlers}, $gi);
4169 my $last_handler_res;
4170 foreach my $handler ( @handlers)
4171 { $last_handler_res= $handler->($t, $gi, %att);
4172 last unless $last_handler_res;
4173 }
4174 ## no critic (TestingAndDebugging::ProhibitNoStrict);
4175232µs211µs
# spent 8µs (5+3) within XML::Twig::BEGIN@4175 which was called: # once (5µs+3µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 4175
no strict 'refs';
# spent 8µs making 1 call to XML::Twig::BEGIN@4175 # spent 3µs making 1 call to strict::unimport
4176 print {$fh} $tag if( $tag && (!@handlers || $last_handler_res));
4177 }
4178 else
4179 {
4180 ## no critic (TestingAndDebugging::ProhibitNoStrict);
41812140µs28µs
# spent 6µs (4+2) within XML::Twig::BEGIN@4181 which was called: # once (4µs+2µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 4181
no strict 'refs';
# spent 6µs making 1 call to XML::Twig::BEGIN@4181 # spent 2µs making 1 call to strict::unimport
41826700ns print {$fh} $tag if( $tag);
4183 }
4184711µs return;
4185 }
4186
4187sub _twig_end_check_roots
4188
# spent 80µs (50+30) within XML::Twig::_twig_end_check_roots which was called 7 times, avg 11µs/call: # 7 times (50µs+30µs) by XML::Parser::Expat::ParseString at line 486 of XML/Parser/Expat.pm, avg 11µs/call
{ # warn " in _twig_end_check_roots...\n"; # DEBUG handler
4189
419073µs my( $p, $gi, %att)= @_;
419172µs my $t= $p->{twig};
4192 # $tag can be empty (<elt/>), hence the undef and the tests for defined
419373µs my $tag= $t->{twig_default_print} ? $t->{twig_keep_encoding} ? $p->original_string
4194 : $p->recognized_string
4195 : undef;
4196715µs75µs my $fh= $t->{twig_output_fh} || select() || \*STDOUT;
# spent 5µs making 7 calls to CORE::select, avg 657ns/call
4197
419872µs if( $t->{twig_endtag_handlers})
4199 { # look for end tag handlers
4200 my @handlers= _handler( $t, $t->{twig_endtag_handlers}, $gi);
4201 my $last_handler_res=1;
4202 foreach my $handler ( @handlers)
4203 { $last_handler_res= $handler->($t, $gi) || last; }
4204 #if( ! $last_handler_res)
4205 # { pop @{$t->{_twig_context_stack}}; warn "tested";
4206 # return;
4207 # }
4208 }
4209 {
4210 ## no critic (TestingAndDebugging::ProhibitNoStrict);
42119166µs211µs
# spent 8µs (5+3) within XML::Twig::BEGIN@4211 which was called: # once (5µs+3µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 4211
no strict 'refs';
# spent 8µs making 1 call to XML::Twig::BEGIN@4211 # spent 3µs making 1 call to strict::unimport
421271µs print {$fh} $tag if( defined $tag);
4213 }
421476µs73µs if( $p->depth == 0)
# spent 3µs making 7 calls to XML::Parser::Expat::depth, avg 457ns/call
4215 {
42161700ns121µs _twig_end( $p, $gi);
# spent 21µs making 1 call to XML::Twig::_twig_end
421712µs11µs $t->root->{end_tag_flushed}=1;
# spent 1µs making 1 call to XML::Twig::root
4218 }
4219
422076µs pop @{$t->{_twig_context_stack}};
422179µs return;
4222 }
4223
4224sub _twig_pi_check_roots
4225 { # warn " in _twig_pi_check_roots...\n"; # DEBUG handler
4226 my( $p, $target, $data)= @_;
4227 my $t= $p->{twig};
4228 my $pi= $t->{twig_default_print} ? $t->{twig_keep_encoding} ? $p->original_string
4229 : $p->recognized_string
4230 : undef;
4231 my $fh= $t->{twig_output_fh} || select() || \*STDOUT;
4232
4233 if( my $handler= $t->{twig_handlers}->{pi_handlers}->{$target}
4234 || $t->{twig_handlers}->{pi_handlers}->{''}
4235 )
4236 { # if handler is called on pi, then it needs to be processed as a regular node
4237 my @flags= qw( twig_process_pi twig_keep_pi);
4238 my @save= @{$t}{@flags}; # save pi related flags
4239 @{$t}{@flags}= (1, 0); # override them, pi needs to be processed
4240 _twig_pi( @_); # call handler on the pi
4241 @{$t}{@flags}= @save;; # restore flag
4242 }
4243 else
4244 {
4245 ## no critic (TestingAndDebugging::ProhibitNoStrict);
424621.52ms211µs
# spent 8µs (5+3) within XML::Twig::BEGIN@4246 which was called: # once (5µs+3µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 4246
no strict 'refs';
# spent 8µs making 1 call to XML::Twig::BEGIN@4246 # spent 3µs making 1 call to strict::unimport
4247 print {$fh} $pi if( defined( $pi));
4248 }
4249 return;
4250 }
4251
4252
4253sub _output_ignored
4254 { my( $t, $p)= @_;
4255 my $action= $t->{twig_ignore_action};
4256
4257 my $get_string= $t->{twig_keep_encoding} ? 'original_string' : 'recognized_string';
4258
4259 if( $action eq 'print' ) { print $p->$get_string; }
4260 else
4261 { my $string_ref;
4262 if( $action eq 'string')
4263 { $string_ref= \$t->{twig_buffered_string}; }
4264 elsif( ref( $action) && ref( $action) eq 'SCALAR')
4265 { $string_ref= $action; }
4266 else
4267 { _croak( "wrong ignore action: $action"); }
4268
4269 $$string_ref .= $p->$get_string;
4270 }
4271 }
4272
4273
4274
4275sub _twig_ignore_start
4276 { # warn " in _twig_ignore_start...\n"; # DEBUG handler
4277
4278 my( $p, $gi)= @_;
4279 my $t= $p->{twig};
4280 $t->{twig_ignore_level}++;
4281 my $action= $t->{twig_ignore_action};
4282
4283 $t->_output_ignored( $p) unless $action eq 'discard';
4284 return;
4285 }
4286
4287sub _twig_ignore_end
4288 { # warn " in _twig_ignore_end...\n"; # DEBUG handler
4289
4290 my( $p, $gi)= @_;
4291 my $t= $p->{twig};
4292
4293 my $action= $t->{twig_ignore_action};
4294 $t->_output_ignored( $p) unless $action eq 'discard';
4295
4296 $t->{twig_ignore_level}--;
4297
4298 if( ! $t->{twig_ignore_level})
4299 {
4300 $t->{twig_current} = $t->{twig_ignore_elt};
4301 $t->{twig_current}->{'twig_current'}=1;
4302
4303 $t->{twig_ignore_elt}->cut; # there could possibly be a memory leak here (delete would avoid it,
4304 # but could also delete elements that should not be deleted)
4305
4306 # restore the saved stack to the current level
4307 splice( @{$t->{_twig_context_stack}}, $p->depth+ 1 );
4308 #warn "stack: ", _dump_stack( $t->{_twig_context_stack}), "\n";
4309
4310 $p->setHandlers( @{$t->{twig_saved_handlers}});
4311 # test for handlers
4312 if( $t->{twig_endtag_handlers})
4313 { # look for end tag handlers
4314 my @handlers= _handler( $t, $t->{twig_endtag_handlers}, $gi);
4315 my $last_handler_res=1;
4316 foreach my $handler ( @handlers)
4317 { $last_handler_res= $handler->($t, $gi) || last; }
4318 }
4319 pop @{$t->{_twig_context_stack}};
4320 };
4321 return;
4322 }
4323
4324#sub _dump_stack { my( $stack)= @_; return join( ":", map { $_->{$ST_TAG} } @$stack); }
4325
4326sub ignore
4327 { my( $t, $elt, $action)= @_;
4328 my $current= $t->{twig_current};
4329
4330 if( ! ($elt && ref( $elt) && isa( $elt, 'XML::Twig::Elt'))) { $elt= $current; }
4331
4332 #warn "ignore: current = ", $current->tag, ", elt = ", $elt->tag, ")\n";
4333
4334 # we need the ($elt == $current->{last_child}) test because the current element is set to the
4335 # parent _before_ handlers are called (and I can't figure out how to fix this)
4336 unless( ($elt == $current) || ($current->{last_child} && ($elt == $current->{last_child})) || $current->in( $elt))
4337 { _croak( "element to be ignored must be ancestor of current element"); }
4338
4339 $t->{twig_ignore_level}= $current == $elt ? 1 : $t->_level_in_stack( $current) - $t->_level_in_stack($elt) + 1;
4340 #warn "twig_ignore_level: $t->{twig_ignore_level} (current: ", $current->tag, ", elt: ", $elt->tag, ")\n";
4341 $t->{twig_ignore_elt} = $elt; # save it, so we can delete it later
4342
4343 $action ||= 'discard';
4344 if( !($action eq 'print' || $action eq 'string' || ( ref( $action) && ref( $action) eq 'SCALAR')))
4345 { $action= 'discard'; }
4346
4347 $t->{twig_ignore_action}= $action;
4348
4349 my $p= $t->{twig_parser};
4350 my @saved_handlers= $p->setHandlers( %twig_handlers_ignore); # set handlers
4351
4352 my $get_string= $t->{twig_keep_encoding} ? 'original_string' : 'recognized_string';
4353
4354 my $default_handler;
4355
4356 if( $action ne 'discard')
4357 { if( $action eq 'print')
4358 { $p->setHandlers( Default => sub { print $_[0]->$get_string; }); }
4359 else
4360 { my $string_ref;
4361 if( $action eq 'string')
4362 { if( ! exists $t->{twig_buffered_string}) { $t->{twig_buffered_string}=''; }
4363 $string_ref= \$t->{twig_buffered_string};
4364 }
4365 elsif( ref( $action) && ref( $action) eq 'SCALAR')
4366 { $string_ref= $action; }
4367
4368 $p->setHandlers( Default => sub { $$string_ref .= $_[0]->$get_string; });
4369 }
4370 $t->_output_ignored( $p, $action);
4371 }
4372
4373
4374 $t->{twig_saved_handlers}= \@saved_handlers; # save current handlers
4375 }
4376
4377sub _level_in_stack
4378 { my( $t, $elt)= @_;
4379 my $level=1;
4380 foreach my $elt_in_stack ( @{$t->{_twig_context_stack}} )
4381 { if( $elt_in_stack->{$ST_ELT} && ($elt == $elt_in_stack->{$ST_ELT})) { return $level }
4382 $level++;
4383 }
4384 }
4385
- -
4388# select $t->{twig_output_fh} and store the current selected fh
4389sub _set_fh_to_twig_output_fh
439071µs
# spent 6µs within XML::Twig::_set_fh_to_twig_output_fh which was called 7 times, avg 929ns/call: # 7 times (6µs+0s) by XML::Twig::_twig_init at line 1974, avg 929ns/call
{ my $t= shift;
439171µs my $output_fh= $t->{twig_output_fh};
439276µs if( $output_fh && !$t->{twig_output_fh_selected})
4393 { # there is an output fh
4394 $t->{twig_selected_fh}= select(); # store the currently selected fh
4395 $t->{twig_output_fh_selected}=1;
4396 select $output_fh; # select the output fh for the twig
4397 }
4398 }
4399
4400# select the fh that was stored in $t->{twig_selected_fh}
4401# (before $t->{twig_output_fh} was selected)
4402sub _set_fh_to_selected_fh
440371µs
# spent 8µs within XML::Twig::_set_fh_to_selected_fh which was called 7 times, avg 1µs/call: # 7 times (8µs+0s) by XML::Twig::_twig_final at line 2736, avg 1µs/call
{ my $t= shift;
440479µs return unless( $t->{twig_output_fh});
4405 my $selected_fh= $t->{twig_selected_fh};
4406 $t->{twig_output_fh_selected}=0;
4407 select $selected_fh;
4408 return;
4409 }
4410
4411
4412sub encoding
4413 { return $_[0]->{twig_xmldecl}->{encoding} if( $_[0]->{twig_xmldecl}); }
4414
4415sub set_encoding
4416 { my( $t, $encoding)= @_;
4417 $t->{twig_xmldecl} ||={};
4418 $t->set_xml_version( "1.0") unless( $t->xml_version);
4419 $t->{twig_xmldecl}->{encoding}= $encoding;
4420 return $t;
4421 }
4422
4423sub output_encoding
4424 { return $_[0]->{output_encoding}; }
4425
4426sub set_output_encoding
4427 { my( $t, $encoding)= @_;
4428 my $output_filter= $t->output_filter || '';
4429
4430 if( ($encoding && $encoding !~ m{^utf-?8$}i) || $t->{twig_keep_encoding} || $output_filter)
4431 { $t->set_output_filter( _encoding_filter( $encoding || '')); }
4432
4433 $t->{output_encoding}= $encoding;
4434 return $t;
4435 }
4436
4437sub xml_version
4438 { return $_[0]->{twig_xmldecl}->{version} if( $_[0]->{twig_xmldecl}); }
4439
4440sub set_xml_version
4441 { my( $t, $version)= @_;
4442 $t->{twig_xmldecl} ||={};
4443 $t->{twig_xmldecl}->{version}= $version;
4444 return $t;
4445 }
4446
4447sub standalone
4448 { return $_[0]->{twig_xmldecl}->{standalone} if( $_[0]->{twig_xmldecl}); }
4449
4450sub set_standalone
4451 { my( $t, $standalone)= @_;
4452 $t->{twig_xmldecl} ||={};
4453 $t->set_xml_version( "1.0") unless( $t->xml_version);
4454 $t->{twig_xmldecl}->{standalone}= $standalone;
4455 return $t;
4456 }
4457
4458
4459# SAX methods
4460
4461sub toSAX1
4462 { _croak( "cannot use toSAX1 while parsing (use flush_toSAX1)") if (defined $_[0]->{twig_parser});
4463 shift(@_)->_toSAX(@_, \&XML::Twig::Elt::_start_tag_data_SAX1,
4464 \&XML::Twig::Elt::_end_tag_data_SAX1
4465 );
4466 }
4467
4468sub toSAX2
4469 { _croak( "cannot use toSAX2 while parsing (use flush_toSAX2)") if (defined $_[0]->{twig_parser});
4470 shift(@_)->_toSAX(@_, \&XML::Twig::Elt::_start_tag_data_SAX2,
4471 \&XML::Twig::Elt::_end_tag_data_SAX2
4472 );
4473 }
4474
4475
4476sub _toSAX
4477 { my( $t, $handler, $start_tag_data, $end_tag_data) = @_;
4478
4479 if( my $start_document = $handler->can( 'start_document'))
4480 { $start_document->( $handler); }
4481
4482 $t->_prolog_toSAX( $handler);
4483
4484 if( $t->root) { $t->root->_toSAX( $handler, $start_tag_data, $end_tag_data) ; }
4485 if( my $end_document = $handler->can( 'end_document'))
4486 { $end_document->( $handler); }
4487 }
4488
4489
4490sub flush_toSAX1
4491 { shift(@_)->_flush_toSAX(@_, \&XML::Twig::Elt::_start_tag_data_SAX1,
4492 \&XML::Twig::Elt::_end_tag_data_SAX1
4493 );
4494 }
4495
4496sub flush_toSAX2
4497 { shift(@_)->_flush_toSAX(@_, \&XML::Twig::Elt::_start_tag_data_SAX2,
4498 \&XML::Twig::Elt::_end_tag_data_SAX2
4499 );
4500 }
4501
4502sub _flush_toSAX
4503 { my( $t, $handler, $start_tag_data, $end_tag_data)= @_;
4504
4505 # the "real" last element processed, as _twig_end has closed it
4506 my $last_elt;
4507 if( $t->{twig_current})
4508 { $last_elt= $t->{twig_current}->{last_child}; }
4509 else
4510 { $last_elt= $t->{twig_root}; }
4511
4512 my $elt= $t->{twig_root};
4513 unless( $elt->{'flushed'})
4514 { # init unless already done (ie root has been flushed)
4515 if( my $start_document = $handler->can( 'start_document'))
4516 { $start_document->( $handler); }
4517 # flush the DTD
4518 $t->_prolog_toSAX( $handler)
4519 }
4520
4521 while( $elt)
4522 { my $next_elt;
4523 if( $last_elt && $last_elt->in( $elt))
4524 {
4525 unless( $elt->{'flushed'})
4526 { # just output the front tag
4527 if( my $start_element = $handler->can( 'start_element'))
4528 { if( my $tag_data= $start_tag_data->( $elt))
4529 { $start_element->( $handler, $tag_data); }
4530 }
4531 $elt->{'flushed'}=1;
4532 }
4533 $next_elt= $elt->{first_child};
4534 }
4535 else
4536 { # an element before the last one or the last one,
4537 $next_elt= $elt->{next_sibling};
4538 $elt->_toSAX( $handler, $start_tag_data, $end_tag_data);
4539 $elt->delete;
4540 last if( $last_elt && ($elt == $last_elt));
4541 }
4542 $elt= $next_elt;
4543 }
4544 if( !$t->{twig_parsing})
4545 { if( my $end_document = $handler->can( 'end_document'))
4546 { $end_document->( $handler); }
4547 }
4548 }
4549
4550
4551sub _prolog_toSAX
4552 { my( $t, $handler)= @_;
4553 $t->_xmldecl_toSAX( $handler);
4554 $t->_DTD_toSAX( $handler);
4555 }
4556
4557sub _xmldecl_toSAX
4558 { my( $t, $handler)= @_;
4559 my $decl= $t->{twig_xmldecl};
4560 my $data= { Version => $decl->{version},
4561 Encoding => $decl->{encoding},
4562 Standalone => $decl->{standalone},
4563 };
4564 if( my $xml_decl= $handler->can( 'xml_decl'))
4565 { $xml_decl->( $handler, $data); }
4566 }
4567
4568sub _DTD_toSAX
4569 { my( $t, $handler)= @_;
4570 my $doctype= $t->{twig_doctype};
4571 return unless( $doctype);
4572 my $data= { Name => $doctype->{name},
4573 PublicId => $doctype->{pub},
4574 SystemId => $doctype->{sysid},
4575 };
4576
4577 if( my $start_dtd= $handler->can( 'start_dtd'))
4578 { $start_dtd->( $handler, $data); }
4579
4580 # I should call code to export the internal subset here
4581
4582 if( my $end_dtd= $handler->can( 'end_dtd'))
4583 { $end_dtd->( $handler); }
4584 }
4585
4586# input/output filters
4587
4588sub latin1
4589 { local $SIG{__DIE__};
4590 if( _use( 'Encode'))
4591 { return encode_convert( 'ISO-8859-15'); }
4592 elsif( _use( 'Text::Iconv'))
4593 { return iconv_convert( 'ISO-8859-15'); }
4594 elsif( _use( 'Unicode::Map8') && _use( 'Unicode::String'))
4595 { return unicode_convert( 'ISO-8859-15'); }
4596 else
4597 { return \&regexp2latin1; }
4598 }
4599
4600sub _encoding_filter
4601 {
4602 { local $SIG{__DIE__};
4603 my $encoding= $_[1] || $_[0];
4604 if( _use( 'Encode'))
4605 { my $sub= encode_convert( $encoding);
4606 return $sub;
4607 }
4608 elsif( _use( 'Text::Iconv'))
4609 { return iconv_convert( $encoding); }
4610 elsif( _use( 'Unicode::Map8') && _use( 'Unicode::String'))
4611 { return unicode_convert( $encoding); }
4612 }
4613 _croak( "Encode, Text::Iconv or Unicode::Map8 and Unicode::String need to be installed in order to use encoding options");
4614 }
4615
4616# shamelessly lifted from XML::TyePYX (works only with XML::Parse 2.27)
4617sub regexp2latin1
4618 { my $text=shift;
4619 $text=~s{([\xc0-\xc3])(.)}{ my $hi = ord($1);
4620 my $lo = ord($2);
4621 chr((($hi & 0x03) <<6) | ($lo & 0x3F))
4622 }ge;
4623 return $text;
4624 }
4625
4626
4627sub html_encode
4628 { _use( 'HTML::Entities') or croak "cannot use html_encode: missing HTML::Entities";
4629 return HTML::Entities::encode_entities($_[0] );
4630 }
4631
4632sub safe_encode
4633 { my $str= shift;
4634 if( $perl_version < 5.008)
4635 { # the no utf8 makes the regexp work in 5.6
4636291µs212µs
# spent 10µs (8+2) within XML::Twig::BEGIN@4636 which was called: # once (8µs+2µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 4636
no utf8; # = perl 5.6
# spent 10µs making 1 call to XML::Twig::BEGIN@4636 # spent 2µs making 1 call to utf8::unimport
4637 $str =~ s{([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)}
4638 {_XmlUtf8Decode($1)}egs;
4639 }
4640 else
4641 { $str= encode( ascii => $str, $FB_HTMLCREF); }
4642 return $str;
4643 }
4644
4645sub safe_encode_hex
4646 { my $str= shift;
4647 if( $perl_version < 5.008)
4648 { # the no utf8 makes the regexp work in 5.6
464921.73ms27µs
# spent 6µs (5+1) within XML::Twig::BEGIN@4649 which was called: # once (5µs+1µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 4649
no utf8; # = perl 5.6
# spent 6µs making 1 call to XML::Twig::BEGIN@4649 # spent 1µs making 1 call to utf8::unimport
4650 $str =~ s{([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)}
4651 {_XmlUtf8Decode($1, 1)}egs;
4652 }
4653 else
4654 { $str= encode( ascii => $str, $FB_XMLCREF); }
4655 return $str;
4656 }
4657
4658# this one shamelessly lifted from XML::DOM
4659# does NOT work on 5.8.0
4660sub _XmlUtf8Decode
4661 { my ($str, $hex) = @_;
4662 my $len = length ($str);
4663 my $n;
4664
4665 if ($len == 2)
4666 { my @n = unpack "C2", $str;
4667 $n = (($n[0] & 0x3f) << 6) + ($n[1] & 0x3f);
4668 }
4669 elsif ($len == 3)
4670 { my @n = unpack "C3", $str;
4671 $n = (($n[0] & 0x1f) << 12) + (($n[1] & 0x3f) << 6) + ($n[2] & 0x3f);
4672 }
4673 elsif ($len == 4)
4674 { my @n = unpack "C4", $str;
4675 $n = (($n[0] & 0x0f) << 18) + (($n[1] & 0x3f) << 12)
4676 + (($n[2] & 0x3f) << 6) + ($n[3] & 0x3f);
4677 }
4678 elsif ($len == 1) # just to be complete...
4679 { $n = ord ($str); }
4680 else
4681 { croak "bad value [$str] for _XmlUtf8Decode"; }
4682
4683 my $char= $hex ? sprintf ("&#x%x;", $n) : "&#$n;";
4684 return $char;
4685 }
4686
4687
4688sub unicode_convert
4689 { my $enc= $_[1] ? $_[1] : $_[0]; # so the method can be called on the twig or directly
4690 _use( 'Unicode::Map8') or croak "Unicode::Map8 not available, needed for encoding filter: $!";
4691 _use( 'Unicode::String') or croak "Unicode::String not available, needed for encoding filter: $!";
4692 import Unicode::String qw(utf8);
4693 my $sub= eval qq{ { $NO_WARNINGS;
4694 my \$cnv;
4695 BEGIN { \$cnv= Unicode::Map8->new(\$enc)
4696 or croak "Can't create converter to \$enc";
4697 }
4698 sub { return \$cnv->to8 (utf8(\$_[0])->ucs2); }
4699 }
4700 };
4701 unless( $sub) { croak $@; }
4702 return $sub;
4703 }
4704
4705sub iconv_convert
4706 { my $enc= $_[1] ? $_[1] : $_[0]; # so the method can be called on the twig or directly
4707 _use( 'Text::Iconv') or croak "Text::Iconv not available, needed for encoding filter: $!";
4708 my $sub= eval qq{ { $NO_WARNINGS;
4709 my \$cnv;
4710 BEGIN { \$cnv = Text::Iconv->new( 'utf8', \$enc)
4711 or croak "Can't create iconv converter to \$enc";
4712 }
4713 sub { return \$cnv->convert( \$_[0]); }
4714 }
4715 };
4716 unless( $sub)
4717 { if( $@=~ m{^Unsupported conversion: Invalid argument})
4718 { croak "Unsupported encoding: $enc"; }
4719 else
4720 { croak $@; }
4721 }
4722
4723 return $sub;
4724 }
4725
4726sub encode_convert
4727 { my $enc= $_[1] ? $_[1] : $_[0]; # so the method can be called on the twig or directly
4728 my $sub= eval qq{sub { $NO_WARNINGS; return encode( "$enc", \$_[0]); } };
4729 croak "can't create Encode-based filter: $@" unless( $sub);
4730 return $sub;
4731 }
4732
4733
4734# XML::XPath compatibility
4735sub getRootNode { return $_[0]; }
4736sub getParentNode { return undef; }
4737sub getChildNodes { my @children= ($_[0]->root); return wantarray ? @children : \@children; }
4738
4739sub _weakrefs { return $weakrefs; }
4740sub _set_weakrefs { $weakrefs=shift() || 0; XML::Twig::Elt::set_destroy()if ! $weakrefs; } # for testing purposes
4741
4742sub _dump
4743 { my $t= shift;
4744 my $dump='';
4745
4746 $dump="document\n"; # should dump twig level data here
4747 if( $t->root) { $dump .= $t->root->_dump( @_); }
4748
4749 return $dump;
4750
4751 }
4752
4753
47541;
4755
4756######################################################################
4757package XML::Twig::Entity_list;
4758######################################################################
4759
47601800ns*isa= *UNIVERSAL::isa;
4761
4762sub new
476371µs
# spent 13µs within XML::Twig::Entity_list::new which was called 7 times, avg 2µs/call: # 7 times (13µs+0s) by XML::Twig::new at line 742, avg 2µs/call
{ my $class = shift;
476476µs my $self={ entities => {}, updated => 0};
4765
476672µs bless $self, $class;
476777µs return $self;
4768
4769 }
4770
4771sub add_new_ent
4772 { my $ent_list= shift;
4773 my $ent= XML::Twig::Entity->new( @_);
4774 $ent_list->add( $ent);
4775 return $ent_list;
4776 }
4777
4778sub _add_list
4779 { my( $ent_list, $to_add)= @_;
4780 my $ents_to_add= $to_add->{entities};
4781 return $ent_list unless( $ents_to_add && %$ents_to_add);
4782 @{$ent_list->{entities}}{keys %$ents_to_add}= values %$ents_to_add;
4783 $ent_list->{updated}=1;
4784 return $ent_list;
4785 }
4786
4787sub add
4788 { my( $ent_list, $ent)= @_;
4789 $ent_list->{entities}->{$ent->{name}}= $ent;
4790 $ent_list->{updated}=1;
4791 return $ent_list;
4792 }
4793
4794sub ent
4795 { my( $ent_list, $ent_name)= @_;
4796 return $ent_list->{entities}->{$ent_name};
4797 }
4798
4799# can be called with an entity or with an entity name
4800sub delete
4801 { my $ent_list= shift;
4802 if( isa( ref $_[0], 'XML::Twig::Entity'))
4803 { # the second arg is an entity
4804 my $ent= shift;
4805 delete $ent_list->{entities}->{$ent->{name}};
4806 }
4807 else
4808 { # the second arg was not entity, must be a string then
4809 my $name= shift;
4810 delete $ent_list->{entities}->{$name};
4811 }
4812 $ent_list->{updated}=1;
4813 return $ent_list;
4814 }
4815
4816sub print
4817 { my ($ent_list, $fh)= @_;
4818 my $old_select= defined $fh ? select $fh : undef;
4819
4820 foreach my $ent_name ( sort keys %{$ent_list->{entities}})
4821 { my $ent= $ent_list->{entities}->{$ent_name};
4822 # we have to test what the entity is or un-defined entities can creep in
4823 if( isa( $ent, 'XML::Twig::Entity')) { $ent->print(); }
4824 }
4825 select $old_select if( defined $old_select);
4826 return $ent_list;
4827 }
4828
4829sub text
4830 { my ($ent_list)= @_;
4831 return join "\n", map { $ent_list->{entities}->{$_}->text} sort keys %{$ent_list->{entities}};
4832 }
4833
4834# return the list of entity names
4835sub entity_names
4836 { my $ent_list= shift;
4837 return (sort keys %{$ent_list->{entities}}) ;
4838 }
4839
4840
4841sub list
4842 { my ($ent_list)= @_;
4843 return map { $ent_list->{entities}->{$_} } sort keys %{$ent_list->{entities}};
4844 }
4845
48461;
4847
4848######################################################################
4849package XML::Twig::Entity;
4850######################################################################
4851
4852#*isa= *UNIVERSAL::isa;
4853
4854sub new
4855 { my( $class, $name, $val, $sysid, $pubid, $ndata, $param)= @_;
4856 $class= ref( $class) || $class;
4857
4858 my $self={};
4859
4860 $self->{name} = $name;
4861 $self->{val} = $val if( defined $val );
4862 $self->{sysid} = $sysid if( defined $sysid);
4863 $self->{pubid} = $pubid if( defined $pubid);
4864 $self->{ndata} = $ndata if( defined $ndata);
4865 $self->{param} = $param if( defined $param);
4866
4867 bless $self, $class;
4868 return $self;
4869 }
4870
4871
4872sub name { return $_[0]->{name}; }
4873sub val { return $_[0]->{val}; }
4874sub sysid { return defined( $_[0]->{sysid}) ? $_[0]->{sysid} : ''; }
4875sub pubid { return defined( $_[0]->{pubid}) ? $_[0]->{pubid} : ''; }
4876sub ndata { return defined( $_[0]->{ndata}) ? $_[0]->{ndata} : ''; }
4877sub param { return defined( $_[0]->{param}) ? $_[0]->{param} : ''; }
4878
4879
4880sub print
4881 { my ($ent, $fh)= @_;
4882 my $text= $ent->text;
4883 if( $fh) { print $fh $text . "\n"; }
4884 else { print $text . "\n"; }
4885 }
4886
4887sub sprint
4888 { my ($ent)= @_;
4889 return $ent->text;
4890 }
4891
4892sub text
4893 { my ($ent)= @_;
4894 #warn "text called: '", $ent->_dump, "'\n";
4895 return '' if( !$ent->{name});
4896 my @tokens;
4897 push @tokens, '<!ENTITY';
4898
4899 push @tokens, '%' if( $ent->{param});
4900 push @tokens, $ent->{name};
4901
4902 if( defined $ent->{val} && !defined( $ent->{sysid}) && !defined($ent->{pubid}) )
4903 { push @tokens, _quoted_val( $ent->{val});
4904 }
4905 elsif( defined $ent->{sysid})
4906 { push @tokens, 'PUBLIC', _quoted_val( $ent->{pubid}) if( $ent->{pubid});
4907 push @tokens, 'SYSTEM' unless( $ent->{pubid});
4908 push @tokens, _quoted_val( $ent->{sysid});
4909 push @tokens, 'NDATA', $ent->{ndata} if( $ent->{ndata});
4910 }
4911 return join( ' ', @tokens) . '>';
4912 }
4913
4914sub _quoted_val
4915 { my $q= $_[0]=~ m{"} ? q{'} : q{"};
4916 return qq{$q$_[0]$q};
4917 }
4918
4919sub _dump
4920 { my( $ent)= @_; return join( " - ", map { "$_ => '$ent->{$_}'" } grep { defined $ent->{$_} } sort keys %$ent); }
4921
49221;
4923
4924######################################################################
4925package XML::Twig::Notation_list;
4926######################################################################
4927
49281200ns*isa= *UNIVERSAL::isa;
4929
4930sub new
493171µs
# spent 10µs within XML::Twig::Notation_list::new which was called 7 times, avg 1µs/call: # 7 times (10µs+0s) by XML::Twig::new at line 743, avg 1µs/call
{ my $class = shift;
493274µs my $self={ notations => {}, updated => 0};
4933
493471µs bless $self, $class;
493576µs return $self;
4936
4937 }
4938
4939sub add_new_notation
4940 { my $notation_list= shift;
4941 my $notation= XML::Twig::Notation->new( @_);
4942 $notation_list->add( $notation);
4943 return $notation_list;
4944 }
4945
4946sub _add_list
4947 { my( $notation_list, $to_add)= @_;
4948 my $notations_to_add= $to_add->{notations};
4949 return $notation_list unless( $notations_to_add && %$notations_to_add);
4950 @{$notation_list->{notations}}{keys %$notations_to_add}= values %$notations_to_add;
4951 $notation_list->{updated}=1;
4952 return $notation_list;
4953 }
4954
4955sub add
4956 { my( $notation_list, $notation)= @_;
4957 $notation_list->{notations}->{$notation->{name}}= $notation;
4958 $notation_list->{updated}=1;
4959 return $notation_list;
4960 }
4961
4962sub notation
4963 { my( $notation_list, $notation_name)= @_;
4964 return $notation_list->{notations}->{$notation_name};
4965 }
4966
4967# can be called with an notation or with an notation name
4968sub delete
4969 { my $notation_list= shift;
4970 if( isa( ref $_[0], 'XML::Twig::Notation'))
4971 { # the second arg is an notation
4972 my $notation= shift;
4973 delete $notation_list->{notations}->{$notation->{name}};
4974 }
4975 else
4976 { # the second arg was not notation, must be a string then
4977 my $name= shift;
4978 delete $notation_list->{notations}->{$name};
4979 }
4980 $notation_list->{updated}=1;
4981 return $notation_list;
4982 }
4983
4984sub print
4985 { my ($notation_list, $fh)= @_;
4986 my $old_select= defined $fh ? select $fh : undef;
4987
4988 foreach my $notation_name ( sort keys %{$notation_list->{notations}})
4989 { my $notation= $notation_list->{notations}->{$notation_name};
4990 # we have to test what the notation is or un-defined notations can creep in
4991 if( isa( $notation, 'XML::Twig::Notation')) { $notation->print(); }
4992 }
4993 select $old_select if( defined $old_select);
4994 return $notation_list;
4995 }
4996
4997sub text
4998 { my ($notation_list)= @_;
4999 return join "\n", map { $notation_list->{notations}->{$_}->text} sort keys %{$notation_list->{notations}};
5000 }
5001
5002# return the list of notation names
5003sub notation_names
5004 { my $notation_list= shift;
5005 return (sort keys %{$notation_list->{notations}}) ;
5006 }
5007
5008
5009sub list
5010 { my ($notation_list)= @_;
5011 return map { $notation_list->{notations}->{$_} } sort keys %{$notation_list->{notations}};
5012 }
5013
50141;
5015
5016######################################################################
5017package XML::Twig::Notation;
5018######################################################################
5019
5020#*isa= *UNIVERSAL::isa;
5021
5022BEGIN
502314µs
# spent 3µs within XML::Twig::Notation::BEGIN@5023 which was called: # once (3µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 5024
{ *sprint= *text;
50241313µs13µs }
# spent 3µs making 1 call to XML::Twig::Notation::BEGIN@5023
5025
5026sub new
5027 { my( $class, $name, $base, $sysid, $pubid)= @_;
5028 $class= ref( $class) || $class;
5029
5030 my $self={};
5031
5032 $self->{name} = $name;
5033 $self->{base} = $base if( defined $base );
5034 $self->{sysid} = $sysid if( defined $sysid);
5035 $self->{pubid} = $pubid if( defined $pubid);
5036
5037 bless $self, $class;
5038 return $self;
5039 }
5040
5041
5042sub name { return $_[0]->{name}; }
5043sub base { return $_[0]->{base}; }
5044sub sysid { return $_[0]->{sysid}; }
5045sub pubid { return $_[0]->{pubid}; }
5046
5047
5048sub print
5049 { my ($notation, $fh)= @_;
5050 my $text= $notation->text;
5051 if( $fh) { print $fh $text . "\n"; }
5052 else { print $text . "\n"; }
5053 }
5054
5055sub text
5056 { my ($notation)= @_;
5057 return '' if( !$notation->{name});
5058 my @tokens;
5059 push @tokens, '<!NOTATION';
5060 push @tokens, $notation->{name};
5061 push @tokens, ( 'PUBLIC', _quoted_val( $notation->{pubid} ) ) if $notation->{pubid};
5062 push @tokens, ( 'SYSTEM') if ! $notation->{pubid} && $notation->{sysid};
5063 push @tokens, (_quoted_val( $notation->{sysid}) ) if $notation->{sysid};
5064
5065 return join( ' ', @tokens) . '>';
5066 }
5067
5068sub _quoted_val
5069 { my $q= $_[0]=~ m{"} ? q{'} : q{"};
5070 return qq{$q$_[0]$q};
5071 }
5072
5073sub _dump
5074 { my( $notation)= @_; return join( " - ", map { "$_ => '$notation->{$_}'" } grep { defined $notation->{$_} } sort keys %$notation); }
5075
50761;
5077
5078######################################################################
5079package XML::Twig::Elt;
5080######################################################################
5081
50822253µs254µs
# spent 31µs (7+24) within XML::Twig::Elt::BEGIN@5082 which was called: # once (7µs+24µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 5082
use Carp;
# spent 31µs making 1 call to XML::Twig::Elt::BEGIN@5082 # spent 24µs making 1 call to Exporter::import
50831200ns*isa= *UNIVERSAL::isa;
5084
50851200nsmy $CDATA_START = "<![CDATA[";
50861100nsmy $CDATA_END = "]]>";
50871100nsmy $PI_START = "<?";
50881100nsmy $PI_END = "?>";
50891100nsmy $COMMENT_START = "<!--";
50901100nsmy $COMMENT_END = "-->";
5091
50921100nsmy $XMLNS_URI = 'http://www.w3.org/2000/xmlns/';
5093
5094
5095BEGIN
5096
# spent 49µs (33+16) within XML::Twig::Elt::BEGIN@5096 which was called: # once (33µs+16µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 5162
{ # set some aliases for methods
50971700ns *tag = *gi;
50981200ns *name = *gi;
50991100ns *set_tag = *set_gi;
51001100ns *set_name = *set_gi;
51011100ns *find_nodes = *get_xpath; # as in XML::DOM
51021100ns *findnodes = *get_xpath; # as in XML::LibXML
51031100ns *field = *first_child_text;
51041200ns *trimmed_field = *first_child_trimmed_text;
51051100ns *is_field = *contains_only_text;
51061100ns *is = *passes;
51071100ns *matches = *passes;
51081100ns *has_child = *first_child;
51091100ns *has_children = *first_child;
51101100ns *all_children_pass = *all_children_are;
51111100ns *all_children_match= *all_children_are;
51121200ns *getElementsByTagName= *descendants;
51131100ns *find_by_tag_name= *descendants_or_self;
51141100ns *unwrap = *erase;
51151200ns *inner_xml = *xml_string;
51161100ns *outer_xml = *sprint;
51171100ns *add_class = *add_to_class;
5118
51191200ns *first_child_is = *first_child_matches;
51201100ns *last_child_is = *last_child_matches;
51211100ns *next_sibling_is = *next_sibling_matches;
51221200ns *prev_sibling_is = *prev_sibling_matches;
51231100ns *next_elt_is = *next_elt_matches;
51241100ns *prev_elt_is = *prev_elt_matches;
51251100ns *parent_is = *parent_matches;
51261100ns *child_is = *child_matches;
51271100ns *inherited_att = *inherit_att;
5128
51291100ns *sort_children_by_value= *sort_children_on_value;
5130
51311200ns *has_atts= *att_nb;
5132
5133 # imports from XML::Twig
51341400ns *_is_fh= *XML::Twig::_is_fh;
5135
5136 # XML::XPath compatibility
51371100ns *string_value = *text;
51381100ns *toString = *sprint;
51391100ns *getName = *gi;
51401100ns *getRootNode = *twig;
51411200ns *getNextSibling = *_next_sibling;
51421100ns *getPreviousSibling = *_prev_sibling;
51431100ns *isElementNode = *is_elt;
51441100ns *isTextNode = *is_text;
51451100ns *isPI = *is_pi;
51461100ns *isPINode = *is_pi;
51471100ns *isProcessingInstructionNode= *is_pi;
51481100ns *isComment = *is_comment;
51491100ns *isCommentNode = *is_comment;
51501100ns *getTarget = *target;
51511200ns *getFirstChild = *_first_child;
51521100ns *getLastChild = *_last_child;
5153
5154 # try using weak references
5155 # test whether we can use weak references
515623µs { local $SIG{__DIE__};
5157119µs116µs if( eval 'require Scalar::Util' && defined( &Scalar::Util::weaken) )
# spent 16µs making 1 call to Exporter::import
# spent 2µs executing statements in string eval
5158 { import Scalar::Util qw(weaken); }
5159 elsif( eval 'require WeakRef')
5160 { import WeakRef; }
5161 }
516215.55ms149µs}
# spent 49µs making 1 call to XML::Twig::Elt::BEGIN@5096
5163
5164
5165# can be called as XML::Twig::Elt->new( [[$gi, $atts, [@content]])
5166# - gi is an optional gi given to the element
5167# - $atts is a hashref to attributes for the element
5168# - @content is an optional list of text and elements that will
5169# be inserted under the element
5170sub new
517136436955.7ms
# spent 1.82s (1.71+110ms) within XML::Twig::Elt::new which was called 364369 times, avg 5µs/call: # 364369 times (1.71s+110ms) by XML::Twig::_twig_start at line 2079, avg 5µs/call
{ my $class= shift;
517236436970.5ms $class= ref $class || $class;
517336436928.0ms my $elt = {};
517436436969.0ms bless ($elt, $class);
5175
517636436945.0ms return $elt unless @_;
5177
5178364369657ms364369110ms if( @_ == 1 && $_[0]=~ m{^\s*<}) { return $class->parse( @_); }
# spent 110ms making 364369 calls to CORE::match, avg 301ns/call
5179
5180 # if a gi is passed then use it
518136436957.1ms my $gi= shift;
5182364369170ms117242µs $elt->{gi}=$XML::Twig::gi2index{$gi} or $elt->set_gi( $gi);
# spent 242µs making 117 calls to XML::Twig::Elt::set_gi, avg 2µs/call
5183
5184
518536436992.5ms my $atts= ref $_[0] eq 'HASH' ? shift : undef;
5186
518736436942.6ms if( $atts && defined $atts->{$CDATA})
5188 { delete $atts->{$CDATA};
5189
5190 my $cdata= $class->new( $CDATA => @_);
5191 return $class->new( $gi, $atts, $cdata);
5192 }
5193
5194364369183ms if( $gi eq $PCDATA)
5195 { if( grep { ref $_ } @_) { croak "element $PCDATA can only be created from text"; }
5196 $elt->{pcdata}= join '', @_;
5197 }
5198 elsif( $gi eq $ENT)
5199 { $elt->{ent}= shift; }
5200 elsif( $gi eq $CDATA)
5201 { if( grep { ref $_ } @_) { croak "element $CDATA can only be created from text"; }
5202 $elt->{cdata}= join '', @_;
5203 }
5204 elsif( $gi eq $COMMENT)
5205 { if( grep { ref $_ } @_) { croak "element $COMMENT can only be created from text"; }
5206 $elt->{comment}= join '', @_;
5207 }
5208 elsif( $gi eq $PI)
5209 { if( grep { ref $_ } @_) { croak "element $PI can only be created from text"; }
5210 $elt->_set_pi( shift, join '', @_);
5211 }
5212 else
5213 { # the rest of the arguments are the content of the element
521436436973.9ms if( @_)
5215 { $elt->set_content( @_); }
5216 else
521736436979.0ms { $elt->{empty}= 1; }
5218 }
5219
522036436931.5ms if( $atts)
5221 { # the attribute hash can be used to pass the asis status
5222 if( defined $atts->{$ASIS}) { $elt->set_asis( $atts->{$ASIS} ); delete $atts->{$ASIS}; }
5223 if( defined $atts->{$EMPTY}) { $elt->{empty}= $atts->{$EMPTY}; delete $atts->{$EMPTY}; }
5224 if( keys %$atts) { $elt->set_atts( $atts); }
5225 $elt->_set_id( $atts->{$ID}) if( $atts->{$ID});
5226 }
5227
5228364369679ms return $elt;
5229 }
5230
5231# optimized version of $elt->new( PCDATA, $text);
5232sub _new_pcdata
5233 { my $class= $_[0];
5234 $class= ref $class || $class;
5235 my $elt = {};
5236 bless $elt, $class;
5237 $elt->{gi}=$XML::Twig::gi2index{$PCDATA} or $elt->set_gi( $PCDATA);
5238 $elt->{pcdata}= $_[1];
5239 return $elt;
5240 }
5241
5242# this function creates an XM:::Twig::Elt from a string
5243# it is quite clumsy at the moment, as it just creates a
5244# new twig then returns its root
5245# there might also be memory leaks there
5246# additional arguments are passed to new XML::Twig
5247sub parse
5248 { my $class= shift;
5249 if( ref( $class)) { $class= ref( $class); }
5250 my $string= shift;
5251 my %args= @_;
5252 my $t= XML::Twig->new(%args);
5253 $t->parse( $string);
5254 my $elt= $t->root;
5255 # clean-up the node
5256 delete $elt->{twig}; # get rid of the twig data
5257 delete $elt->{twig_current}; # better get rid of this too
5258 if( $t->{twig_id_list}) { $elt->{twig_id_list}= $t->{twig_id_list}; }
5259 $elt->cut;
5260 undef $t->{twig_root};
5261 return $elt;
5262 }
5263
5264sub set_inner_xml
5265 { my( $elt, $xml, @args)= @_;
5266 my $new_elt= $elt->parse( "<dummy>$xml</dummy>", @args);
5267 $elt->cut_children;
5268 $new_elt->paste_first_child( $elt);
5269 $new_elt->erase;
5270 return $elt;
5271 }
5272
5273sub set_outer_xml
5274 { my( $elt, $xml, @args)= @_;
5275 my $new_elt= $elt->parse( "<dummy>$xml</dummy>", @args);
5276 $elt->cut_children;
5277 $new_elt->replace( $elt);
5278 $new_elt->erase;
5279 return $new_elt;
5280 }
5281
5282
5283sub set_inner_html
5284 { my( $elt, $html)= @_;
5285 my $t= XML::Twig->new->parse_html( "<html>$html</html>");
5286 my $new_elt= $t->root;
5287 if( $elt->tag eq 'head')
5288 { $new_elt->first_child( 'head')->unwrap;
5289 $new_elt->first_child( 'body')->cut;
5290 }
5291 elsif( $elt->tag ne 'html')
5292 { $new_elt->first_child( 'head')->cut;
5293 $new_elt->first_child( 'body')->unwrap;
5294 }
5295 $new_elt->cut;
5296 $elt->cut_children;
5297 $new_elt->paste_first_child( $elt);
5298 $new_elt->erase;
5299 return $elt;
5300 }
5301
5302sub set_gi
530311722µs
# spent 242µs within XML::Twig::Elt::set_gi which was called 117 times, avg 2µs/call: # 117 times (242µs+0s) by XML::Twig::Elt::new at line 5182, avg 2µs/call
{ my ($elt, $gi)= @_;
530411738µs unless( defined $XML::Twig::gi2index{$gi})
5305 { # new gi, create entries in %gi2index and @index2gi
530611739µs push @XML::Twig::index2gi, $gi;
530711772µs $XML::Twig::gi2index{$gi}= $#XML::Twig::index2gi;
5308 }
530911729µs $elt->{gi}= $XML::Twig::gi2index{$gi};
531011791µs return $elt;
5311 }
5312
5313127487249ms
# spent 64.6ms within XML::Twig::Elt::gi which was called 127487 times, avg 507ns/call: # 127276 times (64.5ms+0s) by XML::Twig::Elt::__ANON__[(eval 128)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:5871]:1] at line 1 of (eval 128)[XML/Twig.pm:5871], avg 507ns/call # 103 times (30µs+0s) by XML::Twig::Elt::__ANON__[(eval 86)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:5871]:1] at line 1 of (eval 86)[XML/Twig.pm:5871], avg 286ns/call # 28 times (8µs+0s) by XML::Twig::Elt::__ANON__[(eval 91)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:5871]:1] at line 1 of (eval 91)[XML/Twig.pm:5871], avg 268ns/call # 15 times (10µs+0s) by Spreadsheet::ParseXLSX::_get_text_and_rich_font_by_cell at line 583 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 660ns/call # 14 times (5µs+0s) by XML::Twig::Elt::__ANON__[(eval 90)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:5871]:1] at line 1 of (eval 90)[XML/Twig.pm:5871], avg 336ns/call # 14 times (5µs+0s) by XML::Twig::Elt::__ANON__[(eval 95)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:5871]:1] at line 1 of (eval 95)[XML/Twig.pm:5871], avg 336ns/call # 14 times (4µs+0s) by XML::Twig::Elt::__ANON__[(eval 96)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:5871]:1] at line 1 of (eval 96)[XML/Twig.pm:5871], avg 271ns/call # 12 times (4µs+0s) by Spreadsheet::ParseXLSX::_parse_themes at line 672 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 292ns/call # 6 times (8µs+0s) by XML::Twig::Elt::is_elt at line 5418, avg 1µs/call # 5 times (2µs+0s) by XML::Twig::Elt::__ANON__[(eval 101)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:5871]:1] at line 1 of (eval 101)[XML/Twig.pm:5871], avg 440ns/call
sub gi { return $XML::Twig::index2gi[$_[0]->{gi}]; }
5314
5315sub local_name
5316 { my $elt= shift;
5317 return _local_name( $XML::Twig::index2gi[$elt->{'gi'}]);
5318 }
5319
5320sub ns_prefix
5321 { my $elt= shift;
5322 return _ns_prefix( $XML::Twig::index2gi[$elt->{'gi'}]);
5323 }
5324
5325# namespace prefix for any qname (can be used for elements or attributes)
5326sub _ns_prefix
5327 { my $qname= shift;
5328 if( $qname=~ m{^([^:]*):})
5329 { return $1; }
5330 else
5331 { return( ''); } # should it be '' ?
5332 }
5333
5334# local name for any qname (can be used for elements or attributes)
5335sub _local_name
5336 { my $qname= shift;
5337 (my $local= $qname)=~ s{^[^:]*:}{};
5338 return $local;
5339 }
5340
5341#sub get_namespace
5342sub namespace ## no critic (Subroutines::ProhibitNestedSubs);
5343 { my $elt= shift;
5344 my $prefix= defined $_[0] ? shift() : $elt->ns_prefix;
5345 my $ns_att= $prefix ? "xmlns:$prefix" : "xmlns";
5346 my $expanded= $DEFAULT_NS{$prefix} || $elt->_inherit_att_through_cut( $ns_att) || '';
5347 return $expanded;
5348 }
5349
5350sub declare_missing_ns ## no critic (Subroutines::ProhibitNestedSubs);
5351 { my $root= shift;
5352 my %missing_prefix;
5353 my $map= $root->_current_ns_prefix_map;
5354
5355 foreach my $prefix (keys %$map)
5356 { my $prefix_att= $prefix eq '#default' ? 'xmlns' : "xmlns:$prefix";
5357 if( ! $root->{'att'}->{$prefix_att})
5358 { $root->set_att( $prefix_att => $map->{$prefix}); }
5359 }
5360 return $root;
5361 }
5362
5363sub _current_ns_prefix_map
5364 { my( $elt)= shift;
5365 my $map;
5366 while( $elt)
5367 { foreach my $att ($elt->att_names)
5368 { my $prefix= $att eq 'xmlns' ? '#default'
5369 : $att=~ m{^xmlns:(.*)$} ? $1
5370 : next
5371 ;
5372 if( ! exists $map->{$prefix}) { $map->{$prefix}= $elt->{'att'}->{$att}; }
5373 }
5374 $elt= $elt->{parent} || ($elt->{former} && $elt->{former}->{parent});
5375 }
5376 return $map;
5377 }
5378
5379sub set_ns_decl
5380 { my( $elt, $uri, $prefix)= @_;
5381 my $ns_att= $prefix ? "xmlns:$prefix" : 'xmlns';
5382 $elt->set_att( $ns_att => $uri);
5383 return $elt;
5384 }
5385
5386sub set_ns_as_default
5387 { my( $root, $uri)= @_;
5388 my @ns_decl_to_remove;
5389 foreach my $elt ($root->descendants_or_self)
5390 { if( $elt->_ns_prefix && $elt->namespace eq $uri)
5391 { $elt->set_tag( $elt->local_name); }
5392 # store any namespace declaration for that uri
5393 foreach my $ns_decl (grep { $_=~ m{xmlns(:|$)} && $elt->{'att'}->{$_} eq $uri } $elt->att_names)
5394 { push @ns_decl_to_remove, [$elt, $ns_decl]; }
5395 }
5396 $root->set_ns_decl( $uri);
5397 # now remove the ns declarations (if done earlier then descendants of an element with the ns declaration
5398 # are not considered being in the namespace
5399 foreach my $ns_decl_to_remove ( @ns_decl_to_remove)
5400 { my( $elt, $ns_decl)= @$ns_decl_to_remove;
5401 $elt->del_att( $ns_decl);
5402 }
5403
5404 return $root;
5405 }
5406
5407
5408
5409# return #ELT for an element and #PCDATA... for others
5410sub get_type
5411 { my $gi_nb= $_[0]->{gi}; # the number, not the string
5412 return $ELT if( $gi_nb >= $XML::Twig::SPECIAL_GI);
5413 return $_[0]->gi;
5414 }
5415
5416# return the gi if it's a "real" element, 0 otherwise
5417sub is_elt
5418616µs68µs
# spent 26µs (18+8) within XML::Twig::Elt::is_elt which was called 6 times, avg 4µs/call: # 6 times (18µs+8µs) by XML::Twig::Elt::cut at line 7171, avg 4µs/call
{ if( $_[0]->{gi} >= $XML::Twig::SPECIAL_GI)
# spent 8µs making 6 calls to XML::Twig::Elt::gi, avg 1µs/call
5419 { return $_[0]->gi; }
5420 else
5421 { return 0; }
5422 }
5423
5424
5425sub is_pcdata
5426 { my $elt= shift;
5427 return (exists $elt->{'pcdata'});
5428 }
5429
5430sub is_cdata
5431 { my $elt= shift;
5432 return (exists $elt->{'cdata'});
5433 }
5434
5435sub is_pi
5436 { my $elt= shift;
5437 return (exists $elt->{'target'});
5438 }
5439
5440sub is_comment
5441 { my $elt= shift;
5442 return (exists $elt->{'comment'});
5443 }
5444
5445sub is_ent
5446 { my $elt= shift;
5447 return (exists $elt->{ent} || $elt->{ent_name});
5448 }
5449
5450
5451sub is_text
5452 { my $elt= shift;
5453 return (exists( $elt->{'pcdata'}) || (exists $elt->{'cdata'}));
5454 }
5455
5456sub is_empty
5457 { return $_[0]->{empty} || 0; }
5458
5459sub set_empty
5460 { $_[0]->{empty}= defined( $_[1]) ? $_[1] : 1; return $_[0]; }
5461
5462sub set_not_empty
5463 { delete $_[0]->{empty} if( $_[0]->{'empty'}); return $_[0]; }
5464
5465
5466sub set_asis
5467 { my $elt=shift;
5468
5469 foreach my $descendant ($elt, $elt->_descendants )
5470 { $descendant->{asis}= 1;
5471 if( (exists $descendant->{'cdata'}))
5472 { $descendant->{gi}=$XML::Twig::gi2index{$PCDATA} or $descendant->set_gi( $PCDATA);
5473 $descendant->{pcdata}= $descendant->{cdata};
5474 }
5475
5476 }
5477 return $elt;
5478 }
5479
5480sub set_not_asis
5481 { my $elt=shift;
5482 foreach my $descendant ($elt, $elt->descendants)
5483 { delete $descendant->{asis} if $descendant->{asis};}
5484 return $elt;
5485 }
5486
5487sub is_asis
5488 { return $_[0]->{asis}; }
5489
5490sub closed
5491 { my $elt= shift;
5492 my $t= $elt->twig || return;
5493 my $curr_elt= $t->{twig_current};
5494 return 1 unless( $curr_elt);
5495 return $curr_elt->in( $elt);
5496 }
5497
5498sub set_pcdata
5499 { my( $elt, $pcdata)= @_;
5500
5501 if( $elt->{extra_data_in_pcdata})
5502 { _try_moving_extra_data( $elt, $pcdata);
5503 }
5504 $elt->{pcdata}= $pcdata;
5505 return $elt;
5506 }
5507
5508sub _extra_data_in_pcdata { return $_[0]->{extra_data_in_pcdata}; }
5509sub _set_extra_data_in_pcdata { $_[0]->{extra_data_in_pcdata}= $_[1]; return $_[0]; }
5510sub _del_extra_data_in_pcdata { delete $_[0]->{extra_data_in_pcdata}; return $_[0]; }
5511sub _unshift_extra_data_in_pcdata
5512 { my $e= shift;
5513 $e->{extra_data_in_pcdata}||=[];
5514 unshift @{$e->{extra_data_in_pcdata}}, { text => shift(), offset => shift() };
5515 }
5516sub _push_extra_data_in_pcdata
5517 { my $e= shift;
5518 $e->{extra_data_in_pcdata}||=[];
5519 push @{$e->{extra_data_in_pcdata}}, { text => shift(), offset => shift() };
5520 }
5521
5522sub _extra_data_before_end_tag { return $_[0]->{extra_data_before_end_tag} || ''; }
5523sub _set_extra_data_before_end_tag { $_[0]->{extra_data_before_end_tag}= $_[1]; return $_[0]}
5524sub _del_extra_data_before_end_tag { delete $_[0]->{extra_data_before_end_tag}; return $_[0]}
5525sub _prefix_extra_data_before_end_tag
5526 { my( $elt, $data)= @_;
5527 if($elt->{extra_data_before_end_tag})
5528 { $elt->{extra_data_before_end_tag}= $data . $elt->{extra_data_before_end_tag}; }
5529 else
5530 { $elt->{extra_data_before_end_tag}= $data; }
5531 return $elt;
5532 }
5533
5534# internal, in cases where we know there is no extra_data (inlined anyway!)
5535sub _set_pcdata { $_[0]->{pcdata}= $_[1]; }
5536
5537# try to figure out if we can keep the extra_data around
5538sub _try_moving_extra_data
5539 { my( $elt, $modified)=@_;
5540 my $initial= $elt->{pcdata};
5541 my $cpis= $elt->{extra_data_in_pcdata};
5542
5543 if( (my $offset= index( $modified, $initial)) != -1)
5544 { # text has been added
5545 foreach (@$cpis) { $_->{offset}+= $offset; }
5546 }
5547 elsif( ($offset= index( $initial, $modified)) != -1)
5548 { # text has been cut
5549 my $len= length( $modified);
5550 foreach my $cpi (@$cpis) { $cpi->{offset} -= $offset; }
5551 $elt->_set_extra_data_in_pcdata( [ grep { $_->{offset} >= 0 && $_->{offset} < $len } @$cpis ]);
5552 }
5553 else
5554 { _match_extra_data_words( $elt, $initial, $modified)
5555 || _match_extra_data_chars( $elt, $initial, $modified)
5556 || $elt->_del_extra_data_in_pcdata;
5557 }
5558 }
5559
5560sub _match_extra_data_words
5561 { my( $elt, $initial, $modified)= @_;
5562 my @initial= split /\b/, $initial;
5563 my @modified= split /\b/, $modified;
5564
5565 return _match_extra_data( $elt, length( $initial), \@initial, \@modified);
5566 }
5567
5568sub _match_extra_data_chars
5569 { my( $elt, $initial, $modified)= @_;
5570 my @initial= split //, $initial;
5571 my @modified= split //, $modified;
5572
5573 return _match_extra_data( $elt, length( $initial), \@initial, \@modified);
5574 }
5575
5576sub _match_extra_data
5577 { my( $elt, $length, $initial, $modified)= @_;
5578
5579 my $cpis= $elt->{extra_data_in_pcdata};
5580
5581 if( @$initial <= @$modified)
5582 {
5583 my( $ok, $positions, $offsets)= _pos_offset( $initial, $modified);
5584 if( $ok)
5585 { my $offset=0;
5586 my $pos= shift @$positions;
5587 foreach my $cpi (@$cpis)
5588 { while( $cpi->{offset} >= $pos)
5589 { $offset= shift @$offsets;
5590 $pos= shift @$positions || $length +1;
5591 }
5592 $cpi->{offset} += $offset;
5593 }
5594 return 1;
5595 }
5596 }
5597 else
5598 { my( $ok, $positions, $offsets)= _pos_offset( $modified, $initial);
5599 if( $ok)
5600 { #print STDERR "pos: ", join( ':', @$positions), "\n",
5601 # "offset: ", join( ':', @$offsets), "\n";
5602 my $offset=0;
5603 my $pos= shift @$positions;
5604 my $prev_pos= 0;
5605
5606 foreach my $cpi (@$cpis)
5607 { while( $cpi->{offset} >= $pos)
5608 { $offset= shift @$offsets;
5609 $prev_pos= $pos;
5610 $pos= shift @$positions || $length +1;
5611 }
5612 $cpi->{offset} -= $offset;
5613 if( $cpi->{offset} < $prev_pos) { delete $cpi->{text}; }
5614 }
5615 $elt->_set_extra_data_in_pcdata( [ grep { exists $_->{text} } @$cpis ]);
5616 return 1;
5617 }
5618 }
5619 return 0;
5620 }
5621
5622
5623sub _pos_offset
5624 { my( $short, $long)= @_;
5625 my( @pos, @offset);
5626 my( $s_length, $l_length)=(0,0);
5627 while (@$short)
5628 { my $s_word= shift @$short;
5629 my $l_word= shift @$long;
5630 if( $s_word ne $l_word)
5631 { while( @$long && $s_word ne $l_word)
5632 { $l_length += length( $l_word);
5633 $l_word= shift @$long;
5634 }
5635 if( !@$long && $s_word ne $l_word) { return 0; }
5636 push @pos, $s_length;
5637 push @offset, $l_length - $s_length;
5638 }
5639 my $length= length( $s_word);
5640 $s_length += $length;
5641 $l_length += $length;
5642 }
5643 return( 1, \@pos, \@offset);
5644 }
5645
5646sub append_pcdata
5647 { $_[0]->{'pcdata'}.= $_[1];
5648 return $_[0];
5649 }
5650
5651sub pcdata { return $_[0]->{pcdata}; }
5652
5653
5654sub append_extra_data
5655 { $_[0]->{extra_data}.= $_[1];
5656 return $_[0];
5657 }
5658
5659sub set_extra_data
5660 { $_[0]->{extra_data}= $_[1];
5661 return $_[0];
5662 }
5663sub extra_data { return $_[0]->{extra_data} || ''; }
5664
5665sub set_target
5666 { my( $elt, $target)= @_;
5667 $elt->{target}= $target;
5668 return $elt;
5669 }
5670sub target { return $_[0]->{target}; }
5671
5672sub set_data
5673 { $_[0]->{'data'}= $_[1];
5674 return $_[0];
5675 }
5676sub data { return $_[0]->{data}; }
5677
5678sub set_pi
5679 { my $elt= shift;
5680 unless( $elt->{gi} == $XML::Twig::gi2index{$PI})
5681 { $elt->cut_children;
5682 $elt->{gi}=$XML::Twig::gi2index{$PI} or $elt->set_gi( $PI);
5683 }
5684 return $elt->_set_pi( @_);
5685 }
5686
5687sub _set_pi
5688 { $_[0]->set_target( $_[1]);
5689 $_[0]->{data}= $_[2];
5690 return $_[0];
5691 }
5692
5693sub pi_string { my $string= $PI_START . $_[0]->{target};
5694 my $data= $_[0]->{data};
5695 if( defined( $data) && $data ne '') { $string .= " $data"; }
5696 $string .= $PI_END ;
5697 return $string;
5698 }
5699
5700sub set_comment
5701 { my $elt= shift;
5702 unless( $elt->{gi} == $XML::Twig::gi2index{$COMMENT})
5703 { $elt->cut_children;
5704 $elt->{gi}=$XML::Twig::gi2index{$COMMENT} or $elt->set_gi( $COMMENT);
5705 }
5706 $elt->{comment}= $_[0];
5707 return $elt;
5708 }
5709
5710sub _set_comment { $_[0]->{comment}= $_[1]; return $_[0]; }
5711sub comment { return $_[0]->{comment}; }
5712sub comment_string { return $COMMENT_START . _comment_escaped_string( $_[0]->{comment}) . $COMMENT_END; }
5713# comments cannot start or end with
5714sub _comment_escaped_string
5715 { my( $c)= @_;
5716 $c=~ s{^-}{ -};
5717 $c=~ s{-$}{- };
5718 $c=~ s{--}{- -}g;
5719 return $c;
5720 }
5721
5722sub set_ent { $_[0]->{ent}= $_[1]; return $_[0]; }
5723sub ent { return $_[0]->{ent}; }
5724sub ent_name { return substr( $_[0]->{ent}, 1, -1);}
5725
5726sub set_cdata
5727 { my $elt= shift;
5728 unless( $elt->{gi} == $XML::Twig::gi2index{$CDATA})
5729 { $elt->cut_children;
5730 $elt->insert_new_elt( first_child => $CDATA, @_);
5731 return $elt;
5732 }
5733 $elt->{cdata}= $_[0];
5734 return $_[0];
5735 }
5736
5737sub _set_cdata
5738 { $_[0]->{cdata}= $_[1];
5739 return $_[0];
5740 }
5741
5742sub append_cdata
5743 { $_[0]->{cdata}.= $_[1];
5744 return $_[0];
5745 }
5746sub cdata { return $_[0]->{cdata}; }
5747
5748
5749sub contains_only_text
5750 { my $elt= shift;
5751 return 0 unless $elt->is_elt;
5752 foreach my $child ($elt->_children)
5753 { return 0 if $child->is_elt; }
5754 return $elt;
5755 }
5756
5757sub contains_only
5758 { my( $elt, $exp)= @_;
5759 my @children= do { my $elt= $elt; my @children=(); my $child= $elt->{first_child}; while( $child) { push @children, $child; $child= $child->{next_sibling}; } @children; };
5760 foreach my $child (@children)
5761 { return 0 unless $child->is( $exp); }
5762 return @children || 1;
5763 }
5764
5765sub contains_a_single
5766 { my( $elt, $exp)= @_;
5767 my $child= $elt->{first_child} or return 0;
5768 return 0 unless $child->passes( $exp);
5769 return 0 if( $child->{next_sibling});
5770 return $child;
5771 }
5772
5773
5774sub root
5775162µs
# spent 40µs within XML::Twig::Elt::root which was called 16 times, avg 3µs/call: # 16 times (40µs+0s) by XML::Twig::Elt::twig at line 5788, avg 3µs/call
{ my $elt= shift;
57761631µs while( $elt->{parent}) { $elt= $elt->{parent}; }
57771616µs return $elt;
5778 }
5779
5780sub _root_through_cut
5781 { my $elt= shift;
5782 while( $elt->{parent} || ($elt->{former} && $elt->{former}->{parent})) { $elt= $elt->{parent} || ($elt->{former} && $elt->{former}->{parent}); }
5783 return $elt;
5784 }
5785
5786sub twig
5787162µs
# spent 78µs (38+40) within XML::Twig::Elt::twig which was called 16 times, avg 5µs/call: # 2 times (5µs+4µs) by XML::Twig::Elt::__ANON__[(eval 62)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 62)[XML/Twig.pm:7113], avg 4µs/call # once (4µs+5µs) by XML::Twig::Elt::__ANON__[(eval 129)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 129)[XML/Twig.pm:7113] # once (4µs+3µs) by XML::Twig::Elt::__ANON__[(eval 58)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 58)[XML/Twig.pm:7113] # once (3µs+3µs) by XML::Twig::Elt::__ANON__[(eval 60)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 60)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 64)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 64)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 103)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 103)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 61)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 61)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 97)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 97)[XML/Twig.pm:7113] # once (2µs+3µs) by XML::Twig::Elt::__ANON__[(eval 63)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 63)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 70)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 70)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 76)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 76)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 85)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 85)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 68)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 68)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 87)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 87)[XML/Twig.pm:7113] # once (2µs+2µs) by XML::Twig::Elt::__ANON__[(eval 66)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 66)[XML/Twig.pm:7113]
{ my $elt= shift;
57881613µs1640µs my $root= $elt->root;
# spent 40µs making 16 calls to XML::Twig::Elt::root, avg 3µs/call
57891630µs return $root->{twig};
5790 }
5791
5792sub _twig_through_cut
5793 { my $elt= shift;
5794 my $root= $elt->_root_through_cut;
5795 return $root->{twig};
5796 }
5797
5798
5799# used for navigation
5800# returns undef or the element, depending on whether $elt passes $cond
5801# $cond can be
5802# - empty: the element passes the condition
5803# - ELT ('#ELT'): the element passes the condition if it is a "real" element
5804# - TEXT ('#TEXT'): the element passes if it is a CDATA or PCDATA element
5805# - a string with an XPath condition (only a subset of XPath is actually
5806# supported).
5807# - a regexp: the element passes if its gi matches the regexp
5808# - a code ref: the element passes if the code, applied on the element,
5809# returns true
5810
58111100nsmy %cond_cache; # expression => coderef
5812
5813sub reset_cond_cache { %cond_cache=(); }
5814
5815{
5816 sub _install_cond
5817377µs
# spent 7.38ms (6.09+1.29) within XML::Twig::Elt::_install_cond which was called 37 times, avg 199µs/call: # 26 times (1.65ms+654µs) by XML::Twig::Elt::first_child at line 5999, avg 89µs/call # 11 times (4.43ms+637µs) by XML::Twig::Elt::passes at line 5974, avg 461µs/call
{ my $cond= shift;
5818373µs my $test;
5819376µs my $init='';
5820
5821376µs my $original_cond= $cond;
5822
58233762µs3720µs my $not= ($cond=~ s{^\s*!}{}) ? '!' : '';
# spent 20µs making 37 calls to CORE::subst, avg 543ns/call
5824
58253711µs if( ref $cond eq 'CODE') { return $cond; }
5826
58273711µs if( ref $cond eq 'Regexp')
5828 { $test = qq{(\$_[0]->gi=~ /$cond/)}; }
5829 else
5830374µs { my @tests;
5831379µs while( $cond)
5832 {
5833 # the condition is a string
583437696µs222513µs if( $cond=~ s{$ELT$SEP}{})
# spent 406µs making 111 calls to CORE::regcomp, avg 4µs/call # spent 107µs making 111 calls to CORE::subst, avg 966ns/call
5835 { push @tests, qq{\$_[0]->is_elt}; }
5836 elsif( $cond=~ s{$TEXT$SEP}{})
5837 { push @tests, qq{\$_[0]->is_text}; }
5838 elsif( $cond=~ s{^\s*($REG_TAG_PART)$SEP}{})
58393733µs37153µs { push @tests, _gi_test( $1); }
# spent 153µs making 37 calls to XML::Twig::Elt::_gi_test, avg 4µs/call
5840 elsif( $cond=~ s{^\s*($REG_REGEXP)$SEP}{})
5841 { # /regexp/
5842 push @tests, qq{ \$_[0]->gi=~ $1 };
5843 }
5844 elsif( $cond=~ s{^\s*($REG_TAG_PART)?\s* # $1
5845 \[\s*(-?)\s*(\d+)\s*\] # [$2]
5846 $SEP}{}xo
5847 )
5848 { my( $gi, $neg, $index)= ($1, $2, $3);
5849 my $siblings= $neg ? q{$_[0]->_next_siblings} : q{$_[0]->_prev_siblings};
5850 if( $gi && ($gi ne '*'))
5851 #{ $test= qq{((\$_[0]->gi eq "$gi") && (scalar( grep { \$_->gi eq "$gi" } $siblings) + 1 == $index))}; }
5852 { push @tests, _and( _gi_test( $gi), qq{ (scalar( grep { \$_->gi eq "$gi" } $siblings) + 1 == $index)}); }
5853 else
5854 { push @tests, qq{(scalar( $siblings) + 1 == $index)}; }
5855 }
5856 elsif( $cond=~ s{^\s*($REG_TAG_PART?)\s*($REG_PREDICATE)$SEP}{})
5857 { my( $gi, $predicate)= ( $1, $2);
5858 push @tests, _and( _gi_test( $gi), _parse_predicate_in_step( $predicate));
5859 }
5860 elsif( $cond=~ s{^\s*($REG_NAKED_PREDICATE)$SEP}{})
5861 { push @tests, _parse_predicate_in_step( $1); }
5862 else
5863 { croak "wrong navigation condition '$original_cond' ($@)"; }
5864 }
58653718µs $test= @tests > 1 ? '(' . join( '||', map { "($_)" } @tests) . ')' : $tests[0];
5866 }
5867
5868 #warn "init: '$init' - test: '$test'\n";
5869
58703715µs my $sub= qq{sub { $NO_WARNINGS; $init; return $not($test) ? \$_[0] : undef; } };
587137984µs my $s= eval $sub;
# spent 818ms executing statements in string eval
# includes 54.5ms spent executing 202908 calls to 2 subs defined therein. # spent 627ms executing statements in string eval
# includes 299ms spent executing 127277 calls to 2 subs defined therein. # spent 574ms executing statements in string eval
# includes 49.6ms spent executing 127277 calls to 2 subs defined therein. # spent 156µs executing statements in 4 string evals (merged)
# includes 42µs spent executing 50 calls to 5 subs defined therein. # spent 137µs executing statements in 4 string evals (merged)
# includes 31µs spent executing 17 calls to 5 subs defined therein. # spent 125µs executing statements in 3 string evals (merged)
# includes 28µs spent executing 16 calls to 4 subs defined therein. # spent 120µs executing statements in string eval
# includes 96µs spent executing 104 calls to 2 subs defined therein. # spent 109µs executing statements in 3 string evals (merged)
# includes 33µs spent executing 22 calls to 4 subs defined therein. # spent 109µs executing statements in 3 string evals (merged)
# includes 24µs spent executing 26 calls to 4 subs defined therein. # spent 82µs executing statements in 2 string evals (merged)
# includes 15µs spent executing 8 calls to 3 subs defined therein. # spent 70µs executing statements in 2 string evals (merged)
# includes 18µs spent executing 9 calls to 3 subs defined therein. # spent 56µs executing statements in string eval
# includes 32µs spent executing 29 calls to 2 subs defined therein. # spent 47µs executing statements in string eval
# includes 20µs spent executing 15 calls to 2 subs defined therein. # spent 45µs executing statements in string eval
# includes 19µs spent executing 15 calls to 2 subs defined therein. # spent 45µs executing statements in string eval
# includes 8µs spent executing 2 calls to 2 subs defined therein. # spent 45µs executing statements in string eval
# includes 13µs spent executing 7 calls to 2 subs defined therein. # spent 43µs executing statements in string eval
# includes 19µs spent executing 15 calls to 2 subs defined therein. # spent 40µs executing statements in string eval
# includes 15µs spent executing 6 calls to 2 subs defined therein. # spent 38µs executing statements in string eval
# includes 8µs spent executing 2 calls to 2 subs defined therein. # spent 36µs executing statements in string eval
# includes 10µs spent executing 11 calls to 2 subs defined therein. # spent 35µs executing statements in string eval
# includes 7µs spent executing 2 calls to 2 subs defined therein. # spent 33µs executing statements in string eval
# includes 8µs spent executing 5 calls to 2 subs defined therein. # spent 32µs executing statements in string eval
# includes 7µs spent executing 3 calls to 2 subs defined therein.
5872 #warn "cond: $cond\n$sub\n";
5873377µs if( $@)
5874 { croak "wrong navigation condition '$original_cond' ($@);" }
58753768µs return $s;
5876 }
5877
5878 sub _gi_test
58793725µs
# spent 153µs (112+41) within XML::Twig::Elt::_gi_test which was called 37 times, avg 4µs/call: # 37 times (112µs+41µs) by XML::Twig::Elt::_install_cond at line 5839, avg 4µs/call
{ my( $full_gi)= @_;
5880
5881 # optimize if the gi exists, including the case where the gi includes a dot
58823714µs my $index= $XML::Twig::gi2index{$full_gi};
5883373.72ms if( $index) { return qq{\$_[0]->{gi} == $index}; }
5884
5885725µs715µs my( $gi, $class, $id)= $full_gi=~ m{^(.*?)(?:[.]([^.]*)|[#](.*))?$};
# spent 15µs making 7 calls to CORE::match, avg 2µs/call
5886
588771µs my $gi_test='';
588873µs if( $gi && $gi ne '*' )
5889 { # 2 options, depending on whether the gi exists in gi2index
5890 # start optimization
589172µs my $index= $XML::Twig::gi2index{$gi};
589272µs if( $index)
5893 { # the gi exists, use its index as a faster shortcut
5894 $gi_test = qq{\$_[0]->{gi} == $index};
5895 }
5896 else
5897 { # it does not exist (but might be created later), compare the strings
5898
589973µs $gi_test = qq{ \$_[0]->gi eq "$gi"};
5900 }
5901 }
5902 else
5903 { $gi_test= 1; }
5904
590571µs my $class_test='';
5906 #warn "class: '$class'";
590771µs if( $class)
5908 { $class_test = qq{ defined( \$_[0]->{att}->{class}) && \$_[0]->{att}->{class}=~ m{\\b$class\\b} }; }
5909
591071µs my $id_test='';
5911 #warn "id: '$id'";
59127600ns if( $id)
5913 { $id_test = qq{ defined( \$_[0]->{att}->{$ID}) && \$_[0]->{att}->{$ID} eq '$id' }; }
5914
5915
5916 #warn "gi_test: '$gi_test' - class_test: '$class_test' returning ", _and( $gi_test, $class_test);
5917713µs726µs return _and( $gi_test, $class_test, $id_test);
# spent 26µs making 7 calls to XML::Twig::Elt::_and, avg 4µs/call
5918 }
5919
5920
5921 # input: the original predicate
5922 sub _parse_predicate_in_step
5923 { my $cond= shift;
5924 my %PERL_ALPHA_TEST= ( '=' => ' eq ', '!=' => ' ne ', '>' => ' gt ', '>=' => ' ge ', '<' => ' lt ', '<=' => ' le ');
5925
5926 $cond=~ s{^\s*\[\s*}{};
5927 $cond=~ s{\s*\]\s*$}{};
5928 $cond=~ s{( ($REG_STRING|$REG_REGEXP) # strings or regexps
5929 { my( $token, $string, $att, $bare_att, $num_test, $alpha_test, $func, $string_regexp, $string_eq, $string_test, $and_or)
5930 = ( $1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11);
5931
5932 if( defined $string) { $token }
5933 elsif( $att) { "( \$_[0]->{att} && exists( \$_[0]->{att}->{'$att'}) && \$_[0]->{att}->{'$att'})"; }
5934 elsif( $bare_att) { "(\$_[0]->{att} && defined( \$_[0]->{att}->{'$bare_att'}))"; }
5935 elsif( $num_test && ($num_test eq '=') ) { "==" } # others tests are unchanged
5936 elsif( $alpha_test) { $PERL_ALPHA_TEST{$alpha_test} }
5937 elsif( $func && $func=~ m{^(?:string|text)})
5938 { "\$_[0]->text"; }
5939 elsif( $string_regexp && $string_regexp =~ m{(?:string|text)\(\s*($REG_TAG_NAME)\s*\)\s*($REG_MATCH)\s*($REG_REGEXP)})
5940 { "(XML::Twig::_first_n { (\$_->gi eq '$1') && (\$_->text $2 $3) } 1, \$_[0]->_children)"; }
5941 elsif( $string_eq && $string_eq =~ m{(?:string|text)\(\s*($REG_TAG_NAME)\s*\)\s*(!?=)\s*($REG_VALUE)})
5942 {"(XML::Twig::_first_n { (\$_->gi eq '$1') && (\$_->text $PERL_ALPHA_TEST{$2} $3) } 1, \$_[0]->_children)"; }
5943 elsif( $string_test && $string_test =~ m{(?:string|text)\(\s*($REG_TAG_NAME)\s*\)\s*([<>]=?)\s*($REG_VALUE)})
5944 { "(XML::Twig::_first_n { (\$_->gi eq '$1') && (\$_->text $2 $3) } 1, \$_[0]->_children)"; }
5945 elsif( $and_or) { $and_or eq 'and' ? '&&' : '||' ; }
5946 else { $token; }
5947 }gexs;
5948
- -
5960 return "($cond)";
5961 }
5962
5963
5964 sub _op
596552µs
# spent 10µs within XML::Twig::Elt::_op which was called 5 times, avg 2µs/call: # 5 times (10µs+0s) by XML::Twig::Elt::_install_xpath at line 7079, avg 2µs/call
{ my $op= shift;
596653µs if( $op eq '=') { $op= 'eq'; }
5967 elsif( $op eq '!=') { $op= 'ne'; }
596857µs return $op;
5969 }
5970
5971 sub passes
597245841µs
# spent 5.29ms (190µs+5.10) within XML::Twig::Elt::passes which was called 458 times, avg 12µs/call: # 442 times (122µs+0s) by XML::Twig::Elt::ancestors at line 6341, avg 275ns/call # 16 times (68µs+5.10ms) by XML::Twig::descendants at line 3759, avg 323µs/call
{ my( $elt, $cond)= @_;
5973458258µs return $elt unless $cond;
59741616µs115.07ms my $sub= ($cond_cache{$cond} ||= _install_cond( $cond));
# spent 5.07ms making 11 calls to XML::Twig::Elt::_install_cond, avg 461µs/call
59751630µs1632µs return $sub->( $elt);
5976 }
5977}
5978
5979sub set_parent
59801200ns { $_[0]->{parent}= $_[1];
5981 if( $XML::Twig::weakrefs) { weaken( $_[0]->{parent}); }
5982 }
5983
5984sub parent
5985 { my $elt= shift;
5986 my $cond= shift || return $elt->{parent};
5987 do { $elt= $elt->{parent} || return; } until ( $elt->passes( $cond));
5988 return $elt;
5989 }
5990
5991sub set_first_child
5992 { $_[0]->{'first_child'}= $_[1];
5993 }
5994
5995sub first_child
599642156035.3ms
# spent 2.08s (1.66+427ms) within XML::Twig::Elt::first_child which was called 421560 times, avg 5µs/call: # 202907 times (775ms+364ms) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 423 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 6µs/call # 202907 times (775ms+49.7ms) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 375 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 4µs/call # 15651 times (105ms+11.9ms) by XML::Twig::Elt::children at line 6271, avg 7µs/call # 20 times (53µs+180µs) by Spreadsheet::ParseXLSX::_parse_styles at line 822 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 12µs/call # 18 times (79µs+324µs) by Spreadsheet::ParseXLSX::_parse_styles at line 872 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 22µs/call # 15 times (20µs+111µs) by Spreadsheet::ParseXLSX::_parse_styles at line 912 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 9µs/call # 15 times (22µs+105µs) by Spreadsheet::ParseXLSX::_parse_styles at line 911 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 9µs/call # 5 times (40µs+404µs) by Spreadsheet::ParseXLSX::_parse_styles at line 829 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 89µs/call # 5 times (20µs+75µs) by Spreadsheet::ParseXLSX::_parse_styles at line 834 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 19µs/call # 5 times (20µs+4µs) by Spreadsheet::ParseXLSX::_parse_styles at line 833 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 5µs/call # 3 times (20µs+118µs) by Spreadsheet::ParseXLSX::_parse_styles at line 856 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 46µs/call # 3 times (19µs+109µs) by Spreadsheet::ParseXLSX::_parse_styles at line 857 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 43µs/call # 3 times (10µs+85µs) by Spreadsheet::ParseXLSX::_parse_styles at line 858 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 32µs/call # 3 times (14µs+81µs) by Spreadsheet::ParseXLSX::_parse_styles at line 861 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 32µs/call
{ my $elt= shift;
599742156048.4ms my $cond= shift || return $elt->{first_child};
599842153254.3ms my $child= $elt->{first_child};
599942153279.2ms262.31ms my $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond));
# spent 2.31ms making 26 calls to XML::Twig::Elt::_install_cond, avg 89µs/call
6000421532192ms270241425ms while( $child && !$test_cond->( $child))
# spent 364ms making 127276 calls to XML::Twig::Elt::__ANON__[(eval 128)[XML/Twig.pm:5871]:1], avg 3µs/call # spent 49.6ms making 127276 calls to XML::Twig::Elt::__ANON__[(eval 127)[XML/Twig.pm:5871]:1], avg 390ns/call # spent 11.2ms making 15608 calls to XML::Twig::Elt::__ANON__[(eval 126)[XML/Twig.pm:5871]:1], avg 717ns/call # spent 12µs making 5 calls to XML::Twig::Elt::__ANON__[(eval 101)[XML/Twig.pm:5871]:1], avg 2µs/call # spent 10µs making 6 calls to XML::Twig::Elt::__ANON__[(eval 91)[XML/Twig.pm:5871]:1], avg 2µs/call # spent 7µs making 3 calls to XML::Twig::Elt::__ANON__[(eval 95)[XML/Twig.pm:5871]:1], avg 2µs/call # spent 6µs making 3 calls to XML::Twig::Elt::__ANON__[(eval 90)[XML/Twig.pm:5871]:1], avg 2µs/call # spent 6µs making 3 calls to XML::Twig::Elt::__ANON__[(eval 96)[XML/Twig.pm:5871]:1], avg 2µs/call # spent 5µs making 15 calls to XML::Twig::Elt::__ANON__[(eval 104)[XML/Twig.pm:5871]:1], avg 347ns/call # spent 5µs making 13 calls to XML::Twig::Elt::__ANON__[(eval 73)[XML/Twig.pm:5871]:1], avg 400ns/call # spent 4µs making 11 calls to XML::Twig::Elt::__ANON__[(eval 130)[XML/Twig.pm:5871]:1], avg 409ns/call # spent 3µs making 6 calls to XML::Twig::Elt::__ANON__[(eval 100)[XML/Twig.pm:5871]:1], avg 567ns/call # spent 3µs making 4 calls to XML::Twig::Elt::__ANON__[(eval 105)[XML/Twig.pm:5871]:1], avg 650ns/call # spent 2µs making 3 calls to XML::Twig::Elt::__ANON__[(eval 72)[XML/Twig.pm:5871]:1], avg 767ns/call # spent 2µs making 2 calls to XML::Twig::Elt::__ANON__[(eval 80)[XML/Twig.pm:5871]:1], avg 850ns/call # spent 2µs making 2 calls to XML::Twig::Elt::__ANON__[(eval 79)[XML/Twig.pm:5871]:1], avg 750ns/call # spent 2µs making 3 calls to XML::Twig::Elt::__ANON__[(eval 94)[XML/Twig.pm:5871]:1], avg 500ns/call # spent 1µs making 2 calls to XML::Twig::Elt::__ANON__[(eval 71)[XML/Twig.pm:5871]:1], avg 650ns/call
600112740432.1ms10672µs { $child= $child->{next_sibling}; }
# spent 24µs making 22 calls to XML::Twig::Elt::__ANON__[(eval 91)[XML/Twig.pm:5871]:1], avg 1µs/call # spent 13µs making 11 calls to XML::Twig::Elt::__ANON__[(eval 90)[XML/Twig.pm:5871]:1], avg 1µs/call # spent 12µs making 11 calls to XML::Twig::Elt::__ANON__[(eval 95)[XML/Twig.pm:5871]:1], avg 1µs/call # spent 12µs making 11 calls to XML::Twig::Elt::__ANON__[(eval 96)[XML/Twig.pm:5871]:1], avg 1µs/call # spent 3µs making 16 calls to XML::Twig::Elt::__ANON__[(eval 104)[XML/Twig.pm:5871]:1], avg 206ns/call # spent 2µs making 7 calls to XML::Twig::Elt::__ANON__[(eval 105)[XML/Twig.pm:5871]:1], avg 243ns/call # spent 2µs making 8 calls to XML::Twig::Elt::__ANON__[(eval 73)[XML/Twig.pm:5871]:1], avg 212ns/call # spent 2µs making 7 calls to XML::Twig::Elt::__ANON__[(eval 94)[XML/Twig.pm:5871]:1], avg 214ns/call # spent 1µs making 6 calls to XML::Twig::Elt::__ANON__[(eval 72)[XML/Twig.pm:5871]:1], avg 233ns/call # spent 1µs making 4 calls to XML::Twig::Elt::__ANON__[(eval 71)[XML/Twig.pm:5871]:1], avg 250ns/call # spent 700ns making 2 calls to XML::Twig::Elt::__ANON__[(eval 80)[XML/Twig.pm:5871]:1], avg 350ns/call # spent 300ns making 1 call to XML::Twig::Elt::__ANON__[(eval 130)[XML/Twig.pm:5871]:1]
6002421532849ms return $child;
6003 }
6004
6005sub _first_child { return $_[0]->{first_child}; }
6006sub _last_child { return $_[0]->{last_child}; }
6007sub _next_sibling { return $_[0]->{next_sibling}; }
6008sub _prev_sibling { return $_[0]->{prev_sibling}; }
6009sub _parent { return $_[0]->{parent}; }
6010sub _next_siblings { my $elt= shift; my @siblings; while( $elt= $elt->{next_sibling}) { push @siblings, $elt; } return @siblings; }
6011sub _prev_siblings { my $elt= shift; my @siblings; while( $elt= $elt->{prev_sibling}) { push @siblings, $elt; } return @siblings; }
6012
6013# sets a field
6014# arguments $record, $cond, @content
6015sub set_field
6016 { my $record = shift;
6017 my $cond = shift;
6018 my $child= $record->first_child( $cond);
6019 if( $child)
6020 { $child->set_content( @_); }
6021 else
6022 { if( $cond=~ m{^\s*($REG_TAG_NAME)})
6023 { my $gi= $1;
6024 $child= $record->insert_new_elt( last_child => $gi, @_);
6025 }
6026 else
6027 { croak "can't create a field name from $cond"; }
6028 }
6029 return $child;
6030 }
6031
6032sub set_last_child
6033 { $_[0]->{'last_child'}= $_[1];
6034 delete $_->[0]->{empty};
6035 if( $XML::Twig::weakrefs) { weaken( $_[0]->{'last_child'}); }
6036 }
6037
6038sub last_child
6039 { my $elt= shift;
6040 my $cond= shift || return $elt->{last_child};
6041 my $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond));
6042 my $child= $elt->{last_child};
6043 while( $child && !$test_cond->( $child) )
6044 { $child= $child->{prev_sibling}; }
6045 return $child
6046 }
6047
6048
6049sub set_prev_sibling
6050 { $_[0]->{'prev_sibling'}= $_[1];
6051 if( $XML::Twig::weakrefs) { weaken( $_[0]->{'prev_sibling'}); }
6052 }
6053
6054sub prev_sibling
6055 { my $elt= shift;
6056 my $cond= shift || return $elt->{prev_sibling};
6057 my $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond));
6058 my $sibling= $elt->{prev_sibling};
6059 while( $sibling && !$test_cond->( $sibling) )
6060 { $sibling= $sibling->{prev_sibling}; }
6061 return $sibling;
6062 }
6063
6064sub set_next_sibling { $_[0]->{'next_sibling'}= $_[1]; }
6065
6066sub next_sibling
606720298617.2ms
# spent 958ms (915+43.3) within XML::Twig::Elt::next_sibling which was called 202986 times, avg 5µs/call: # 202986 times (915ms+43.3ms) by XML::Twig::Elt::children at line 6274, avg 5µs/call
{ my $elt= shift;
606820298617.8ms my $cond= shift || return $elt->{next_sibling};
606920294728.9ms my $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond));
607020294730.7ms my $sibling= $elt->{next_sibling};
607120294782.0ms18732443.3ms while( $sibling && !$test_cond->( $sibling) )
# spent 43.3ms making 187299 calls to XML::Twig::Elt::__ANON__[(eval 126)[XML/Twig.pm:5871]:1], avg 231ns/call # spent 3µs making 14 calls to XML::Twig::Elt::__ANON__[(eval 104)[XML/Twig.pm:5871]:1], avg 229ns/call # spent 2µs making 9 calls to XML::Twig::Elt::__ANON__[(eval 72)[XML/Twig.pm:5871]:1], avg 233ns/call # spent 500ns making 2 calls to XML::Twig::Elt::__ANON__[(eval 73)[XML/Twig.pm:5871]:1], avg 250ns/call
6072 { $sibling= $sibling->{next_sibling}; }
6073202947359ms return $sibling;
6074 }
6075
6076# methods dealing with the class attribute, convenient if you work with xhtml
6077sub class { $_[0]->{att}->{class}; }
6078# lvalue version of class. separate from class to avoid problem like RT#
6079sub lclass
6080 :lvalue # > perl 5.5
6081 { $_[0]->{att}->{class}; }
6082
6083sub set_class { my( $elt, $class)= @_; $elt->set_att( class => $class); }
6084
6085# adds a class to an element
6086sub add_to_class
6087 { my( $elt, $new_class)= @_;
6088 return $elt unless $new_class;
6089 my $class= $elt->class;
6090 my %class= $class ? map { $_ => 1 } split /\s+/, $class : ();
6091 $class{$new_class}= 1;
6092 $elt->set_class( join( ' ', sort keys %class));
6093 }
6094
6095sub remove_class
6096 { my( $elt, $class_to_remove)= @_;
6097 return $elt unless $class_to_remove;
6098 my $class= $elt->class;
6099 my %class= $class ? map { $_ => 1 } split /\s+/, $class : ();
6100 delete $class{$class_to_remove};
6101 $elt->set_class( join( ' ', sort keys %class));
6102 }
6103
6104sub att_to_class { my( $elt, $att)= @_; $elt->set_class( $elt->{'att'}->{$att}); }
6105sub add_att_to_class { my( $elt, $att)= @_; $elt->add_to_class( $elt->{'att'}->{$att}); }
6106sub move_att_to_class { my( $elt, $att)= @_; $elt->add_to_class( $elt->{'att'}->{$att});
6107 $elt->del_att( $att);
6108 }
6109sub tag_to_class { my( $elt)= @_; $elt->set_class( $elt->tag); }
6110sub add_tag_to_class { my( $elt)= @_; $elt->add_to_class( $elt->tag); }
6111sub set_tag_class { my( $elt, $new_tag)= @_; $elt->add_tag_to_class; $elt->set_tag( $new_tag); }
6112
6113sub tag_to_span
6114 { my( $elt)= @_;
6115 $elt->set_class( $elt->tag) unless( $elt->tag eq 'span' && $elt->class); # set class to span unless it would mean replacing it with span
6116 $elt->set_tag( 'span');
6117 }
6118
6119sub tag_to_div
6120 { my( $elt)= @_;
6121 $elt->set_class( $elt->tag) unless( $elt->tag eq 'div' && $elt->class); # set class to div unless it would mean replacing it with div
6122 $elt->set_tag( 'div');
6123 }
6124
6125sub in_class
6126 { my( $elt, $class)= @_;
6127 my $elt_class= $elt->class;
6128 return unless( defined $elt_class);
6129 return $elt->class=~ m{(?:^|\s)\Q$class\E(?:\s|$)} ? $elt : 0;
6130 }
6131
6132
6133# get or set all attributes
6134# argument can be a hash or a hashref
6135sub set_atts
613636436943.3ms
# spent 1.69s (1.56+128ms) within XML::Twig::Elt::set_atts which was called 364369 times, avg 5µs/call: # 364369 times (1.56s+128ms) by XML::Twig::_twig_start at line 2080, avg 5µs/call
{ my $elt= shift;
613736436941.3ms my %atts;
6138364369181ms364369128ms tie %atts, 'Tie::IxHash' if( keep_atts_order());
# spent 128ms making 364369 calls to XML::Twig::Elt::keep_atts_order, avg 352ns/call
6139364369318ms %atts= @_ == 1 ? %{$_[0]} : @_;
6140364369106ms $elt->{att}= \%atts;
614136436962.8ms if( exists $atts{$ID}) { $elt->_set_id( $atts{$ID}); }
6142364369793ms return $elt;
6143 }
6144
6145sub atts { return $_[0]->{att}; }
6146sub att_names { return (sort keys %{$_[0]->{att}}); }
6147sub del_atts { $_[0]->{att}={}; return $_[0]; }
6148
6149# get or set a single attribute (set works for several atts)
6150sub set_att
6151 { my $elt= shift;
6152
6153 if( $_[0] && ref( $_[0]) && !$_[1])
6154 { croak "improper call to set_att, usage is \$elt->set_att( att1 => 'val1', att2 => 'val2',...)"; }
6155
6156 unless( $elt->{att})
6157 { $elt->{att}={};
6158 tie %{$elt->{att}}, 'Tie::IxHash' if( keep_atts_order());
6159 }
6160
6161 while(@_)
6162 { my( $att, $val)= (shift, shift);
6163 $elt->{att}->{$att}= $val;
6164 if( $att eq $ID) { $elt->_set_id( $val); }
6165 }
6166 return $elt;
6167 }
6168
61696740811.19s
# spent 278ms within XML::Twig::Elt::att which was called 674081 times, avg 412ns/call: # 202907 times (100ms+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 358 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 493ns/call # 202907 times (73.0ms+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 407 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 360ns/call # 202907 times (68.3ms+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 373 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 336ns/call # 18180 times (12.4ms+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:302] at line 292 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 684ns/call # 15608 times (12.8ms+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 350 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 820ns/call # 15608 times (5.77ms+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 353 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 369ns/call # 15608 times (5.46ms+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 354 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 350ns/call # 90 times (35µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 913 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 389ns/call # 49 times (15µs+0s) by Spreadsheet::ParseXLSX::_color at line 1132 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 314ns/call # 19 times (6µs+0s) by Spreadsheet::ParseXLSX::_color at line 1131 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 289ns/call # 15 times (5µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 916 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 353ns/call # 15 times (5µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 917 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 347ns/call # 15 times (5µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 920 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 320ns/call # 15 times (5µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 922 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 313ns/call # 15 times (4µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 919 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 293ns/call # 15 times (4µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 921 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 260ns/call # 12 times (7µs+0s) by Spreadsheet::ParseXLSX::_parse_themes at line 672 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 600ns/call # 12 times (4µs+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:268] at line 264 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 367ns/call # 11 times (3µs+0s) by Spreadsheet::ParseXLSX::_color at line 1150 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 245ns/call # 10 times (7µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 821 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 720ns/call # 5 times (3µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 830 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 600ns/call # 5 times (2µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 927 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 320ns/call # 5 times (1µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 926 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 260ns/call # 5 times (1µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 928 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 260ns/call # 5 times (1µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 925 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 240ns/call # 5 times (1µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 929 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 240ns/call # 5 times (1µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 930 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 240ns/call # 3 times (2µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 860 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 767ns/call # 3 times (2µs+0s) by Spreadsheet::ParseXLSX::_parse_workbook at line 139 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 700ns/call # 3 times (2µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 862 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 533ns/call # 2 times (2µs+0s) by Spreadsheet::ParseXLSX::_extract_files at line 985 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 750ns/call # 2 times (2µs+0s) by Spreadsheet::ParseXLSX::_extract_files at line 1010 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 750ns/call # 2 times (1µs+0s) by Spreadsheet::ParseXLSX::_parse_styles at line 827 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 600ns/call # 2 times (900ns+0s) by Spreadsheet::ParseXLSX::_color at line 1142 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 450ns/call # once (2µs+0s) by Spreadsheet::ParseXLSX::_parse_workbook at line 205 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (2µs+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:246] at line 238 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (2µs+0s) by Spreadsheet::ParseXLSX::_extract_files at line 966 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (1µs+0s) by Spreadsheet::ParseXLSX::_extract_files at line 981 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (1µs+0s) by Spreadsheet::ParseXLSX::_extract_files at line 993 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (1µs+0s) by Spreadsheet::ParseXLSX::_parse_workbook at line 177 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (800ns+0s) by Spreadsheet::ParseXLSX::_extract_files at line 983 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (800ns+0s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:338] at line 330 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (600ns+0s) by Spreadsheet::ParseXLSX::_parse_workbook at line 184 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (500ns+0s) by Spreadsheet::ParseXLSX::_parse_workbook at line 179 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm # once (400ns+0s) by Spreadsheet::ParseXLSX::_parse_workbook at line 148 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm
sub att { $_[0]->{att}->{$_[1]}; }
6170# lvalue version of att. separate from class to avoid problem like RT#
6171sub latt
6172 :lvalue # > perl 5.5
6173 { $_[0]->{att}->{$_[1]}; }
6174
6175sub del_att
6176 { my $elt= shift;
6177 while( @_) { delete $elt->{'att'}->{shift()}; }
6178 return $elt;
6179 }
6180
6181sub att_exists { return exists $_[0]->{att}->{$_[1]}; }
6182
6183# delete an attribute from all descendants of an element
6184sub strip_att
6185 { my( $elt, $att)= @_;
6186 $_->del_att( $att) foreach ($elt->descendants_or_self( qq{*[\@$att]}));
6187 return $elt;
6188 }
6189
6190sub change_att_name
6191 { my( $elt, $old_name, $new_name)= @_;
6192 my $value= $elt->{'att'}->{$old_name};
6193 return $elt unless( defined $value);
6194 $elt->del_att( $old_name)
6195 ->set_att( $new_name => $value);
6196 return $elt;
6197 }
6198
6199sub lc_attnames
6200 { my $elt= shift;
6201 foreach my $att ($elt->att_names)
6202 { if( $att ne lc $att) { $elt->change_att_name( $att, lc $att); } }
6203 return $elt;
6204 }
6205
6206sub set_twig_current { $_[0]->{twig_current}=1; }
6207sub del_twig_current { delete $_[0]->{twig_current}; }
6208
6209
6210# get or set the id attribute
6211sub set_id
6212 { my( $elt, $id)= @_;
6213 $elt->del_id() if( exists $elt->{att}->{$ID});
6214 $elt->set_att($ID, $id);
6215 $elt->_set_id( $id);
6216 return $elt;
6217 }
6218
6219# only set id, does not update the attribute value
6220sub _set_id
6221 { my( $elt, $id)= @_;
6222 my $t= $elt->twig || $elt;
6223 $t->{twig_id_list}->{$id}= $elt;
6224 if( $XML::Twig::weakrefs) { weaken( $t->{twig_id_list}->{$id}); }
6225 return $elt;
6226 }
6227
6228sub id { return $_[0]->{att}->{$ID}; }
6229
6230# methods used to add ids to elements that don't have one
6231BEGIN
62321300ns
# spent 3µs within XML::Twig::Elt::BEGIN@6232 which was called: # once (3µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 6248
{ my $id_nb = "0001";
623314µs my $id_seed = "twig_id_";
6234
6235 sub set_id_seed ## no critic (Subroutines::ProhibitNestedSubs);
6236 { $id_seed= $_[1]; $id_nb=1; }
6237
6238 sub add_id ## no critic (Subroutines::ProhibitNestedSubs);
6239 { my $elt= shift;
6240 if( defined $elt->{'att'}->{$ID})
6241 { return $elt->{'att'}->{$ID}; }
6242 else
6243 { my $id= $_[0] && ref( $_[0]) && isa( $_[0], 'CODE') ? $_[0]->( $elt) : $id_seed . $id_nb++;
6244 $elt->set_id( $id);
6245 return $id;
6246 }
6247 }
624812.61ms13µs}
# spent 3µs making 1 call to XML::Twig::Elt::BEGIN@6232
6249
- -
6252# delete the id attribute and remove the element from the id list
6253sub del_id
6254 { my $elt= shift;
6255 if( ! exists $elt->{att}->{$ID}) { return $elt };
6256 my $id= $elt->{att}->{$ID};
6257
6258 delete $elt->{att}->{$ID};
6259
6260 my $t= shift || $elt->twig;
6261 unless( $t) { return $elt; }
6262 if( exists $t->{twig_id_list}->{$id}) { delete $t->{twig_id_list}->{$id}; }
6263
6264 return $elt;
6265 }
6266
6267# return the list of children
6268sub children
6269156511.60ms
# spent 1.57s (500ms+1.07) within XML::Twig::Elt::children which was called 15651 times, avg 101µs/call: # 15608 times (500ms+1.07s) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 357 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 101µs/call # 15 times (47µs+18µs) by Spreadsheet::ParseXLSX::_get_text_and_rich_font_by_cell at line 582 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 4µs/call # 13 times (44µs+15µs) by XML::Twig::Elt::__ANON__[(eval 68)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 68)[XML/Twig.pm:7113], avg 4µs/call # 11 times (34µs+238µs) by XML::Twig::Elt::__ANON__[(eval 70)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 70)[XML/Twig.pm:7113], avg 25µs/call # once (16µs+116µs) by XML::Twig::Elt::__ANON__[(eval 97)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 97)[XML/Twig.pm:7113] # once (4µs+104µs) by XML::Twig::Elt::__ANON__[(eval 76)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 76)[XML/Twig.pm:7113] # once (6µs+100µs) by XML::Twig::Elt::__ANON__[(eval 87)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 87)[XML/Twig.pm:7113] # once (4µs+88µs) by XML::Twig::Elt::__ANON__[(eval 103)[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/XML/Twig.pm:7113]:1] at line 1 of (eval 103)[XML/Twig.pm:7113]
{ my $elt= shift;
6270156511.67ms my @children;
62711565111.9ms15651116ms my $child= $elt->first_child( @_);
# spent 116ms making 15651 calls to XML::Twig::Elt::first_child, avg 7µs/call
62721565111.2ms while( $child)
627320298617.0ms { push @children, $child;
6274202986104ms202986958ms $child= $child->next_sibling( @_);
# spent 958ms making 202986 calls to XML::Twig::Elt::next_sibling, avg 5µs/call
6275 }
62761565132.0ms return @children;
6277 }
6278
6279sub _children
6280 { my $elt= shift;
6281 my @children=();
6282 my $child= $elt->{first_child};
6283 while( $child)
6284 { push @children, $child;
6285 $child= $child->{next_sibling};
6286 }
6287 return @children;
6288 }
6289
6290sub children_copy
6291 { my $elt= shift;
6292 my @children;
6293 my $child= $elt->first_child( @_);
6294 while( $child)
6295 { push @children, $child->copy;
6296 $child= $child->next_sibling( @_);
6297 }
6298 return @children;
6299 }
6300
6301
6302sub children_count
6303 { my $elt= shift;
6304 my $cond= shift;
6305 my $count=0;
6306 my $child= $elt->{first_child};
6307 while( $child)
6308 { $count++ if( $child->passes( $cond));
6309 $child= $child->{next_sibling};
6310 }
6311 return $count;
6312 }
6313
6314sub children_text
6315 { my $elt= shift;
6316 return wantarray() ? map { $_->text} $elt->children( @_)
6317 : join( '', map { $_->text} $elt->children( @_) )
6318 ;
6319 }
6320
6321sub children_trimmed_text
6322 { my $elt= shift;
6323 return wantarray() ? map { $_->trimmed_text} $elt->children( @_)
6324 : join( '', map { $_->trimmed_text} $elt->children( @_) )
6325 ;
6326 }
6327
6328sub all_children_are
6329 { my( $parent, $cond)= @_;
6330 foreach my $child ($parent->_children)
6331 { return 0 unless( $child->passes( $cond)); }
6332 return $parent;
6333 }
6334
6335
6336sub ancestors
633715418µs
# spent 649µs (527+121) within XML::Twig::Elt::ancestors which was called 154 times, avg 4µs/call: # 77 times (265µs+60µs) by XML::Twig::Elt::cmp at line 9725, avg 4µs/call # 77 times (262µs+62µs) by XML::Twig::Elt::cmp at line 9726, avg 4µs/call
{ my( $elt, $cond)= @_;
63381548µs my @ancestors;
633915425µs while( $elt->{parent})
634044239µs { $elt= $elt->{parent};
6341442228µs442122µs push @ancestors, $elt if( $elt->passes( $cond));
# spent 122µs making 442 calls to XML::Twig::Elt::passes, avg 275ns/call
6342 }
634315496µs return @ancestors;
6344 }
6345
6346sub ancestors_or_self
6347 { my( $elt, $cond)= @_;
6348 my @ancestors;
6349 while( $elt)
6350 { push @ancestors, $elt if( $elt->passes( $cond));
6351 $elt= $elt->{parent};
6352 }
6353 return @ancestors;
6354 }
6355
6356
6357sub _ancestors
6358 { my( $elt, $include_self)= @_;
6359 my @ancestors= $include_self ? ($elt) : ();
6360 while( $elt= $elt->{parent}) { push @ancestors, $elt; }
6361 return @ancestors;
6362 }
6363
6364
6365sub inherit_att
6366 { my $elt= shift;
6367 my $att= shift;
6368 my %tags= map { ($_, 1) } @_;
6369
6370 do
6371 { if( (defined $elt->{'att'}->{$att})
6372 && ( !%tags || $tags{$XML::Twig::index2gi[$elt->{'gi'}]})
6373 )
6374 { return $elt->{'att'}->{$att}; }
6375 } while( $elt= $elt->{parent});
6376 return undef;
6377 }
6378
6379sub _inherit_att_through_cut
6380 { my $elt= shift;
6381 my $att= shift;
6382 my %tags= map { ($_, 1) } @_;
6383
6384 do
6385 { if( (defined $elt->{'att'}->{$att})
6386 && ( !%tags || $tags{$XML::Twig::index2gi[$elt->{'gi'}]})
6387 )
6388 { return $elt->{'att'}->{$att}; }
6389 } while( $elt= $elt->{parent} || ($elt->{former} && $elt->{former}->{parent}));
6390 return undef;
6391 }
6392
6393
6394sub current_ns_prefixes
6395 { my $elt= shift;
6396 my %prefix;
6397 $prefix{''}=1 if( $elt->namespace( ''));
6398 while( $elt)
6399 { my @ns= grep { !m{^xml} } map { m{^([^:]+):} } ($XML::Twig::index2gi[$elt->{'gi'}], $elt->att_names);
6400 $prefix{$_}=1 foreach (@ns);
6401 $elt= $elt->{parent};
6402 }
6403
6404 return (sort keys %prefix);
6405 }
6406
6407# kinda counter-intuitive actually:
6408# the next element is found by looking for the next open tag after from the
6409# current one, which is the first child, if it exists, or the next sibling
6410# or the first next sibling of an ancestor
6411# optional arguments are:
6412# - $subtree_root: a reference to an element, when the next element is not
6413# within $subtree_root anymore then next_elt returns undef
6414# - $cond: a condition, next_elt returns the next element matching the condition
6415
6416sub next_elt
64171300ns
# spent 252µs (136+117) within XML::Twig::Elt::next_elt which was called: # once (136µs+117µs) by XML::Twig::Elt::descendants at line 6875
{ my $elt= shift;
64181300ns my $subtree_root= 0;
641914µs1800ns $subtree_root= shift if( ref( $_[0]) && isa( $_[0], 'XML::Twig::Elt'));
# spent 800ns making 1 call to UNIVERSAL::isa
64201200ns my $cond= shift;
64211300ns my $next_elt;
6422
6423 my $ind; # optimization
6424 my $test_cond;
642511µs if( $cond) # optimization
6426 { unless( defined( $ind= $XML::Twig::gi2index{$cond}) ) # optimization
6427 { $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond)); } # optimization
6428 } # optimization
6429
6430 do
643110319µs { if( $next_elt= $elt->{first_child})
6432 { # simplest case: the elt has a child
6433 }
6434 elsif( $next_elt= $elt->{next_sibling})
6435 { # no child but a next sibling (just check we stay within the subtree)
6436
6437 # case where elt is subtree_root, is empty and has a sibling
6438 return undef if( $subtree_root && ($elt == $subtree_root));
6439
6440 }
6441 else
6442 { # case where the element has no child and no next sibling:
6443 # get the first next sibling of an ancestor, checking subtree_root
6444
6445 # case where elt is subtree_root, is empty and has no sibling
6446243µs return undef if( $subtree_root && ($elt == $subtree_root));
6447
6448243µs $next_elt= $elt->{parent} || return undef;
6449
6450244µs until( $next_elt->{next_sibling})
6451164µs { return undef if( $subtree_root && ($subtree_root == $next_elt));
6452153µs $next_elt= $next_elt->{parent} || return undef;
6453 }
6454233µs return undef if( $subtree_root && ($subtree_root == $next_elt));
6455233µs $next_elt= $next_elt->{next_sibling};
6456 }
64571026µs $elt= $next_elt; # just in case we need to loop
6458 } until( ! defined $elt
6459 || ! defined $cond
6460143µs102116µs || (defined $ind && ($elt->{gi} eq $ind)) # optimization
# spent 116µs making 102 calls to XML::Twig::Elt::__ANON__[(eval 86)[XML/Twig.pm:5871]:1], avg 1µs/call
6461 || (defined $test_cond && ($test_cond->( $elt)))
6462 );
6463
6464 return $elt;
6465 }
6466
6467# return the next_elt within the element
6468# just call next_elt with the element as first and second argument
6469sub first_descendant { return $_[0]->next_elt( @_); }
6470
6471# get the last descendant, # then return the element found or call prev_elt with the condition
6472sub last_descendant
6473 { my( $elt, $cond)= @_;
6474 my $last_descendant= $elt->_last_descendant;
6475 if( !$cond || $last_descendant->matches( $cond))
6476 { return $last_descendant; }
6477 else
6478 { return $last_descendant->prev_elt( $elt, $cond); }
6479 }
6480
6481# no argument allowed here, just go down the last_child recursively
6482sub _last_descendant
6483 { my $elt= shift;
6484 while( my $child= $elt->{last_child}) { $elt= $child; }
6485 return $elt;
6486 }
6487
6488# counter-intuitive too:
6489# the previous element is found by looking
6490# for the first open tag backwards from the current one
6491# it's the last descendant of the previous sibling
6492# if it exists, otherwise it's simply the parent
6493sub prev_elt
6494 { my $elt= shift;
6495 my $subtree_root= 0;
6496 if( defined $_[0] and (ref( $_[0]) && isa( $_[0], 'XML::Twig::Elt')))
6497 { $subtree_root= shift ;
6498 return undef if( $elt == $subtree_root);
6499 }
6500 my $cond= shift;
6501 # get prev elt
6502 my $prev_elt;
6503 do
6504 { return undef if( $elt == $subtree_root);
6505 if( $prev_elt= $elt->{prev_sibling})
6506 { while( $prev_elt->{last_child})
6507 { $prev_elt= $prev_elt->{last_child}; }
6508 }
6509 else
6510 { $prev_elt= $elt->{parent} || return undef; }
6511 $elt= $prev_elt; # in case we need to loop
6512 } until( $elt->passes( $cond));
6513
6514 return $elt;
6515 }
6516
6517sub _following_elt
6518 { my( $elt)= @_;
6519 while( $elt && !$elt->{next_sibling})
6520 { $elt= $elt->{parent}; }
6521 return $elt ? $elt->{next_sibling} : undef;
6522 }
6523
6524sub following_elt
6525 { my( $elt, $cond)= @_;
6526 $elt= $elt->_following_elt || return undef;
6527 return $elt if( !$cond || $elt->matches( $cond));
6528 return $elt->next_elt( $cond);
6529 }
6530
6531sub following_elts
6532 { my( $elt, $cond)= @_;
6533 if( !$cond) { undef $cond; }
6534 my $following= $elt->following_elt( $cond);
6535 if( $following)
6536 { my @followings= $following;
6537 while( $following= $following->next_elt( $cond))
6538 { push @followings, $following; }
6539 return( @followings);
6540 }
6541 else
6542 { return (); }
6543 }
6544
6545sub _preceding_elt
6546 { my( $elt)= @_;
6547 while( $elt && !$elt->{prev_sibling})
6548 { $elt= $elt->{parent}; }
6549 return $elt ? $elt->{prev_sibling}->_last_descendant : undef;
6550 }
6551
6552sub preceding_elt
6553 { my( $elt, $cond)= @_;
6554 $elt= $elt->_preceding_elt || return undef;
6555 return $elt if( !$cond || $elt->matches( $cond));
6556 return $elt->prev_elt( $cond);
6557 }
6558
6559sub preceding_elts
6560 { my( $elt, $cond)= @_;
6561 if( !$cond) { undef $cond; }
6562 my $preceding= $elt->preceding_elt( $cond);
6563 if( $preceding)
6564 { my @precedings= $preceding;
6565 while( $preceding= $preceding->prev_elt( $cond))
6566 { push @precedings, $preceding; }
6567 return( @precedings);
6568 }
6569 else
6570 { return (); }
6571 }
6572
6573# used in get_xpath
6574sub _self
6575 { my( $elt, $cond)= @_;
6576 return $cond ? $elt->matches( $cond) : $elt;
6577 }
6578
6579sub next_n_elt
6580 { my $elt= shift;
6581 my $offset= shift || return undef;
6582 foreach (1..$offset)
6583 { $elt= $elt->next_elt( @_) || return undef; }
6584 return $elt;
6585 }
6586
6587# checks whether $elt is included in $ancestor, returns 1 in that case
6588sub in
6589677689.70ms
# spent 203ms (177+26.7) within XML::Twig::Elt::in which was called 67768 times, avg 3µs/call: # 67614 times (176ms+26.7ms) by XML::Twig::purge at line 3546, avg 3µs/call # 77 times (148µs+14µs) by XML::Twig::Elt::cmp at line 9721, avg 2µs/call # 77 times (119µs+8µs) by XML::Twig::Elt::cmp at line 9722, avg 2µs/call
{ my ($elt, $ancestor)= @_;
659067768144ms6776826.7ms if( ref( $ancestor) && isa( $ancestor, 'XML::Twig::Elt'))
# spent 26.7ms making 67768 calls to UNIVERSAL::isa, avg 395ns/call
6591 { # element
65926805678.0ms while( $elt= $elt->{parent}) { return $elt if( $elt == $ancestor); }
6593 }
6594 else
6595 { # condition
6596 while( $elt= $elt->{parent}) { return $elt if( $elt->matches( $ancestor)); }
6597 }
65983396159.9ms return 0;
6599 }
6600
6601sub first_child_text
6602 { my $elt= shift;
6603 my $dest=$elt->first_child(@_) or return '';
6604 return $dest->text;
6605 }
6606
6607sub fields
6608 { my $elt= shift;
6609 return map { $elt->field( $_) } @_;
6610 }
6611
6612sub first_child_trimmed_text
6613 { my $elt= shift;
6614 my $dest=$elt->first_child(@_) or return '';
6615 return $dest->trimmed_text;
6616 }
6617
6618sub first_child_matches
6619 { my $elt= shift;
6620 my $dest= $elt->{first_child} or return undef;
6621 return $dest->passes( @_);
6622 }
6623
6624sub last_child_text
6625 { my $elt= shift;
6626 my $dest=$elt->last_child(@_) or return '';
6627 return $dest->text;
6628 }
6629
6630sub last_child_trimmed_text
6631 { my $elt= shift;
6632 my $dest=$elt->last_child(@_) or return '';
6633 return $dest->trimmed_text;
6634 }
6635
6636sub last_child_matches
6637 { my $elt= shift;
6638 my $dest= $elt->{last_child} or return undef;
6639 return $dest->passes( @_);
6640 }
6641
6642sub child_text
6643 { my $elt= shift;
6644 my $dest=$elt->child(@_) or return '';
6645 return $dest->text;
6646 }
6647
6648sub child_trimmed_text
6649 { my $elt= shift;
6650 my $dest=$elt->child(@_) or return '';
6651 return $dest->trimmed_text;
6652 }
6653
6654sub child_matches
6655 { my $elt= shift;
6656 my $nb= shift;
6657 my $dest= $elt->child( $nb) or return undef;
6658 return $dest->passes( @_);
6659 }
6660
6661sub prev_sibling_text
6662 { my $elt= shift;
6663 my $dest= $elt->_prev_sibling(@_) or return '';
6664 return $dest->text;
6665 }
6666
6667sub prev_sibling_trimmed_text
6668 { my $elt= shift;
6669 my $dest= $elt->_prev_sibling(@_) or return '';
6670 return $dest->trimmed_text;
6671 }
6672
6673sub prev_sibling_matches
6674 { my $elt= shift;
6675 my $dest= $elt->{prev_sibling} or return undef;
6676 return $dest->passes( @_);
6677 }
6678
6679sub next_sibling_text
6680 { my $elt= shift;
6681 my $dest= $elt->next_sibling(@_) or return '';
6682 return $dest->text;
6683 }
6684
6685sub next_sibling_trimmed_text
6686 { my $elt= shift;
6687 my $dest= $elt->next_sibling(@_) or return '';
6688 return $dest->trimmed_text;
6689 }
6690
6691sub next_sibling_matches
6692 { my $elt= shift;
6693 my $dest= $elt->{next_sibling} or return undef;
6694 return $dest->passes( @_);
6695 }
6696
6697sub prev_elt_text
6698 { my $elt= shift;
6699 my $dest= $elt->prev_elt(@_) or return '';
6700 return $dest->text;
6701 }
6702
6703sub prev_elt_trimmed_text
6704 { my $elt= shift;
6705 my $dest= $elt->prev_elt(@_) or return '';
6706 return $dest->trimmed_text;
6707 }
6708
6709sub prev_elt_matches
6710 { my $elt= shift;
6711 my $dest= $elt->prev_elt or return undef;
6712 return $dest->passes( @_);
6713 }
6714
6715sub next_elt_text
6716 { my $elt= shift;
6717 my $dest= $elt->next_elt(@_) or return '';
6718 return $dest->text;
6719 }
6720
6721sub next_elt_trimmed_text
6722 { my $elt= shift;
6723 my $dest= $elt->next_elt(@_) or return '';
6724 return $dest->trimmed_text;
6725 }
6726
6727sub next_elt_matches
6728 { my $elt= shift;
6729 my $dest= $elt->next_elt or return undef;
6730 return $dest->passes( @_);
6731 }
6732
6733sub parent_text
6734 { my $elt= shift;
6735 my $dest= $elt->parent(@_) or return '';
6736 return $dest->text;
6737 }
6738
6739sub parent_trimmed_text
6740 { my $elt= shift;
6741 my $dest= $elt->parent(@_) or return '';
6742 return $dest->trimmed_text;
6743 }
6744
6745sub parent_matches
6746 { my $elt= shift;
6747 my $dest= $elt->{parent} or return undef;
6748 return $dest->passes( @_);
6749 }
6750
6751sub is_first_child
6752 { my $elt= shift;
6753 my $parent= $elt->{parent} or return 0;
6754 my $first_child= $parent->first_child( @_) or return 0;
6755 return ($first_child == $elt) ? $elt : 0;
6756 }
6757
6758sub is_last_child
6759 { my $elt= shift;
6760 my $parent= $elt->{parent} or return 0;
6761 my $last_child= $parent->last_child( @_) or return 0;
6762 return ($last_child == $elt) ? $elt : 0;
6763 }
6764
6765# returns the depth level of the element
6766# if 2 parameter are used then counts the 2cd element name in the
6767# ancestors list
6768sub level
6769 { my( $elt, $cond)= @_;
6770 my $level=0;
6771 my $name=shift || '';
6772 while( $elt= $elt->{parent}) { $level++ if( !$cond || $elt->matches( $cond)); }
6773 return $level;
6774 }
6775
6776# checks whether $elt has an ancestor that satisfies $cond, returns the ancestor
6777sub in_context
6778 { my ($elt, $cond, $level)= @_;
6779 $level= -1 unless( $level) ; # $level-- will never hit 0
6780
6781 while( $level)
6782 { $elt= $elt->{parent} or return 0;
6783 if( $elt->matches( $cond)) { return $elt; }
6784 $level--;
6785 }
6786 return 0;
6787 }
6788
6789sub _descendants
6790 { my( $subtree_root, $include_self)= @_;
6791 my @descendants= $include_self ? ($subtree_root) : ();
6792
6793 my $elt= $subtree_root;
6794 my $next_elt;
6795
6796 MAIN: while( 1)
6797 { if( $next_elt= $elt->{first_child})
6798 { # simplest case: the elt has a child
6799 }
6800 elsif( $next_elt= $elt->{next_sibling})
6801 { # no child but a next sibling (just check we stay within the subtree)
6802
6803 # case where elt is subtree_root, is empty and has a sibling
6804 last MAIN if( $elt == $subtree_root);
6805 }
6806 else
6807 { # case where the element has no child and no next sibling:
6808 # get the first next sibling of an ancestor, checking subtree_root
6809
6810 # case where elt is subtree_root, is empty and has no sibling
6811 last MAIN if( $elt == $subtree_root);
6812
6813 # backtrack until we find a parent with a next sibling
6814 $next_elt= $elt->{parent} || last;
6815 until( $next_elt->{next_sibling})
6816 { last MAIN if( $subtree_root == $next_elt);
6817 $next_elt= $next_elt->{parent} || last MAIN;
6818 }
6819 last MAIN if( $subtree_root == $next_elt);
6820 $next_elt= $next_elt->{next_sibling};
6821 }
6822 $elt= $next_elt || last MAIN;
6823 push @descendants, $elt;
6824 }
6825 return @descendants;
6826 }
6827
6828
6829sub descendants
6830165µs
# spent 870µs (618+252) within XML::Twig::Elt::descendants which was called 16 times, avg 54µs/call: # 16 times (618µs+252µs) by XML::Twig::descendants at line 3762, avg 54µs/call
{ my( $subtree_root, $cond)= @_;
6831165µs my @descendants=();
6832162µs my $elt= $subtree_root;
6833
6834 # this branch is pure optimization for speed: if $cond is a gi replace it
6835 # by the index of the gi and loop here
6836 # start optimization
6837162µs my $ind;
68381611µs if( !$cond || ( defined ( $ind= $XML::Twig::gi2index{$cond})) )
6839 {
684015900ns my $next_elt;
6841
6842152µs while( 1)
6843737153µs { if( $next_elt= $elt->{first_child})
6844 { # simplest case: the elt has a child
6845 }
6846 elsif( $next_elt= $elt->{next_sibling})
6847 { # no child but a next sibling (just check we stay within the subtree)
6848
6849 # case where elt is subtree_root, is empty and has a sibling
685030135µs last if( $subtree_root && ($elt == $subtree_root));
6851 }
6852 else
6853 { # case where the element has no child and no next sibling:
6854 # get the first next sibling of an ancestor, checking subtree_root
6855
6856 # case where elt is subtree_root, is empty and has no sibling
685716625µs last if( $subtree_root && ($elt == $subtree_root));
6858
6859 # backtrack until we find a parent with a next sibling
686016621µs $next_elt= $elt->{parent} || last undef;
686116627µs until( $next_elt->{next_sibling})
686211915µs { last if( $subtree_root && ($subtree_root == $next_elt));
686310424µs $next_elt= $next_elt->{parent} || last;
6864 }
686516620µs last if( $subtree_root && ($subtree_root == $next_elt));
686615116µs $next_elt= $next_elt->{next_sibling};
6867 }
686872246µs $elt= $next_elt || last;
6869722191µs push @descendants, $elt if( !$cond || ($elt->{gi} eq $ind));
6870 }
6871 }
6872 else
6873 { # branch for a complex condition: use the regular (slow but simple) way
6874
687512µs1252µs while( $elt= $elt->next_elt( $subtree_root, $cond))
# spent 252µs making 1 call to XML::Twig::Elt::next_elt
6876 { push @descendants, $elt; }
6877 }
68781622µs return @descendants;
6879 }
6880
6881
6882sub descendants_or_self
6883 { my( $elt, $cond)= @_;
6884 my @descendants= $elt->passes( $cond) ? ($elt) : ();
6885 push @descendants, $elt->descendants( $cond);
6886 return @descendants;
6887 }
6888
6889sub sibling
6890 { my $elt= shift;
6891 my $nb= shift;
6892 if( $nb > 0)
6893 { foreach( 1..$nb)
6894 { $elt= $elt->next_sibling( @_) or return undef; }
6895 }
6896 elsif( $nb < 0)
6897 { foreach( 1..(-$nb))
6898 { $elt= $elt->prev_sibling( @_) or return undef; }
6899 }
6900 else # $nb == 0
6901 { return $elt->passes( $_[0]); }
6902 return $elt;
6903 }
6904
6905sub sibling_text
6906 { my $elt= sibling( @_);
6907 return $elt ? $elt->text : undef;
6908 }
6909
6910
6911sub child
6912 { my $elt= shift;
6913 my $nb= shift;
6914 if( $nb >= 0)
6915 { $elt= $elt->first_child( @_) or return undef;
6916 foreach( 1..$nb)
6917 { $elt= $elt->next_sibling( @_) or return undef; }
6918 }
6919 else
6920 { $elt= $elt->last_child( @_) or return undef;
6921 foreach( 2..(-$nb))
6922 { $elt= $elt->prev_sibling( @_) or return undef; }
6923 }
6924 return $elt;
6925 }
6926
6927sub prev_siblings
6928 { my $elt= shift;
6929 my @siblings=();
6930 while( $elt= $elt->prev_sibling( @_))
6931 { unshift @siblings, $elt; }
6932 return @siblings;
6933 }
6934
6935sub siblings
6936 { my $elt= shift;
6937 return grep { $_ ne $elt } $elt->{parent}->children( @_);
6938 }
6939
6940sub pos
6941 { my $elt= shift;
6942 return 0 if ($_[0] && !$elt->matches( @_));
6943 my $pos=1;
6944 $pos++ while( $elt= $elt->prev_sibling( @_));
6945 return $pos;
6946 }
6947
6948
6949sub next_siblings
6950 { my $elt= shift;
6951 my @siblings=();
6952 while( $elt= $elt->next_sibling( @_))
6953 { push @siblings, $elt; }
6954 return @siblings;
6955 }
6956
6957
6958# used by get_xpath: parses the xpath expression and generates a sub that performs the
6959# search
69601100ns{ my %axis2method;
696119µs
# spent 6µs within XML::Twig::Elt::BEGIN@6961 which was called: # once (6µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 6973
BEGIN { %axis2method= ( child => 'children',
6962 descendant => 'descendants',
6963 'descendant-or-self' => 'descendants_or_self',
6964 parent => 'parent_is',
6965 ancestor => 'ancestors',
6966 'ancestor-or-self' => 'ancestors_or_self',
6967 'following-sibling' => 'next_siblings',
6968 'preceding-sibling' => 'prev_siblings',
6969 following => 'following_elts',
6970 preceding => 'preceding_elts',
6971 self => '_self',
6972 );
697312.60ms16µs }
# spent 6µs making 1 call to XML::Twig::Elt::BEGIN@6961
6974
6975 sub _install_xpath
6976154µs
# spent 3.48ms (1.98+1.50) within XML::Twig::Elt::_install_xpath which was called 15 times, avg 232µs/call: # 15 times (1.98ms+1.50ms) by XML::Twig::Elt::get_xpath at line 7140, avg 232µs/call
{ my( $xpath_exp, $type)= @_;
6977153µs my $original_exp= $xpath_exp;
6978153µs my $sub= 'my $elt= shift; my @results;';
6979
6980 # grab the root if expression starts with a /
69811541µs1520µs if( $xpath_exp=~ s{^/}{})
# spent 20µs making 15 calls to CORE::subst, avg 1µs/call
6982 { $sub .= '@results= ($elt->twig) || croak "cannot use an XPath query starting with a / on a node not attached to a whole twig";'; }
6983 elsif( $xpath_exp=~ s{^\./}{})
6984 { $sub .= '@results= ($elt);'; }
6985 else
6986 { $sub .= '@results= ($elt);'; }
6987
6988
6989 #warn "xpath_exp= '$xpath_exp'\n";
6990
699115660µs16633µs while( $xpath_exp &&
# spent 509µs making 1 call to CORE::regcomp # spent 124µs making 15 calls to CORE::subst, avg 8µs/call
6992 $xpath_exp=~s{^\s*(/?)
6993 # the xxx=~/regexp/ is a pain as it includes /
6994 (\s*(?:(?:($REG_AXIS)::)?(\*|$REG_TAG_PART|\.\.|\.)\s*)?($REG_PREDICATE_ALT*)
6995 )
6996 (/|$)}{}xo)
6997
69982435µs { my( $wildcard, $sub_exp, $axis, $gi, $predicates)= ($1, $2, $3, $4, $5);
6999243µs if( $axis && ! $gi)
7000 { _croak_and_doublecheck_xpath( $original_exp, "error in xpath expression $original_exp"); }
7001
7002 # grab a parent
70032465µs3325µs if( $sub_exp eq '..')
# spent 18µs making 9 calls to CORE::subst, avg 2µs/call # spent 7µs making 24 calls to CORE::match, avg 279ns/call
7004 { _croak_and_doublecheck_xpath( $original_exp, "error in xpath expression $original_exp") if( $wildcard);
7005 $sub .= '@results= map { $_->{parent}} @results;';
7006 }
7007 # test the element itself
7008 elsif( $sub_exp=~ m{^\.(.*)$}s)
7009 { $sub .= "\@results= grep { \$_->matches( q{$1}) } \@results;" }
7010 # grab children
7011 else
7012 {
7013247µs if( !$axis)
7014 { $axis= $wildcard ? 'descendant' : 'child'; }
7015246µs if( !$gi or $gi eq '*') { $gi=''; }
7016242µs my $function;
7017
7018 # "special" predicates, that return just one element
70192424µs109µs if( $predicates && ($predicates =~ m{^\s*\[\s*((-\s*)?\d+)\s*\]\s*$}))
# spent 9µs making 10 calls to CORE::match, avg 890ns/call
7020 { # [<nb>]
7021 my $offset= $1;
7022 $offset-- if( $offset > 0);
7023 $function= $axis eq 'descendant' ? "next_n_elt( $offset, '$gi')"
7024 : $axis eq 'child' ? "child( $offset, '$gi')"
7025 : _croak_and_doublecheck_xpath( $original_exp, "error [$1] not supported along axis '$axis'")
7026 ;
7027 $sub .= "\@results= grep { \$_ } map { \$_->$function } \@results;"
7028 }
7029 elsif( $predicates && ($predicates =~ m{^\s*\[\s*last\s*\(\s*\)\s*\]\s*$}) )
7030 { # last()
7031 _croak_and_doublecheck_xpath( $original_exp, "error in xpath expression $original_exp, usage of // and last() not supported") if( $wildcard);
7032 $sub .= "\@results= map { \$_->last_child( '$gi') } \@results;";
7033 }
7034 else
7035 { # follow the axis
7036 #warn "axis: '$axis' - method: '$axis2method{$axis}' - gi: '$gi'\n";
7037
70382413µs my $follow_axis= " \$_->$axis2method{$axis}( '$gi')";
7039243µs my $step= $follow_axis;
7040
7041 # now filter using the predicate
704224212µs25186µs while( $predicates=~ s{^\s*($REG_PREDICATE_ALT)\s*}{}o)
# spent 165µs making 1 call to CORE::regcomp # spent 21µs making 24 calls to CORE::subst, avg 871ns/call
704353µs { my $pred= $1;
704458µs54µs $pred=~ s{^\s*\[\s*}{};
# spent 4µs making 5 calls to CORE::subst, avg 840ns/call
7045515µs511µs $pred=~ s{\s*\]\s*$}{};
# spent 11µs making 5 calls to CORE::subst, avg 2µs/call
704651µs my $test="";
70475500ns my $pos;
7048514µs104µs if( $pred=~ m{^(-?\s*\d+)$})
# spent 3µs making 5 calls to CORE::match, avg 660ns/call # spent 600ns making 5 calls to CORE::subst, avg 120ns/call
7049 { my $pos= $1;
7050 if( $step=~ m{^\s*grep(.*) (\$_->\w+\(\s*'[^']*'\s*\))})
7051 { $step= "XML::Twig::_first_n $1 $pos, $2"; }
7052 else
7053 { if( $pos > 0) { $pos--; }
7054 $step= "($step)[$pos]";
7055 }
7056 #warn "number predicate '$pos' - generated step '$step'\n";
7057 }
7058 else
705951µs { my $syntax_error=0;
7060 do
70611068µs1252µs { if( $pred =~ s{^string\(\s*\)\s*=\s*($REG_STRING)\s*}{}o) # string()="string" pred
# spent 50µs making 2 calls to CORE::regcomp, avg 25µs/call # spent 1µs making 10 calls to CORE::subst, avg 140ns/call
7062 { $test .= "\$_->text eq $1"; }
7063 elsif( $pred =~ s{^string\(\s*\)\s*!=\s*($REG_STRING)\s*}{}o) # string()!="string" pred
7064 { $test .= "\$_->text ne $1"; }
70655288µs35261µs if( $pred =~ s{^string\(\s*\)\s*=\s*($REG_NUMBER)\s*}{}o) # string()=<number> pred
# spent 236µs making 5 calls to CORE::regcomp, avg 47µs/call # spent 25µs making 30 calls to CORE::subst, avg 820ns/call
7066 { $test .= "\$_->text eq $1"; }
7067 elsif( $pred =~ s{^string\(\s*\)\s*!=\s*($REG_NUMBER)\s*}{}o) # string()!=<number> pred
7068 { $test .= "\$_->text ne $1"; }
7069 elsif( $pred =~ s{^string\(\s*\)\s*(>|<|>=|<=)\s*($REG_NUMBER)\s*}{}o) # string()!=<number> pred
7070 { $test .= "\$_->text $1 $2"; }
7071
7072 elsif( $pred =~ s{^string\(\s*\)\s*($REG_MATCH)\s*($REG_REGEXP)\s*}{}o) # string()=~/regex/ pred
7073 { my( $match, $regexp)= ($1, $2);
7074 $test .= "\$_->text $match $regexp";
7075 }
7076 elsif( $pred =~ s{^string\(\s*\)\s*}{}o) # string() pred
7077 { $test .= "\$_->text"; }
7078 elsif( $pred=~ s{^@($REG_TAG_NAME)\s*($REG_OP)\s*($REG_STRING|$REG_NUMBER)}{}o) # @att="val" pred
707959µs510µs { my( $att, $oper, $val)= ($1, _op( $2), $3);
# spent 10µs making 5 calls to XML::Twig::Elt::_op, avg 2µs/call
708054µs $test .= qq{((defined \$_->{'att'}->{"$att"}) && (\$_->{'att'}->{"$att"} $oper $val))};
7081 }
7082 elsif( $pred =~ s{^@($REG_TAG_NAME)\s*($REG_MATCH)\s*($REG_REGEXP)\s*}{}o) # @att=~/regex/ pred XXX
7083 { my( $att, $match, $regexp)= ($1, $2, $3);
7084 $test .= qq{((defined \$_->{'att'}->{"$att"}) && (\$_->{'att'}->{"$att"} $match $regexp))};;
7085 }
7086 elsif( $pred=~ s{^@($REG_TAG_NAME)\s*}{}o) # @att pred
7087 { $test .= qq{(defined \$_->{'att'}->{"$1"})}; }
7088 elsif( $pred=~ s{^\s*(?:not|!)\s*@($REG_TAG_NAME)\s*}{}o) # not @att pred
7089 { $test .= qq{((\$_->is_elt) && (not defined \$_->{'att'}->{"$1"}))}; }
7090 elsif( $pred=~ s{^\s*([()])}{}) # ( or ) (just add to the test)
7091 { $test .= qq{$1}; }
7092 elsif( $pred=~ s{^\s*(and|or)\s*}{})
7093 { $test .= lc " $1 "; }
7094 else
7095 { $syntax_error=1; }
7096
7097 } while( !$syntax_error && $pred);
70985600ns _croak_and_doublecheck_xpath( $original_exp, "error in xpath expression $original_exp at $pred") if( $pred);
709952µs $step= " grep { $test } $step ";
7100 }
7101 }
7102 #warn "step: '$step'";
7103246µs $sub .= "\@results= grep defined, map { $step } \@results;";
7104 }
7105 }
7106 }
7107
7108152µs if( $xpath_exp)
7109 { _croak_and_doublecheck_xpath( $original_exp, "error in xpath expression $original_exp around $xpath_exp"); }
7110
7111152µs $sub .= q{return XML::Twig::_unique_elts( @results); };
7112 #warn "generated: '$sub'\n";
711315467µs my $s= eval "sub { $NO_WARNINGS; $sub }";
# spent 118µs executing statements in string eval
# includes 20µs spent executing 2 calls to 2 subs defined therein. # spent 109µs executing statements in string eval
# includes 28µs spent executing 3 calls to 2 subs defined therein. # spent 109µs executing statements in string eval
# includes 31µs spent executing 2 calls to 2 subs defined therein. # spent 103µs executing statements in string eval
# includes 18µs spent executing 2 calls to 2 subs defined therein. # spent 102µs executing statements in string eval
# includes 18µs spent executing 2 calls to 2 subs defined therein. # spent 99µs executing statements in string eval
# includes 30µs spent executing 2 calls to 2 subs defined therein. # spent 96µs executing statements in string eval
# includes 16µs spent executing 2 calls to 2 subs defined therein. # spent 92µs executing statements in string eval
# includes 16µs spent executing 2 calls to 2 subs defined therein. # spent 92µs executing statements in string eval
# includes 16µs spent executing 2 calls to 2 subs defined therein. # spent 92µs executing statements in string eval
# includes 21µs spent executing 2 calls to 2 subs defined therein. # spent 90µs executing statements in string eval
# includes 17µs spent executing 2 calls to 2 subs defined therein. # spent 85µs executing statements in string eval
# includes 17µs spent executing 2 calls to 2 subs defined therein. # spent 82µs executing statements in string eval
# includes 12µs spent executing 2 calls to 2 subs defined therein. # spent 76µs executing statements in string eval
# includes 15µs spent executing 2 calls to 2 subs defined therein. # spent 67µs executing statements in string eval
# includes 13µs spent executing 2 calls to 2 subs defined therein.
7114153µs if( $@)
7115 { _croak_and_doublecheck_xpath( $original_exp, "error in xpath expression $original_exp ($@);") }
71161534µs return( $s);
7117 }
7118}
7119
7120sub _croak_and_doublecheck_xpath
712110s { my $xpath_expression= shift;
7122 my $mess= join( "\n", @_);
7123 if( $XML::Twig::XPath::VERSION || 0)
7124 { my $check_twig= XML::Twig::XPath->new;
7125 if( eval { $check_twig->{twig_xp}->_parse( $xpath_expression) })
7126 { $mess .= "\nthe expression is a valid XPath statement, and you are using XML::Twig::XPath, but"
7127 . "\nyou are using either 'find_nodes' or 'get_xpath' where the method you likely wanted"
7128 . "\nto use is 'findnodes', which is the only one that uses the full XPath engine\n";
7129 }
7130 }
7131 croak $mess;
7132 }
7133
7134
7135
7136{ # extremely elaborate caching mechanism
71371100ns my %xpath; # xpath_expression => subroutine_code;
7138 sub get_xpath
7139166µs
# spent 12.3ms (86µs+12.2) within XML::Twig::Elt::get_xpath which was called 16 times, avg 768µs/call: # 16 times (86µs+12.2ms) by XML::Twig::get_xpath at line 3691, avg 768µs/call
{ my( $elt, $xpath_exp, $offset)= @_;
71401622µs153.48ms my $sub= ($xpath{$xpath_exp} ||= _install_xpath( $xpath_exp));
# spent 3.48ms making 15 calls to XML::Twig::Elt::_install_xpath, avg 232µs/call
71411637µs168.72ms return $sub->( $elt) unless( defined $offset);
7142 my @res= $sub->( $elt);
7143 return $res[$offset];
7144 }
7145}
7146
7147
7148sub findvalues
714910s { my $elt= shift;
7150 return map { $_->text } $elt->get_xpath( @_);
7151 }
7152
7153sub findvalue
7154 { my $elt= shift;
7155 return join '', map { $_->text } $elt->get_xpath( @_);
7156 }
7157
7158
7159# XML::XPath compatibility
7160sub getElementById { return $_[0]->twig->elt_id( $_[1]); }
7161sub getChildNodes { my @children= do { my $elt= $_[0]; my @children=(); my $child= $elt->{first_child}; while( $child) { push @children, $child; $child= $child->{next_sibling}; } @children; }; return wantarray ? @children : \@children; }
7162
7163sub _flushed { return $_[0]->{flushed}; }
7164sub _set_flushed { $_[0]->{flushed}=1; }
7165sub _del_flushed { delete $_[0]->{flushed}; }
7166
7167sub cut
7168338133.92ms
# spent 579ms (545+33.7) within XML::Twig::Elt::cut which was called 33813 times, avg 17µs/call: # 33813 times (545ms+33.7ms) by XML::Twig::Elt::delete at line 8087, avg 17µs/call
{ my $elt= shift;
7169338134.01ms my( $parent, $prev_sibling, $next_sibling);
7170338135.57ms $parent= $elt->{parent};
7171338136.20ms626µs if( ! $parent && $elt->is_elt)
# spent 26µs making 6 calls to XML::Twig::Elt::is_elt, avg 4µs/call
7172 { # are we cutting the root?
717362µs my $t= $elt->{twig};
717464µs if( $t && ! $t->{twig_parsing})
717562µs { delete $t->{twig_root};
717662µs delete $elt->{twig};
71776109µs return $elt;
7178 } # cutt`ing the root
7179 else
7180 { return; } # cutting an orphan, returning $elt would break backward compatibility
7181 }
7182
7183 # save the old links, that'll make it easier for some loops
71843380710.1ms foreach my $link ( qw(parent prev_sibling next_sibling) )
718510142153.5ms { $elt->{former}->{$link}= $elt->{$link};
7186101421180ms10142123.0ms if( $XML::Twig::weakrefs) { weaken( $elt->{former}->{$link}); }
# spent 23.0ms making 101421 calls to Scalar::Util::weaken, avg 227ns/call
7187 }
7188
7189 # if we cut the current element then its parent becomes the current elt
7190338075.38ms if( $elt->{twig_current})
7191 { my $twig_current= $elt->{parent};
7192 $elt->twig->{twig_current}= $twig_current;
7193 $twig_current->{'twig_current'}=1;
7194 delete $elt->{'twig_current'};
7195 }
7196
71973380714.3ms if( $parent->{first_child} && $parent->{first_child} == $elt)
7198338077.78ms { $parent->{first_child}= $elt->{next_sibling};
7199 # cutting can make the parent empty
72003380711.3ms if( ! $parent->{first_child}) { $parent->{empty}= 1; }
7201 }
7202
72033380711.5ms if( $parent->{last_child} && $parent->{last_child} == $elt)
720410142189.4ms338073.60ms { delete $parent->{empty}; $parent->{last_child}=$elt->{prev_sibling}; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ;
# spent 3.60ms making 33807 calls to Scalar::Util::weaken, avg 106ns/call
7205 }
7206
7207338076.42ms if( $prev_sibling= $elt->{prev_sibling})
7208 { $prev_sibling->{next_sibling}= $elt->{next_sibling}; }
7209338074.49ms if( $next_sibling= $elt->{next_sibling})
7210 { $next_sibling->{prev_sibling}=$elt->{prev_sibling}; if( $XML::Twig::weakrefs) { weaken( $next_sibling->{prev_sibling});} ; }
7211
7212
72136761469.7ms338073.58ms $elt->{parent}=undef; if( $XML::Twig::weakrefs) { weaken( $elt->{parent});} ;
# spent 3.58ms making 33807 calls to Scalar::Util::weaken, avg 106ns/call
72146761469.7ms338073.52ms $elt->{prev_sibling}=undef; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ;
# spent 3.52ms making 33807 calls to Scalar::Util::weaken, avg 104ns/call
7215338075.88ms $elt->{next_sibling}= undef;
7216
7217 # merge 2 (now) consecutive text nodes if they are of the same type
7218 # (type can be PCDATA or CDATA)
7219338073.82ms if( $prev_sibling && $next_sibling && $prev_sibling->is_text && ( $XML::Twig::index2gi[$prev_sibling->{'gi'}] eq $XML::Twig::index2gi[$next_sibling->{'gi'}]))
7220 { $prev_sibling->merge_text( $next_sibling); }
7221
72223380749.1ms return $elt;
7223 }
7224
7225
7226sub former_next_sibling { return $_[0]->{former}->{next_sibling}; }
7227sub former_prev_sibling { return $_[0]->{former}->{prev_sibling}; }
7228sub former_parent { return $_[0]->{former}->{parent}; }
7229
7230sub cut_children
7231 { my( $elt, $exp)= @_;
7232 my @children= $elt->children( $exp);
7233 foreach (@children) { $_->cut; }
7234 if( ! $elt->has_children) { $elt->{empty}= 1; }
7235 return @children;
7236 }
7237
7238sub cut_descendants
7239 { my( $elt, $exp)= @_;
7240 my @descendants= $elt->descendants( $exp);
7241 foreach ($elt->descendants( $exp)) { $_->cut; }
7242 if( ! $elt->has_children) { $elt->{empty}= 1; }
7243 return @descendants;
7244 }
7245
7246
7247sub erase
7248 { my $elt= shift;
7249 #you cannot erase the current element
7250 if( $elt->{twig_current})
7251 { croak "trying to erase an element before it has been completely parsed"; }
7252 if( my $parent= $elt->{parent})
7253 { # normal case
7254 $elt->_move_extra_data_after_erase;
7255 my @children= do { my $elt= $elt; my @children=(); my $child= $elt->{first_child}; while( $child) { push @children, $child; $child= $child->{next_sibling}; } @children; };
7256 if( @children)
7257 {
7258 # elt has children, move them up
7259
7260 # the first child may need to be merged with a previous text
7261 my $first_child= shift @children;
7262 $first_child->move( before => $elt);
7263 my $prev= $first_child->{prev_sibling};
7264 if( $prev && $prev->is_text && ($XML::Twig::index2gi[$first_child->{'gi'}] eq $XML::Twig::index2gi[$prev->{'gi'}]) )
7265 { $prev->merge_text( $first_child); }
7266
7267 # move the rest of the children
7268 foreach my $child (@children)
7269 { $child->move( before => $elt); }
7270
7271 # now the elt had no child, delete it
7272 $elt->delete;
7273
7274 # now see if we need to merge the last child with the next element
7275 my $last_child= $children[-1] || $first_child; # if no last child, then it's also the first child
7276 my $next= $last_child->{next_sibling};
7277 if( $next && $next->is_text && ($XML::Twig::index2gi[$last_child->{'gi'}] eq $XML::Twig::index2gi[$next->{'gi'}]) )
7278 { $last_child->merge_text( $next); }
7279
7280 # if parsing and have now a PCDATA text, mark so we can normalize later on if need be
7281 if( $parent->{twig_current} && $last_child->is_text) { $parent->{twig_to_be_normalized}=1; }
7282 }
7283 else
7284 { # no children, just cut the elt
7285 $elt->delete;
7286 }
7287 }
7288 else
7289 { # trying to erase the root (of a twig or of a cut/new element)
7290 my @children= do { my $elt= $elt; my @children=(); my $child= $elt->{first_child}; while( $child) { push @children, $child; $child= $child->{next_sibling}; } @children; };
7291 unless( @children == 1)
7292 { croak "can only erase an element with no parent if it has a single child"; }
7293 $elt->_move_extra_data_after_erase;
7294 my $child= shift @children;
7295 $child->{parent}=undef; if( $XML::Twig::weakrefs) { weaken( $child->{parent});} ;
7296 my $twig= $elt->twig;
7297 $twig->set_root( $child);
7298 }
7299
7300 return $elt;
7301
7302 }
7303
7304sub _move_extra_data_after_erase
7305 { my( $elt)= @_;
7306 # extra_data
7307 if( my $extra_data= $elt->{extra_data})
7308 { my $target= $elt->{first_child} || $elt->{next_sibling};
7309 if( $target)
7310 {
7311 if( $target->is( $ELT))
7312 { $target->set_extra_data( $extra_data . ($target->extra_data || '')); }
7313 elsif( $target->is( $TEXT))
7314 { $target->_unshift_extra_data_in_pcdata( $extra_data, 0); } # TO CHECK
7315 }
7316 else
7317 { my $parent= $elt->{parent}; # always exists or the erase cannot be performed
7318 $parent->_prefix_extra_data_before_end_tag( $extra_data);
7319 }
7320 }
7321
7322 # extra_data_before_end_tag
7323 if( my $extra_data= $elt->{extra_data_before_end_tag})
7324 { if( my $target= $elt->{next_sibling})
7325 { if( $target->is( $ELT))
7326 { $target->set_extra_data( $extra_data . ($target->extra_data || '')); }
7327 elsif( $target->is( $TEXT))
7328 {
7329 $target->_unshift_extra_data_in_pcdata( $extra_data, 0);
7330 }
7331 }
7332 elsif( my $parent= $elt->{parent})
7333 { $parent->_prefix_extra_data_before_end_tag( $extra_data); }
7334 }
7335
7336 return $elt;
7337
7338 }
7339BEGIN
734016µs
# spent 4µs within XML::Twig::Elt::BEGIN@7340 which was called: # once (4µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 7498
{ my %method= ( before => \&paste_before,
7341 after => \&paste_after,
7342 first_child => \&paste_first_child,
7343 last_child => \&paste_last_child,
7344 within => \&paste_within,
7345 );
7346
7347 # paste elt somewhere around ref
7348 # pos can be first_child (default), last_child, before, after or within
7349 sub paste ## no critic (Subroutines::ProhibitNestedSubs);
7350 { my $elt= shift;
7351 if( $elt->{parent})
7352 { croak "cannot paste an element that belongs to a tree"; }
7353 my $pos;
7354 my $ref;
7355 if( ref $_[0])
7356 { $pos= 'first_child';
7357 croak "wrong argument order in paste, should be $_[1] first" if($_[1]);
7358 }
7359 else
7360 { $pos= shift; }
7361
7362 if( my $method= $method{$pos})
7363 {
7364 unless( ref( $_[0]) && isa( $_[0], 'XML::Twig::Elt'))
7365 { if( ! defined( $_[0]))
7366 { croak "missing target in paste"; }
7367 elsif( ! ref( $_[0]))
7368 { croak "wrong target type in paste (not a reference), should be XML::Twig::Elt or a subclass"; }
7369 else
7370 { my $ref= ref $_[0];
7371 croak "wrong target type in paste: '$ref', should be XML::Twig::Elt or a subclass";
7372 }
7373 }
7374 $ref= $_[0];
7375 # check here so error message lists the caller file/line
7376 if( !$ref->{parent} && ($pos=~ m{^(before|after)$}) && !(exists $elt->{'target'}) && !(exists $elt->{'comment'}))
7377 { croak "cannot paste $1 root"; }
7378 $elt->$method( @_);
7379 }
7380 else
7381 { croak "tried to paste in wrong position '$pos', allowed positions " .
7382 " are 'first_child', 'last_child', 'before', 'after' and " .
7383 "'within'";
7384 }
7385 if( (my $ids= $elt->{twig_id_list}) && (my $t= $ref->twig) )
7386 { $t->{twig_id_list}||={};
7387 foreach my $id (keys %$ids)
7388 { $t->{twig_id_list}->{$id}= $ids->{$id};
7389 if( $XML::Twig::weakrefs) { weaken( $t->{twig_id_list}->{$id}); }
7390 }
7391 }
7392 return $elt;
7393 }
7394
7395
7396 sub paste_before
7397 { my( $elt, $ref)= @_;
7398 my( $parent, $prev_sibling, $next_sibling );
7399
7400 # trying to paste before an orphan (root or detached wlt)
7401 unless( $ref->{parent})
7402 { if( my $t= $ref->twig)
7403 { if( (exists $elt->{'comment'}) || (exists $elt->{'target'})) # we can still do this
7404 { $t->_add_cpi_outside_of_root( leading_cpi => $elt); return; }
7405 else
7406 { croak "cannot paste before root"; }
7407 }
7408 else
7409 { croak "cannot paste before an orphan element"; }
7410 }
7411 $parent= $ref->{parent};
7412 $prev_sibling= $ref->{prev_sibling};
7413 $next_sibling= $ref;
7414
7415 $elt->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $elt->{parent});} ;
7416 if( $parent->{first_child} == $ref) { $parent->{first_child}= $elt; }
7417
7418 if( $prev_sibling) { $prev_sibling->{next_sibling}= $elt; }
7419 $elt->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ;
7420
7421 $next_sibling->{prev_sibling}=$elt; if( $XML::Twig::weakrefs) { weaken( $next_sibling->{prev_sibling});} ;
7422 $elt->{next_sibling}= $ref;
7423 return $elt;
7424 }
7425
7426 sub paste_after
7427 { my( $elt, $ref)= @_;
7428 my( $parent, $prev_sibling, $next_sibling );
7429
7430 # trying to paste after an orphan (root or detached wlt)
7431 unless( $ref->{parent})
7432 { if( my $t= $ref->twig)
7433 { if( (exists $elt->{'comment'}) || (exists $elt->{'target'})) # we can still do this
7434 { $t->_add_cpi_outside_of_root( trailing_cpi => $elt); return; }
7435 else
7436 { croak "cannot paste after root"; }
7437 }
7438 else
7439 { croak "cannot paste after an orphan element"; }
7440 }
7441 $parent= $ref->{parent};
7442 $prev_sibling= $ref;
7443 $next_sibling= $ref->{next_sibling};
7444
7445 $elt->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $elt->{parent});} ;
7446 if( $parent->{last_child}== $ref) { delete $parent->{empty}; $parent->{last_child}=$elt; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ; }
7447
7448 $prev_sibling->{next_sibling}= $elt;
7449 $elt->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ;
7450
7451 if( $next_sibling) { $next_sibling->{prev_sibling}=$elt; if( $XML::Twig::weakrefs) { weaken( $next_sibling->{prev_sibling});} ; }
7452 $elt->{next_sibling}= $next_sibling;
7453 return $elt;
7454
7455 }
7456
7457 sub paste_first_child
7458 { my( $elt, $ref)= @_;
7459 my( $parent, $prev_sibling, $next_sibling );
7460 $parent= $ref;
7461 $next_sibling= $ref->{first_child};
7462
7463 $elt->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $elt->{parent});} ;
7464 $parent->{first_child}= $elt;
7465 unless( $parent->{last_child}) { delete $parent->{empty}; $parent->{last_child}=$elt; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ; }
7466
7467 $elt->{prev_sibling}=undef; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ;
7468
7469 if( $next_sibling) { $next_sibling->{prev_sibling}=$elt; if( $XML::Twig::weakrefs) { weaken( $next_sibling->{prev_sibling});} ; }
7470 $elt->{next_sibling}= $next_sibling;
7471 return $elt;
7472 }
7473
7474 sub paste_last_child
7475 { my( $elt, $ref)= @_;
7476 my( $parent, $prev_sibling, $next_sibling );
7477 $parent= $ref;
7478 $prev_sibling= $ref->{last_child};
7479
7480 $elt->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $elt->{parent});} ;
7481 delete $parent->{empty}; $parent->{last_child}=$elt; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ;
7482 unless( $parent->{first_child}) { $parent->{first_child}= $elt; }
7483
7484 $elt->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ;
7485 if( $prev_sibling) { $prev_sibling->{next_sibling}= $elt; }
7486
7487 $elt->{next_sibling}= undef;
7488 return $elt;
7489 }
7490
7491 sub paste_within
7492 { my( $elt, $ref, $offset)= @_;
7493 my $text= $ref->is_text ? $ref : $ref->next_elt( $TEXT, $ref);
7494 my $new= $text->split_at( $offset);
7495 $elt->paste_before( $new);
7496 return $elt;
7497 }
749811.74ms14µs }
# spent 4µs making 1 call to XML::Twig::Elt::BEGIN@7340
7499
7500# load an element into a structure similar to XML::Simple's
7501sub simplify
7502 { my $elt= shift;
7503
7504 # normalize option names
7505 my %options= @_;
7506 %options= map { my ($key, $val)= ($_, $options{$_});
7507 $key=~ s{(\w)([A-Z])}{$1_\L$2}g;
7508 $key => $val
7509 } keys %options;
7510
7511 # check options
7512 my @allowed_options= qw( keyattr forcearray noattr content_key
7513 var var_regexp variables var_attr
7514 group_tags forcecontent
7515 normalise_space normalize_space
7516 );
7517 my %allowed_options= map { $_ => 1 } @allowed_options;
7518 foreach my $option (keys %options)
7519 { carp "invalid option $option\n" unless( $allowed_options{$option}); }
7520
7521 $options{normalise_space} ||= $options{normalize_space} || 0;
7522
7523 $options{content_key} ||= 'content';
7524 if( $options{content_key}=~ m{^-})
7525 { # need to remove the - and to activate extra folding
7526 $options{content_key}=~ s{^-}{};
7527 $options{extra_folding}= 1;
7528 }
7529 else
7530 { $options{extra_folding}= 0; }
7531
7532 $options{forcearray} ||=0;
7533 if( isa( $options{forcearray}, 'ARRAY'))
7534 { my %forcearray_tags= map { $_ => 1 } @{$options{forcearray}};
7535 $options{forcearray_tags}= \%forcearray_tags;
7536 $options{forcearray}= 0;
7537 }
7538
7539 $options{keyattr} ||= ['name', 'key', 'id'];
7540 if( ref $options{keyattr} eq 'ARRAY')
7541 { foreach my $keyattr (@{$options{keyattr}})
7542 { my( $prefix, $att)= ($keyattr=~ m{^([+-])?(.*)});
7543 $prefix ||= '';
7544 $options{key_for_all}->{$att}= 1;
7545 $options{remove_key_for_all}->{$att}=1 unless( $prefix eq '+');
7546 $options{prefix_key_for_all}->{$att}=1 if( $prefix eq '-');
7547 }
7548 }
7549 elsif( ref $options{keyattr} eq 'HASH')
7550 { while( my( $elt, $keyattr)= each %{$options{keyattr}})
7551 { my( $prefix, $att)= ($keyattr=~ m{^([+-])?(.*)});
7552 $prefix ||='';
7553 $options{key_for_elt}->{$elt}= $att;
7554 $options{remove_key_for_elt}->{"$elt#$att"}=1 unless( $prefix);
7555 $options{prefix_key_for_elt}->{"$elt#$att"}=1 if( $prefix eq '-');
7556 }
7557 }
7558
7559
7560 $options{var}||= $options{var_attr}; # for compat with XML::Simple
7561 if( $options{var}) { $options{var_values}= {}; }
7562 else { $options{var}=''; }
7563
7564 if( $options{variables})
7565 { $options{var}||= 1;
7566 $options{var_values}= $options{variables};
7567 }
7568
7569 if( $options{var_regexp} and !$options{var})
7570 { warn "var option not used, var_regexp option ignored\n"; }
7571 $options{var_regexp} ||= '\$\{?(\w+)\}?';
7572
7573 $elt->_simplify( \%options);
7574
7575 }
7576
7577sub _simplify
7578 { my( $elt, $options)= @_;
7579
7580 my $data;
7581
7582 my $gi= $XML::Twig::index2gi[$elt->{'gi'}];
7583 my @children= do { my $elt= $elt; my @children=(); my $child= $elt->{first_child}; while( $child) { push @children, $child; $child= $child->{next_sibling}; } @children; };
7584 my %atts= $options->{noattr} || !$elt->{att} ? () : %{$elt->{att}};
7585 my $nb_atts= keys %atts;
7586 my $nb_children= $elt->children_count + $nb_atts;
7587
7588 my %nb_children;
7589 foreach (@children) { $nb_children{$_->tag}++; }
7590 foreach (keys %atts) { $nb_children{$_}++; }
7591
7592 my $arrays; # tag => array where elements are stored
7593
7594
7595 # store children
7596 foreach my $child (@children)
7597 { if( $child->is_text)
7598 { # generate with a content key
7599 my $text= $elt->_text_with_vars( $options);
7600 if( $options->{normalise_space} >= 2) { $text= _normalize_space( $text); }
7601 if( $options->{force_content}
7602 || $nb_atts
7603 || (scalar @children > 1)
7604 )
7605 { $data->{$options->{content_key}}= $text; }
7606 else
7607 { $data= $text; }
7608 }
7609 else
7610 { # element with sub-elements
7611 my $child_gi= $XML::Twig::index2gi[$child->{'gi'}];
7612
7613 my $child_data= $child->_simplify( $options);
7614
7615 # first see if we need to simplify further the child data
7616 # simplify because of grouped tags
7617 if( my $grouped_tag= $options->{group_tags}->{$child_gi})
7618 { # check that the child data is a hash with a single field
7619 unless( (ref( $child_data) eq 'HASH')
7620 && (keys %$child_data == 1)
7621 && defined ( my $grouped_child_data= $child_data->{$grouped_tag})
7622 )
7623 { croak "error in grouped tag $child_gi"; }
7624 else
7625 { $child_data= $grouped_child_data; }
7626 }
7627 # simplify because of extra folding
7628 if( $options->{extra_folding})
7629 { if( (ref( $child_data) eq 'HASH')
7630 && (keys %$child_data == 1)
7631 && defined( my $content= $child_data->{$options->{content_key}})
7632 )
7633 { $child_data= $content; }
7634 }
7635
7636 if( my $keyatt= $child->_key_attr( $options))
7637 { # simplify element with key
7638 my $key= $child->{'att'}->{$keyatt};
7639 if( $options->{normalise_space} >= 1) { $key= _normalize_space( $key); }
7640 $data->{$child_gi}->{$key}= $child_data;
7641 }
7642 elsif( $options->{forcearray}
7643 || $options->{forcearray_tags}->{$child_gi}
7644 || ( $nb_children{$child_gi} > 1)
7645 )
7646 { # simplify element to store in an array
7647 if( defined $child_data && $child_data ne "" )
7648 { $data->{$child_gi} ||= [];
7649 push @{$data->{$child_gi}}, $child_data;
7650 }
7651 else
7652 { $data->{$child_gi}= [{}]; }
7653 }
7654 else
7655 { # simplify element to store as a hash field
7656 $data->{$child_gi}=$child_data;
7657 $data->{$child_gi}= defined $child_data && $child_data ne "" ? $child_data : {};
7658 }
7659 }
7660 }
7661
7662 # store atts
7663 # TODO: deal with att that already have an element by that name
7664 foreach my $att (keys %atts)
7665 { # do not store if the att is a key that needs to be removed
7666 if( $options->{remove_key_for_all}->{$att}
7667 || $options->{remove_key_for_elt}->{"$gi#$att"}
7668 )
7669 { next; }
7670
7671 my $att_text= $options->{var} ? _replace_vars_in_text( $atts{$att}, $options) : $atts{$att} ;
7672 if( $options->{normalise_space} >= 2) { $att_text= _normalize_space( $att_text); }
7673
7674 if( $options->{prefix_key_for_all}->{$att}
7675 || $options->{prefix_key_for_elt}->{"$gi#$att"}
7676 )
7677 { # prefix the att
7678 $data->{"-$att"}= $att_text;
7679 }
7680 else
7681 { # normal case
7682 $data->{$att}= $att_text;
7683 }
7684 }
7685
7686 return $data;
7687 }
7688
7689sub _key_attr
7690 { my( $elt, $options)=@_;
7691 return if( $options->{noattr});
7692 if( $options->{key_for_all})
7693 { foreach my $att ($elt->att_names)
7694 { if( $options->{key_for_all}->{$att})
7695 { return $att; }
7696 }
7697 }
7698 elsif( $options->{key_for_elt})
7699 { if( my $key_for_elt= $options->{key_for_elt}->{$XML::Twig::index2gi[$elt->{'gi'}]} )
7700 { return $key_for_elt if( defined( $elt->{'att'}->{$key_for_elt})); }
7701 }
7702 return;
7703 }
7704
7705sub _text_with_vars
7706 { my( $elt, $options)= @_;
7707 my $text;
7708 if( $options->{var})
7709 { $text= _replace_vars_in_text( $elt->text, $options);
7710 $elt->_store_var( $options);
7711 }
7712 else
7713 { $text= $elt->text; }
7714 return $text;
7715 }
7716
7717
7718sub _normalize_space
7719 { my $text= shift;
7720 $text=~ s{\s+}{ }sg;
7721 $text=~ s{^\s}{};
7722 $text=~ s{\s$}{};
7723 return $text;
7724 }
7725
7726
7727sub att_nb
7728 { return 0 unless( my $atts= $_[0]->{att});
7729 return scalar keys %$atts;
7730 }
7731
7732sub has_no_atts
7733 { return 1 unless( my $atts= $_[0]->{att});
7734 return scalar keys %$atts ? 0 : 1;
7735 }
7736
7737sub _replace_vars_in_text
7738 { my( $text, $options)= @_;
7739
7740 $text=~ s{($options->{var_regexp})}
7741 { if( defined( my $value= $options->{var_values}->{$2}))
7742 { $value }
7743 else
7744 { warn "unknown variable $2\n";
7745 $1
7746 }
7747 }gex;
7748 return $text;
7749 }
7750
7751sub _store_var
7752 { my( $elt, $options)= @_;
7753 if( defined (my $var_name= $elt->{'att'}->{$options->{var}}))
7754 { $options->{var_values}->{$var_name}= $elt->text;
7755 }
7756 }
7757
7758
7759# split a text element at a given offset
7760sub split_at
7761 { my( $elt, $offset)= @_;
7762 my $text_elt= $elt->is_text ? $elt : $elt->first_child( $TEXT) || return '';
7763 my $string= $text_elt->text;
7764 my $left_string= substr( $string, 0, $offset);
7765 my $right_string= substr( $string, $offset);
7766 $text_elt->{pcdata}= (delete $text_elt->{empty} || 1) && $left_string;
7767 my $new_elt= $elt->new( $XML::Twig::index2gi[$elt->{'gi'}], $right_string);
7768 $new_elt->paste( after => $elt);
7769 return $new_elt;
7770 }
7771
7772
7773# split an element or its text descendants into several, in place
7774# all elements (new and untouched) are returned
7775sub split
7776 { my $elt= shift;
7777 my @text_chunks;
7778 my @result;
7779 if( $elt->is_text) { @text_chunks= ($elt); }
7780 else { @text_chunks= $elt->descendants( $TEXT); }
7781 foreach my $text_chunk (@text_chunks)
7782 { push @result, $text_chunk->_split( 1, @_); }
7783 return @result;
7784 }
7785
7786# split an element or its text descendants into several, in place
7787# created elements (those which match the regexp) are returned
7788sub mark
7789 { my $elt= shift;
7790 my @text_chunks;
7791 my @result;
7792 if( $elt->is_text) { @text_chunks= ($elt); }
7793 else { @text_chunks= $elt->descendants( $TEXT); }
7794 foreach my $text_chunk (@text_chunks)
7795 { push @result, $text_chunk->_split( 0, @_); }
7796 return @result;
7797 }
7798
7799# split a single text element
7800# return_all defines what is returned: if it is true
7801# only returns the elements created by matches in the split regexp
7802# otherwise all elements (new and untouched) are returned
7803
7804
7805{
7806
7807 sub _split
7808 { my $elt= shift;
7809 my $return_all= shift;
7810 my $regexp= shift;
7811 my @tags;
7812
7813 while( @_)
7814 { my $tag= shift();
7815 if( ref $_[0])
7816 { push @tags, { tag => $tag, atts => shift }; }
7817 else
7818 { push @tags, { tag => $tag }; }
7819 }
7820
7821 unless( @tags) { @tags= { tag => $elt->{parent}->gi }; }
7822
7823 my @result; # the returned list of elements
7824 my $text= $elt->text;
7825 my $gi= $XML::Twig::index2gi[$elt->{'gi'}];
7826
7827 # 2 uses: if split matches then the first substring reuses $elt
7828 # once a split has occurred then the last match needs to be put in
7829 # a new element
7830 my $previous_match= 0;
7831
7832 while( my( $pre_match, @matches)= $text=~ /^(.*?)$regexp(.*)$/gcs)
7833 { $text= pop @matches;
7834 if( $previous_match)
7835 { # match, not the first one, create a new text ($gi) element
7836 _utf8_ify( $pre_match) if( $] < 5.010);
7837 $elt= $elt->insert_new_elt( after => $gi, $pre_match);
7838 push @result, $elt if( $return_all);
7839 }
7840 else
7841 { # first match in $elt, re-use $elt for the first sub-string
7842 _utf8_ify( $pre_match) if( $] < 5.010);
7843 $elt->set_text( $pre_match);
7844 $previous_match++; # store the fact that there was a match
7845 push @result, $elt if( $return_all);
7846 }
7847
7848 # now deal with matches captured in the regexp
7849 if( @matches)
7850 { # match, with capture
7851 my $i=0;
7852 foreach my $match (@matches)
7853 { # create new element, text is the match
7854 _utf8_ify( $match) if( $] < 5.010);
7855 my $tag = _repl_match( $tags[$i]->{tag}, @matches) || '#PCDATA';
7856 my $atts = \%{$tags[$i]->{atts}} || {};
7857 my %atts= map { _repl_match( $_, @matches) => _repl_match( $atts->{$_}, @matches) } keys %$atts;
7858 $elt= $elt->insert_new_elt( after => $tag, \%atts, $match);
7859 push @result, $elt;
7860 $i= ($i + 1) % @tags;
7861 }
7862 }
7863 else
7864 { # match, no captures
7865 my $tag = $tags[0]->{tag};
7866 my $atts = \%{$tags[0]->{atts}} || {};
7867 $elt= $elt->insert_new_elt( after => $tag, $atts);
7868 push @result, $elt;
7869 }
7870 }
7871 if( $previous_match && $text)
7872 { # there was at least 1 match, and there is text left after the match
7873 $elt= $elt->insert_new_elt( after => $gi, $text);
7874 }
7875
7876 push @result, $elt if( $return_all);
7877
7878 return @result; # return all elements
7879 }
7880
7881sub _repl_match
7882 { my( $val, @matches)= @_;
7883 $val=~ s{\$(\d+)}{$matches[$1-1]}g;
7884 return $val;
7885 }
7886
7887 # evil hack needed as sometimes
78881200ns my $encode_is_loaded=0; # so we only load Encode once
7889 sub _utf8_ify
7890 {
7891 if( $perl_version >= 5.008 and $perl_version < 5.010 and !_keep_encoding())
7892 { unless( $encode_is_loaded) { require Encode; import Encode; $encode_is_loaded++; }
7893 Encode::_utf8_on( $_[0]); # the flag should be set but is not
7894 }
7895 }
7896
7897
7898}
7899
79002200ns{ my %replace_sub; # cache for complex expressions (expression => sub)
7901
7902 sub subs_text
7903 { my( $elt, $regexp, $replace)= @_;
7904
7905 my $replacement_string;
7906 my $is_string= _is_string( $replace);
7907
7908 my @parents;
7909
7910 foreach my $text_elt ($elt->descendants_or_self( $TEXT))
7911 {
7912 if( $is_string)
7913 { my $text= $text_elt->text;
7914 $text=~ s{$regexp}{ _replace_var( $replace, $1, $2, $3, $4, $5, $6, $7, $8, $9)}egx;
7915 $text_elt->set_text( $text);
7916 }
7917 else
7918 {
79192995µs210µs
# spent 9µs (7+2) within XML::Twig::Elt::BEGIN@7919 which was called: # once (7µs+2µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 7919
no utf8; # = perl 5.6
# spent 9µs making 1 call to XML::Twig::Elt::BEGIN@7919 # spent 2µs making 1 call to utf8::unimport
7920 my $replace_sub= ( $replace_sub{$replace} ||= _install_replace_sub( $replace));
7921 my $text= $text_elt->text;
7922 my $pos=0; # used to skip text that was previously matched
7923 my $found_hit;
7924 while( my( $pre_match_string, $match_string, @var)= ($text=~ m{(.*?)($regexp)}sg))
7925 { $found_hit=1;
7926 my $match_start = length( $pre_match_string);
7927 my $match = $match_start ? $text_elt->split_at( $match_start + $pos) : $text_elt;
7928 my $match_length = length( $match_string);
7929 my $post_match = $match->split_at( $match_length);
7930 $replace_sub->( $match, @var);
7931
7932 # go to next
7933 $text_elt= $post_match;
7934 $text= $post_match->text;
7935
7936 if( $found_hit) { push @parents, $text_elt->{parent} unless $parents[-1] && $parents[-1]== $text_elt->{parent}; }
7937
7938 }
7939 }
7940 }
7941
7942 foreach my $parent (@parents) { $parent->normalize; }
7943
7944 return $elt;
7945 }
7946
7947
7948 sub _is_string
7949 { return ($_[0]=~ m{&e[ln]t}) ? 0: 1 }
7950
7951 sub _replace_var
7952 { my( $string, @var)= @_;
7953 unshift @var, undef;
7954 $string=~ s{\$(\d)}{$var[$1]}g;
7955 return $string;
7956 }
7957
7958 sub _install_replace_sub
7959 { my $replace_exp= shift;
7960 my @item= split m{(&e[ln]t\s*\([^)]*\))}, $replace_exp;
7961 my $sub= q{ my( $match, @var)= @_; my $new; my $last_inserted=$match;};
7962 my( $gi, $exp);
7963 foreach my $item (@item)
7964 { next if ! length $item;
7965 if( $item=~ m{^&elt\s*\(([^)]*)\)})
7966 { $exp= $1; }
7967 elsif( $item=~ m{^&ent\s*\(\s*([^\s)]*)\s*\)})
7968 { $exp= " '#ENT' => $1"; }
7969 else
7970 { $exp= qq{ '#PCDATA' => "$item"}; }
7971 $exp=~ s{\$(\d)}{my $i= $1-1; "\$var[$i]"}eg; # replace references to matches
7972 $sub.= qq{ \$new= \$match->new( $exp); };
7973 $sub .= q{ $new->paste( after => $last_inserted); $last_inserted=$new;};
7974 }
7975 $sub .= q{ $match->delete; };
7976 #$sub=~ s/;/;\n/g; warn "subs: $sub";
7977 my $coderef= eval "sub { $NO_WARNINGS; $sub }";
7978 if( $@) { croak( "invalid replacement expression $replace_exp: ",$@); }
7979 return $coderef;
7980 }
7981
7982 }
7983
7984
7985sub merge_text
79861100ns { my( $e1, $e2)= @_;
7987 croak "invalid merge: can only merge 2 elements"
7988 unless( isa( $e2, 'XML::Twig::Elt'));
7989 croak "invalid merge: can only merge 2 text elements"
7990 unless( $e1->is_text && $e2->is_text && ($e1->gi eq $e2->gi));
7991
7992 my $t1_length= length( $e1->text);
7993
7994 $e1->set_text( $e1->text . $e2->text);
7995
7996 if( my $extra_data_in_pcdata= $e2->_extra_data_in_pcdata)
7997 { foreach my $data (@$extra_data_in_pcdata) { $e1->_push_extra_data_in_pcdata( $data->{text}, $data->{offset} + $t1_length); } }
7998
7999 $e2->delete;
8000
8001 return $e1;
8002 }
8003
8004sub merge
8005 { my( $e1, $e2)= @_;
8006 my @e2_children= $e2->_children;
8007 if( $e1->_last_child && $e1->_last_child->is_pcdata
8008 && @e2_children && $e2_children[0]->is_pcdata
8009 )
8010 { my $t1_length= length( $e1->_last_child->{pcdata});
8011 my $child1= $e1->_last_child;
8012 my $child2= shift @e2_children;
8013 $child1->{pcdata} .= $child2->{pcdata};
8014
8015 my $extra_data= $e1->_extra_data_before_end_tag . $e2->extra_data;
8016
8017 if( $extra_data)
8018 { $e1->_del_extra_data_before_end_tag;
8019 $child1->_push_extra_data_in_pcdata( $extra_data, $t1_length);
8020 }
8021
8022 if( my $extra_data_in_pcdata= $child2->_extra_data_in_pcdata)
8023 { foreach my $data (@$extra_data_in_pcdata) { $child1->_push_extra_data_in_pcdata( $data->{text}, $data->{offset} + $t1_length); } }
8024
8025 if( my $extra_data_before_end_tag= $e2->_extra_data_before_end_tag)
8026 { $e1->_set_extra_data_before_end_tag( $extra_data_before_end_tag); }
8027 }
8028
8029 foreach my $e (@e2_children) { $e->move( last_child => $e1); }
8030
8031 $e2->delete;
8032 return $e1;
8033 }
8034
8035
8036# recursively copy an element and returns the copy (can be huge and long)
8037sub copy
8038 { my $elt= shift;
8039 my $copy= $elt->new( $XML::Twig::index2gi[$elt->{'gi'}]);
8040
8041 if( $elt->extra_data) { $copy->set_extra_data( $elt->extra_data); }
8042 if( $elt->{extra_data_before_end_tag}) { $copy->_set_extra_data_before_end_tag( $elt->{extra_data_before_end_tag}); }
8043
8044 if( $elt->is_asis) { $copy->set_asis; }
8045
8046 if( (exists $elt->{'pcdata'}))
8047 { $copy->{pcdata}= (delete $copy->{empty} || 1) && $elt->{pcdata};
8048 if( $elt->{extra_data_in_pcdata}) { $copy->_set_extra_data_in_pcdata( $elt->{extra_data_in_pcdata}); }
8049 }
8050 elsif( (exists $elt->{'cdata'}))
8051 { $copy->{cdata}= $elt->{cdata};
8052 if( $elt->{extra_data_in_pcdata}) { $copy->_set_extra_data_in_pcdata( $elt->{extra_data_in_pcdata}); }
8053 }
8054 elsif( (exists $elt->{'target'}))
8055 { $copy->_set_pi( $elt->{target}, $elt->{data}); }
8056 elsif( (exists $elt->{'comment'}))
8057 { $copy->{comment}= $elt->{comment}; }
8058 elsif( (exists $elt->{'ent'}))
8059 { $copy->{ent}= $elt->{ent}; }
8060 else
8061 { my @children= do { my $elt= $elt; my @children=(); my $child= $elt->{first_child}; while( $child) { push @children, $child; $child= $child->{next_sibling}; } @children; };
8062 if( my $atts= $elt->{att})
8063 { my %atts;
8064 tie %atts, 'Tie::IxHash' if (keep_atts_order());
8065 %atts= %{$atts}; # we want to do a real copy of the attributes
8066 $copy->set_atts( \%atts);
8067 }
8068 foreach my $child (@children)
8069 { my $child_copy= $child->copy;
8070 $child_copy->paste( 'last_child', $copy);
8071 }
8072 }
8073 # save links to the original location, which can be convenient and is used for namespace resolution
8074 foreach my $link ( qw(parent prev_sibling next_sibling) )
8075 { $copy->{former}->{$link}= $elt->{$link};
8076 if( $XML::Twig::weakrefs) { weaken( $copy->{former}->{$link}); }
8077 }
8078
8079 $copy->{empty}= $elt->{'empty'};
8080
8081 return $copy;
8082 }
8083
8084
8085sub delete
8086338134.26ms
# spent 653ms (74.1+579) within XML::Twig::Elt::delete which was called 33813 times, avg 19µs/call: # 33807 times (73.7ms+579ms) by XML::Twig::purge at line 3553, avg 19µs/call # 6 times (401µs+55µs) by XML::Twig::DESTROY at line 3963, avg 76µs/call
{ my $elt= shift;
80873381318.7ms33813579ms $elt->cut;
# spent 579ms making 33813 calls to XML::Twig::Elt::cut, avg 17µs/call
8088338134.01ms $elt->DESTROY unless $XML::Twig::weakrefs;
80893381362.4ms return undef;
8090 }
8091
8092sub __destroy
8093 { my $elt= shift;
8094 return if( $XML::Twig::weakrefs);
8095 my $t= shift || $elt->twig; # optional argument, passed in recursive calls
8096
8097 foreach( @{[$elt->_children]}) { $_->DESTROY( $t); }
8098
8099 # the id reference needs to be destroyed
8100 # lots of tests to avoid warnings during the cleanup phase
8101 $elt->del_id( $t) if( $ID && $t && defined( $elt->{att}) && exists( $elt->{att}->{$ID}));
8102 if( $elt->{former}) { foreach (keys %{$elt->{former}}) { delete $elt->{former}->{$_}; } delete $elt->{former}; }
8103 foreach (qw( keys %$elt)) { delete $elt->{$_}; }
8104 undef $elt;
8105 }
8106
8107BEGIN
810817µs
# spent 10µs (9+1) within XML::Twig::Elt::BEGIN@8108 which was called: # once (9µs+1µs) by Spreadsheet::ParseXLSX::BEGIN@15 at line 8110 # spent 1µs within XML::Twig::Elt::set_destroy which was called: # once (1µs+0s) by XML::Twig::Elt::BEGIN@8108 at line 8109
{ sub set_destroy { if( $XML::Twig::weakrefs) { undef *DESTROY } else { *DESTROY= *__destroy; } }
810912µs11µs set_destroy();
# spent 1µs making 1 call to XML::Twig::Elt::set_destroy
811011.15ms110µs}
# spent 10µs making 1 call to XML::Twig::Elt::BEGIN@8108
8111
8112# ignores the element
8113sub ignore
8114 { my $elt= shift;
8115 my $t= $elt->twig;
8116 $t->ignore( $elt, @_);
8117 }
8118
8119
# spent 16µs within XML::Twig::Elt::BEGIN@8119 which was called: # once (16µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 9065
BEGIN {
81201200ns my $pretty = 0;
81211200ns my $quote = '"';
81221100ns my $INDENT = ' ';
81231100ns my $empty_tag_style = 0;
812410s my $remove_cdata = 0;
812510s my $keep_encoding = 0;
812610s my $expand_external_entities = 0;
812710s my $keep_atts_order = 0;
812810s my $do_not_escape_amp_in_atts = 0;
81291100ns my $WRAP = '80';
81301100ns my $REPLACED_ENTS = qq{&<};
8131
81321800ns my ($NSGMLS, $NICE, $INDENTED, $INDENTEDCT, $INDENTEDC, $WRAPPED, $RECORD1, $RECORD2, $INDENTEDA)= (1..9);
813313µs my %KEEP_TEXT_TAG_ON_ONE_LINE= map { $_ => 1 } ( $INDENTED, $INDENTEDCT, $INDENTEDC, $INDENTEDA, $WRAPPED);
813411µs my %WRAPPED = map { $_ => 1 } ( $WRAPPED, $INDENTEDA, $INDENTEDC);
8135
813614µs my %pretty_print_style=
8137 ( none => 0, # no added \n
8138 nsgmls => $NSGMLS, # nsgmls-style, \n in tags
8139 # below this line styles are UNSAFE (the generated XML can be well-formed but invalid)
8140 nice => $NICE, # \n after open/close tags except when the
8141 # element starts with text
8142 indented => $INDENTED, # nice plus idented
8143 indented_close_tag => $INDENTEDCT, # nice plus idented
8144 indented_c => $INDENTEDC, # slightly more compact than indented (closing
8145 # tags are on the same line)
8146 wrapped => $WRAPPED, # text is wrapped at column
8147 record_c => $RECORD1, # for record-like data (compact)
8148 record => $RECORD2, # for record-like data (not so compact)
8149 indented_a => $INDENTEDA, # nice, indented, and with attributes on separate
8150 # lines as the nsgmls style, as well as wrapped
8151 # lines - to make the xml friendly to line-oriented tools
8152 cvs => $INDENTEDA, # alias for indented_a
8153 );
8154
81551300ns my ($HTML, $EXPAND)= (1..2);
81561800ns my %empty_tag_style=
8157 ( normal => 0, # <tag/>
8158 html => $HTML, # <tag />
8159 xhtml => $HTML, # <tag />
8160 expand => $EXPAND, # <tag></tag>
8161 );
8162
81631600ns my %quote_style=
8164 ( double => '"',
8165 single => "'",
8166 # smart => "smart",
8167 );
8168
81691100ns my $xml_space_preserve; # set when an element includes xml:space="preserve"
8170
8171 my $output_filter; # filters the entire output (including < and >)
8172 my $output_text_filter; # filters only the text part (tag names, attributes, pcdata)
8173
81741100ns my $replaced_ents= $REPLACED_ENTS;
8175
8176
8177 # returns those pesky "global" variables so you can switch between twigs
8178 sub global_state ## no critic (Subroutines::ProhibitNestedSubs);
8179 { return
8180 { pretty => $pretty,
8181 quote => $quote,
8182 indent => $INDENT,
8183 empty_tag_style => $empty_tag_style,
8184 remove_cdata => $remove_cdata,
8185 keep_encoding => $keep_encoding,
8186 expand_external_entities => $expand_external_entities,
8187 output_filter => $output_filter,
8188 output_text_filter => $output_text_filter,
8189 keep_atts_order => $keep_atts_order,
8190 do_not_escape_amp_in_atts => $do_not_escape_amp_in_atts,
8191 wrap => $WRAP,
8192 replaced_ents => $replaced_ents,
8193 };
8194 }
8195
8196 # restores the global variables
8197 sub set_global_state
8198 { my $state= shift;
8199 $pretty = $state->{pretty};
8200 $quote = $state->{quote};
8201 $INDENT = $state->{indent};
8202 $empty_tag_style = $state->{empty_tag_style};
8203 $remove_cdata = $state->{remove_cdata};
8204 $keep_encoding = $state->{keep_encoding};
8205 $expand_external_entities = $state->{expand_external_entities};
8206 $output_filter = $state->{output_filter};
8207 $output_text_filter = $state->{output_text_filter};
8208 $keep_atts_order = $state->{keep_atts_order};
8209 $do_not_escape_amp_in_atts = $state->{do_not_escape_amp_in_atts};
8210 $WRAP = $state->{wrap};
8211 $replaced_ents = $state->{replaced_ents},
8212 }
8213
8214 # sets global state to defaults
8215 sub init_global_state
8216 { set_global_state(
8217 { pretty => 0,
8218 quote => '"',
8219 indent => $INDENT,
8220 empty_tag_style => 0,
8221 remove_cdata => 0,
8222 keep_encoding => 0,
8223 expand_external_entities => 0,
8224 output_filter => undef,
8225 output_text_filter => undef,
8226 keep_atts_order => undef,
8227 do_not_escape_amp_in_atts => 0,
8228 wrap => $WRAP,
8229 replaced_ents => $REPLACED_ENTS,
8230 });
8231 }
8232
8233
8234 # set the pretty_print style (in $pretty) and returns the old one
8235 # can be called from outside the package with 2 arguments (elt, style)
8236 # or from inside with only one argument (style)
8237 # the style can be either a string (one of the keys of %pretty_print_style
8238 # or a number (presumably an old value saved)
8239 sub set_pretty_print
8240 { my $style= lc( defined $_[1] ? $_[1] : $_[0]); # so we cover both cases
8241 my $old_pretty= $pretty;
8242 if( $style=~ /^\d+$/)
8243 { croak "invalid pretty print style $style" unless( $style < keys %pretty_print_style);
8244 $pretty= $style;
8245 }
8246 else
8247 { croak "invalid pretty print style '$style'" unless( exists $pretty_print_style{$style});
8248 $pretty= $pretty_print_style{$style};
8249 }
8250 if( $WRAPPED{$pretty} )
8251 { XML::Twig::_use( 'Text::Wrap') or croak( "Text::Wrap not available, cannot use style $style"); }
8252 return $old_pretty;
8253 }
8254
8255 sub _pretty_print { return $pretty; }
8256
8257 # set the empty tag style (in $empty_tag_style) and returns the old one
8258 # can be called from outside the package with 2 arguments (elt, style)
8259 # or from inside with only one argument (style)
8260 # the style can be either a string (one of the keys of %empty_tag_style
8261 # or a number (presumably an old value saved)
8262 sub set_empty_tag_style
8263 { my $style= lc( defined $_[1] ? $_[1] : $_[0]); # so we cover both cases
8264 my $old_style= $empty_tag_style;
8265 if( $style=~ /^\d+$/)
8266 { croak "invalid empty tag style $style"
8267 unless( $style < keys %empty_tag_style);
8268 $empty_tag_style= $style;
8269 }
8270 else
8271 { croak "invalid empty tag style '$style'"
8272 unless( exists $empty_tag_style{$style});
8273 $empty_tag_style= $empty_tag_style{$style};
8274 }
8275 return $old_style;
8276 }
8277
8278 sub _pretty_print_styles
8279 { return (sort { $pretty_print_style{$a} <=> $pretty_print_style{$b} || $a cmp $b } keys %pretty_print_style); }
8280
8281 sub set_quote
828272µs
# spent 11µs within XML::Twig::Elt::set_quote which was called 7 times, avg 2µs/call: # 7 times (11µs+0s) by XML::Twig::set_quote at line 3922, avg 2µs/call
{ my $style= $_[1] || $_[0];
828371µs my $old_quote= $quote;
828473µs croak "invalid quote '$style'" unless( exists $quote_style{$style});
828572µs $quote= $quote_style{$style};
828677µs return $old_quote;
8287 }
8288
8289 sub set_remove_cdata
829071µs
# spent 5µs within XML::Twig::Elt::set_remove_cdata which was called 7 times, avg 729ns/call: # 7 times (5µs+0s) by XML::Twig::set_remove_cdata at line 3892, avg 729ns/call
{ my $new_value= defined $_[1] ? $_[1] : $_[0];
82917900ns my $old_value= $remove_cdata;
82927400ns $remove_cdata= $new_value;
829377µs return $old_value;
8294 }
8295
8296
8297 sub set_indent
8298 { my $new_value= defined $_[1] ? $_[1] : $_[0];
8299 my $old_value= $INDENT;
8300 $INDENT= $new_value;
8301 return $old_value;
8302 }
8303
8304 sub set_wrap
8305 { my $new_value= defined $_[1] ? $_[1] : $_[0];
8306 my $old_value= $WRAP;
8307 $WRAP= $new_value;
8308 return $old_value;
8309 }
8310
8311
8312 sub set_keep_encoding
831372µs
# spent 8µs within XML::Twig::Elt::set_keep_encoding which was called 7 times, avg 1µs/call: # 7 times (8µs+0s) by XML::Twig::set_keep_encoding at line 3774, avg 1µs/call
{ my $new_value= defined $_[1] ? $_[1] : $_[0];
831471µs my $old_value= $keep_encoding;
831571µs $keep_encoding= $new_value;
831678µs return $old_value;
8317 }
8318
8319 sub set_replaced_ents
8320 { my $new_value= defined $_[1] ? $_[1] : $_[0];
8321 my $old_value= $replaced_ents;
8322 $replaced_ents= $new_value;
8323 return $old_value;
8324 }
8325
8326 sub do_not_escape_gt
8327 { my $old_value= $replaced_ents;
8328 $replaced_ents= q{&<}; # & needs to be first
8329 return $old_value;
8330 }
8331
8332 sub escape_gt
8333 { my $old_value= $replaced_ents;
8334 $replaced_ents= qq{&<>}; # & needs to be first
8335 return $old_value;
8336 }
8337
8338 sub _keep_encoding { return $keep_encoding; } # so I can use elsewhere in the module
8339
8340 sub set_do_not_escape_amp_in_atts
834172µs
# spent 7µs within XML::Twig::Elt::set_do_not_escape_amp_in_atts which was called 7 times, avg 943ns/call: # 7 times (7µs+0s) by XML::Twig::set_do_not_escape_amp_in_atts at line 3934, avg 943ns/call
{ my $new_value= defined $_[1] ? $_[1] : $_[0];
834271µs my $old_value= $do_not_escape_amp_in_atts;
83437400ns $do_not_escape_amp_in_atts= $new_value;
834477µs return $old_value;
8345 }
8346
8347 sub output_filter { return $output_filter; }
8348 sub output_text_filter { return $output_text_filter; }
8349
8350 sub set_output_filter
835171µs
# spent 25µs (21+4) within XML::Twig::Elt::set_output_filter which was called 7 times, avg 4µs/call: # 7 times (21µs+4µs) by XML::Twig::set_output_filter at line 3895, avg 4µs/call
{ my $new_value= defined $_[1] ? $_[1] : $_[0]; # can be called in object/non-object mode
8352 # if called in object mode with no argument, the filter is undefined
8353717µs144µs if( isa( $new_value, 'XML::Twig::Elt') || isa( $new_value, 'XML::Twig')) { undef $new_value; }
# spent 4µs making 14 calls to UNIVERSAL::isa, avg 271ns/call
835471µs my $old_value= $output_filter;
835572µs if( !$new_value || isa( $new_value, 'CODE') )
8356 { $output_filter= $new_value; }
8357 elsif( $new_value eq 'latin1')
8358 { $output_filter= XML::Twig::latin1();
8359 }
8360 elsif( $XML::Twig::filter{$new_value})
8361 { $output_filter= $XML::Twig::filter{$new_value}; }
8362 else
8363 { croak "invalid output filter '$new_value'"; }
8364
836576µs return $old_value;
8366 }
8367
8368 sub set_output_text_filter
836971µs
# spent 20µs (18+1) within XML::Twig::Elt::set_output_text_filter which was called 7 times, avg 3µs/call: # 7 times (18µs+1µs) by XML::Twig::set_output_text_filter at line 3898, avg 3µs/call
{ my $new_value= defined $_[1] ? $_[1] : $_[0]; # can be called in object/non-object mode
8370 # if called in object mode with no argument, the filter is undefined
8371713µs141µs if( isa( $new_value, 'XML::Twig::Elt') || isa( $new_value, 'XML::Twig')) { undef $new_value; }
# spent 1µs making 14 calls to UNIVERSAL::isa, avg 100ns/call
83727700ns my $old_value= $output_text_filter;
837371µs if( !$new_value || isa( $new_value, 'CODE') )
8374 { $output_text_filter= $new_value; }
8375 elsif( $new_value eq 'latin1')
8376 { $output_text_filter= XML::Twig::latin1();
8377 }
8378 elsif( $XML::Twig::filter{$new_value})
8379 { $output_text_filter= $XML::Twig::filter{$new_value}; }
8380 else
8381 { croak "invalid output text filter '$new_value'"; }
8382
838376µs return $old_value;
8384 }
8385
8386 sub set_expand_external_entities
838772µs
# spent 8µs within XML::Twig::Elt::set_expand_external_entities which was called 7 times, avg 1µs/call: # 7 times (8µs+0s) by XML::Twig::set_expand_external_entities at line 3778, avg 1µs/call
{ my $new_value= defined $_[1] ? $_[1] : $_[0];
838871µs my $old_value= $expand_external_entities;
83897900ns $expand_external_entities= $new_value;
839078µs return $old_value;
8391 }
8392
8393 sub set_keep_atts_order
839472µs
# spent 7µs within XML::Twig::Elt::set_keep_atts_order which was called 7 times, avg 971ns/call: # 7 times (7µs+0s) by XML::Twig::set_keep_atts_order at line 3928, avg 971ns/call
{ my $new_value= defined $_[1] ? $_[1] : $_[0];
839571µs my $old_value= $keep_atts_order;
83967600ns $keep_atts_order= $new_value;
839777µs return $old_value;
8398
8399 }
8400
8401364369792ms
# spent 128ms within XML::Twig::Elt::keep_atts_order which was called 364369 times, avg 352ns/call: # 364369 times (128ms+0s) by XML::Twig::Elt::set_atts at line 6138, avg 352ns/call
sub keep_atts_order { return $keep_atts_order; } # so I can use elsewhere in the module
8402
84031300ns my %html_empty_elt;
840412.45ms17µs
# spent 7µs within XML::Twig::Elt::BEGIN@8404 which was called: # once (7µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 8404
BEGIN { %html_empty_elt= map { $_ => 1} qw( base meta link hr br param img area input col); }
# spent 7µs making 1 call to XML::Twig::Elt::BEGIN@8404
8405
8406 sub start_tag
8407 { my( $elt, $option)= @_;
8408
8409
8410 return if( $elt->{gi} < $XML::Twig::SPECIAL_GI);
8411
8412 my $extra_data= $elt->{extra_data} || '';
8413
8414 my $gi= $XML::Twig::index2gi[$elt->{'gi'}];
8415 my $att= $elt->{att}; # should be $elt->{att}, optimized into a pure hash look-up
8416
8417 my $ns_map= $att ? $att->{'#original_gi'} : '';
8418 if( $ns_map) { $gi= _restore_original_prefix( $ns_map, $gi); }
8419 $gi=~ s{^#default:}{}; # remove default prefix
8420
8421 if( $output_text_filter) { $gi= $output_text_filter->( $gi); }
8422
8423 # get the attribute and their values
8424 my $att_sep = $pretty==$NSGMLS ? "\n"
8425 : $pretty==$INDENTEDA ? "\n" . $INDENT x ($elt->level+1) . ' '
8426 : ' '
8427 ;
8428
8429 my $replace_in_att_value= $replaced_ents . "$quote\t\r\n";
8430 if( $option->{escape_gt} && $replaced_ents !~ m{>}) { $replace_in_att_value.= '>'; }
8431
8432 my $tag;
8433 my @att_names= grep { !( $_=~ m{^#(?!default:)} ) } $keep_atts_order ? keys %{$att} : sort keys %{$att};
8434 if( @att_names)
8435 { my $atts= join $att_sep, map { my $output_att_name= $ns_map ? _restore_original_prefix( $ns_map, $_) : $_;
8436 if( $output_text_filter)
8437 { $output_att_name= $output_text_filter->( $output_att_name); }
8438 $output_att_name . '=' . $quote . _att_xml_string( $att->{$_}, $replace_in_att_value) . $quote
8439
8440 }
8441 @att_names
8442 ;
8443 if( $pretty==$INDENTEDA && @att_names == 1) { $att_sep= ' '; }
8444 $tag= "<$gi$att_sep$atts";
8445 }
8446 else
8447 { $tag= "<$gi"; }
8448
8449 $tag .= "\n" if($pretty==$NSGMLS);
8450
8451
8452 # force empty if suitable HTML tag, otherwise use the value from the input tree
8453 if( ($empty_tag_style eq $HTML) && !$elt->{first_child} && !$elt->{extra_data_before_end_tag} && $html_empty_elt{$gi})
8454 { $elt->{empty}= 1; }
8455 my $empty= defined $elt->{empty} ? $elt->{empty}
8456 : $elt->{first_child} ? 0
8457 : 1;
8458
8459 $tag .= (!$elt->{empty} || $elt->{extra_data_before_end_tag}) ? '>' # element has content
8460 : (($empty_tag_style eq $HTML) && $html_empty_elt{$gi}) ? ' />' # html empty element
8461 # cvs-friendly format
8462 : ( $pretty == $INDENTEDA && @att_names > 1) ? "\n" . $INDENT x $elt->level . "/>"
8463 : ( $pretty == $INDENTEDA && @att_names == 1) ? " />"
8464 : $empty_tag_style ? "></" . $XML::Twig::index2gi[$elt->{'gi'}] . ">" # $empty_tag_style is $HTML or $EXPAND
8465 : '/>'
8466 ;
8467
8468 if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') )) { $tag= ''; }
8469
8470#warn "TRACE: ", $tag,": ", Encode::is_utf8( $tag) ? "has flag" : "FLAG NOT SET";
8471
8472 unless( $pretty) { return defined( $extra_data) ? $extra_data . $tag : $tag; }
8473
8474 my $prefix='';
8475 my $return=''; # '' or \n is to be printed before the tag
8476 my $indent=0; # number of indents before the tag
8477
8478 if( $pretty==$RECORD1)
8479 { my $level= $elt->level;
8480 $return= "\n" if( $level < 2);
8481 $indent= 1 if( $level == 1);
8482 }
8483
8484 elsif( $pretty==$RECORD2)
8485 { $return= "\n";
8486 $indent= $elt->level;
8487 }
8488
8489 elsif( $pretty==$NICE)
8490 { my $parent= $elt->{parent};
8491 unless( !$parent || $parent->{contains_text})
8492 { $return= "\n"; }
8493 $elt->{contains_text}= 1 if( ($parent && $parent->{contains_text})
8494 || $elt->contains_text);
8495 }
8496
8497 elsif( $KEEP_TEXT_TAG_ON_ONE_LINE{$pretty})
8498 { my $parent= $elt->{parent};
8499 unless( !$parent || $parent->{contains_text})
8500 { $return= "\n";
8501 $indent= $elt->level;
8502 }
8503 $elt->{contains_text}= 1 if( ($parent && $parent->{contains_text})
8504 || $elt->contains_text);
8505 }
8506
8507 if( $return || $indent)
8508 { # check for elements in which spaces should be kept
8509 my $t= $elt->twig;
8510 return $extra_data . $tag if( $xml_space_preserve);
8511 if( $t && $t->{twig_keep_spaces_in})
8512 { foreach my $ancestor ($elt->ancestors)
8513 { return $extra_data . $tag if( $t->{twig_keep_spaces_in}->{$XML::Twig::index2gi[$ancestor->{'gi'}]}) }
8514 }
8515
8516 $prefix= $INDENT x $indent;
8517 if( $extra_data)
8518 { $extra_data=~ s{\s+$}{};
8519 $extra_data=~ s{^\s+}{};
8520 $extra_data= $prefix . $extra_data . $return;
8521 }
8522 }
8523
8524
8525 return $return . $extra_data . $prefix . $tag;
8526 }
8527
8528 sub end_tag
8529 { my $elt= shift;
8530 return '' if( ($elt->{gi}<$XML::Twig::SPECIAL_GI)
8531 || ($elt->{'empty'} && !$elt->{extra_data_before_end_tag})
8532 );
8533 my $tag= "<";
8534 my $gi= $XML::Twig::index2gi[$elt->{'gi'}];
8535
8536 if( my $map= $elt->{'att'}->{'#original_gi'}) { $gi= _restore_original_prefix( $map, $gi); }
8537 $gi=~ s{^#default:}{}; # remove default prefix
8538
8539 if( $output_text_filter) { $gi= $output_text_filter->( $XML::Twig::index2gi[$elt->{'gi'}]); }
8540 $tag .= "/$gi>";
8541
8542 $tag = ($elt->{extra_data_before_end_tag} || '') . $tag;
8543
8544 if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') )) { $tag= ''; }
8545
8546 return $tag unless $pretty;
8547
8548 my $prefix='';
8549 my $return=0; # 1 if a \n is to be printed before the tag
8550 my $indent=0; # number of indents before the tag
8551
8552 if( $pretty==$RECORD1)
8553 { $return= 1 if( $elt->level == 0);
8554 }
8555
8556 elsif( $pretty==$RECORD2)
8557 { unless( $elt->contains_text)
8558 { $return= 1 ;
8559 $indent= $elt->level;
8560 }
8561 }
8562
8563 elsif( $pretty==$NICE)
8564 { my $parent= $elt->{parent};
8565 if( ( ($parent && !$parent->{contains_text}) || !$parent )
8566 && ( !$elt->{contains_text}
8567 && ($elt->{has_flushed_child} || $elt->{first_child})
8568 )
8569 )
8570 { $return= 1; }
8571 }
8572
8573 elsif( $KEEP_TEXT_TAG_ON_ONE_LINE{$pretty})
8574 { my $parent= $elt->{parent};
8575 if( ( ($parent && !$parent->{contains_text}) || !$parent )
8576 && ( !$elt->{contains_text}
8577 && ($elt->{has_flushed_child} || $elt->{first_child})
8578 )
8579 )
8580 { $return= 1;
8581 $indent= $elt->level;
8582 }
8583 }
8584
8585 if( $return || $indent)
8586 { # check for elements in which spaces should be kept
8587 my $t= $elt->twig;
8588 return $tag if( $xml_space_preserve);
8589 if( $t && $t->{twig_keep_spaces_in})
8590 { foreach my $ancestor ($elt, $elt->ancestors)
8591 { return $tag if( $t->{twig_keep_spaces_in}->{$XML::Twig::index2gi[$ancestor->{'gi'}]}) }
8592 }
8593
8594 if( $return) { $prefix= ($pretty== $INDENTEDCT) ? "\n$INDENT" : "\n"; }
8595 $prefix.= $INDENT x $indent;
8596 }
8597
8598 # add a \n at the end of the document (after the root element)
8599 $tag .= "\n" unless( $elt->{parent});
8600
8601 return $prefix . $tag;
8602 }
8603
8604 sub _restore_original_prefix
8605 { my( $map, $name)= @_;
8606 my $prefix= _ns_prefix( $name);
8607 if( my $original_prefix= $map->{$prefix})
8608 { if( $original_prefix eq '#default')
8609 { $name=~ s{^$prefix:}{}; }
8610 else
8611 { $name=~ s{^$prefix(?=:)}{$original_prefix}; }
8612 }
8613 return $name;
8614 }
8615
8616 # buffer used to hold the text to print/sprint, to avoid passing it back and forth between methods
8617 my @sprint;
8618
8619 # $elt is an element to print
8620 # $fh is an optional filehandle to print to
8621 # $pretty is an optional value, if true a \n is printed after the < of the
8622 # opening tag
8623 sub print
8624 { my $elt= shift;
8625
8626 my $fh= isa( $_[0], 'GLOB') || isa( $_[0], 'IO::Scalar') ? shift : undef;
8627 my $old_select= defined $fh ? select $fh : undef;
8628 print $elt->sprint( @_);
8629 select $old_select if( defined $old_select);
8630 }
8631
8632
8633# those next 2 methods need to be refactored, they are copies of the same methods in XML::Twig
8634sub print_to_file
8635 { my( $elt, $filename)= (shift, shift);
8636 my $out_fh;
8637# open( $out_fh, ">$filename") or _croak( "cannot create file $filename: $!"); # < perl 5.8
8638 my $mode= $keep_encoding ? '>' : '>:utf8'; # >= perl 5.8
8639 open( $out_fh, $mode, $filename) or _croak( "cannot create file $filename: $!"); # >= perl 5.8
8640 $elt->print( $out_fh, @_);
8641 close $out_fh;
8642 return $elt;
8643 }
8644
8645# probably only works on *nix (at least the chmod bit)
8646# first print to a temporary file, then rename that file to the desired file name, then change permissions
8647# to the original file permissions (or to the current umask)
8648sub safe_print_to_file
8649 { my( $elt, $filename)= (shift, shift);
8650 my $perm= -f $filename ? (stat $filename)[2] & 07777 : ~umask() ;
8651 XML::Twig::_use( 'File::Temp') || croak "need File::Temp to use safe_print_to_file\n";
8652 XML::Twig::_use( 'File::Basename') || croak "need File::Basename to use safe_print_to_file\n";
8653 my $tmpdir= File::Basename::dirname( $filename);
8654 my( $fh, $tmpfilename) = File::Temp::tempfile( DIR => $tmpdir);
8655 $elt->print_to_file( $tmpfilename, @_);
8656 rename( $tmpfilename, $filename) or unlink $tmpfilename && _croak( "cannot move temporary file to $filename: $!");
8657 chmod $perm, $filename;
8658 return $elt;
8659 }
8660
8661
8662 # same as print but does not output the start tag if the element
8663 # is marked as flushed
8664 sub flush
8665 { my $elt= shift;
8666 my $up_to= $_[0] && isa( $_[0], 'XML::Twig::Elt') ? shift : $elt;
8667 $elt->twig->flush_up_to( $up_to, @_);
8668 }
8669 sub purge
8670 { my $elt= shift;
8671 my $up_to= $_[0] && isa( $_[0], 'XML::Twig::Elt') ? shift : $elt;
8672 $elt->twig->purge_up_to( $up_to, @_);
8673 }
8674
8675 sub _flush
8676 { my $elt= shift;
8677
8678 my $pretty;
8679 my $fh= isa( $_[0], 'GLOB') || isa( $_[0], 'IO::Scalar') ? shift : undef;
8680 my $old_select= defined $fh ? select $fh : undef;
8681 my $old_pretty= defined ($pretty= shift) ? set_pretty_print( $pretty) : undef;
8682
8683 $xml_space_preserve= 1 if( ($elt->inherit_att( 'xml:space') || '') eq 'preserve');
8684
8685 $elt->__flush();
8686
8687 $xml_space_preserve= 0;
8688
8689 select $old_select if( defined $old_select);
8690 set_pretty_print( $old_pretty) if( defined $old_pretty);
8691 }
8692
8693 sub __flush
8694 { my $elt= shift;
8695
8696 if( $elt->{gi} >= $XML::Twig::SPECIAL_GI)
8697 { my $preserve= ($elt->{'att'}->{'xml:space'} || '') eq 'preserve';
8698 $xml_space_preserve++ if $preserve;
8699 unless( $elt->{'flushed'})
8700 { print $elt->start_tag();
8701 }
8702
8703 # flush the children
8704 my @children= do { my $elt= $elt; my @children=(); my $child= $elt->{first_child}; while( $child) { push @children, $child; $child= $child->{next_sibling}; } @children; };
8705 foreach my $child (@children)
8706 { $child->_flush( $pretty);
8707 $child->{'flushed'}=1;
8708 }
8709 if( ! $elt->{end_tag_flushed})
8710 { print $elt->end_tag;
8711 $elt->{end_tag_flushed}=1;
8712 $elt->{'flushed'}=1;
8713 }
8714 $xml_space_preserve-- if $preserve;
8715 # used for pretty printing
8716 if( my $parent= $elt->{parent}) { $parent->{has_flushed_child}= 1; }
8717 }
8718 else # text or special element
8719 { my $text;
8720 if( (exists $elt->{'pcdata'})) { $text= $elt->pcdata_xml_string;
8721 if( my $parent= $elt->{parent})
8722 { $parent->{contains_text}= 1; }
8723 }
8724 elsif( (exists $elt->{'cdata'})) { $text= $elt->cdata_string;
8725 if( my $parent= $elt->{parent})
8726 { $parent->{contains_text}= 1; }
8727 }
8728 elsif( (exists $elt->{'target'})) { $text= $elt->pi_string; }
8729 elsif( (exists $elt->{'comment'})) { $text= $elt->comment_string; }
8730 elsif( (exists $elt->{'ent'})) { $text= $elt->ent_string; }
8731
8732 print $output_filter ? $output_filter->( $text) : $text;
8733 }
8734 }
8735
8736
8737 sub xml_text
8738 { my( $elt, @options)= @_;
8739
8740 if( @options && grep { lc( $_) eq 'no_recurse' } @options) { return $elt->xml_text_only; }
8741
8742 my $string='';
8743
8744 if( ($elt->{gi} >= $XML::Twig::SPECIAL_GI) )
8745 { # sprint the children
8746 my $child= $elt->{first_child} || '';
8747 while( $child)
8748 { $string.= $child->xml_text;
8749 } continue { $child= $child->{next_sibling}; }
8750 }
8751 elsif( (exists $elt->{'pcdata'})) { $string .= $output_filter ? $output_filter->($elt->pcdata_xml_string)
8752 : $elt->pcdata_xml_string;
8753 }
8754 elsif( (exists $elt->{'cdata'})) { $string .= $output_filter ? $output_filter->($elt->cdata_string)
8755 : $elt->cdata_string;
8756 }
8757 elsif( (exists $elt->{'ent'})) { $string .= $elt->ent_string; }
8758
8759 return $string;
8760 }
8761
8762 sub xml_text_only
8763 { return join '', map { $_->xml_text if( $_->is_text || (exists $_->{'ent'})) } $_[0]->_children; }
8764
8765 # same as print but except... it does not print but rather returns the string
8766 # if the second parameter is set then only the content is returned, not the
8767 # start and end tags of the element (but the tags of the included elements are
8768 # returned)
8769
8770 sub sprint
8771 { my $elt= shift;
8772 my( $old_pretty, $old_empty_tag_style);
8773
8774 if( $_[0])
8775 { if( isa( $_[0], 'HASH'))
8776 { # "proper way, using a hashref for options
8777 my %args= XML::Twig::_normalize_args( %{shift()});
8778 if( defined $args{PrettyPrint}) { $old_pretty = set_pretty_print( $args{PrettyPrint}); }
8779 if( defined $args{EmptyTags}) { $old_empty_tag_style = set_empty_tag_style( $args{EmptyTags}); }
8780 }
8781 else
8782 { # "old" way, just using the option name
8783 my @other_opt;
8784 foreach my $opt (@_)
8785 { if( exists $pretty_print_style{$opt}) { $old_pretty = set_pretty_print( $opt); }
8786 elsif( exists $empty_tag_style{$opt}) { $old_empty_tag_style = set_empty_tag_style( $opt); }
8787 else { push @other_opt, $opt; }
8788 }
8789 @_= @other_opt;
8790 }
8791 }
8792
8793 $xml_space_preserve= 1 if( ($elt->inherit_att( 'xml:space') || '') eq 'preserve');
8794
8795 @sprint=();
8796 $elt->_sprint( @_);
8797 my $sprint= join( '', @sprint);
8798 if( $output_filter) { $sprint= $output_filter->( $sprint); }
8799
8800 if( ( ($pretty== $WRAPPED) || ($pretty==$INDENTEDC)) && !$xml_space_preserve)
8801 { $sprint= _wrap_text( $sprint); }
8802 $xml_space_preserve= 0;
8803
8804
8805 if( defined $old_pretty) { set_pretty_print( $old_pretty); }
8806 if( defined $old_empty_tag_style) { set_empty_tag_style( $old_empty_tag_style); }
8807
8808 return $sprint;
8809 }
8810
8811 sub _wrap_text
8812 { my( $string)= @_;
8813 my $wrapped;
8814 foreach my $line (split /\n/, $string)
8815 { my( $initial_indent)= $line=~ m{^(\s*)};
8816 my $wrapped_line= Text::Wrap::wrap( '', $initial_indent . $INDENT, $line) . "\n";
8817
8818 # fix glitch with Text::wrap when the first line is long and does not include spaces
8819 # the first line ends up being too short by 2 chars, but we'll have to live with it!
8820 $wrapped_line=~ s{^ +\n }{}s; # this prefix needs to be removed
8821
8822 $wrapped .= $wrapped_line;
8823 }
8824
8825 return $wrapped;
8826 }
8827
8828
8829 sub _sprint
8830 { my $elt= shift;
8831 my $no_tag= shift || 0;
8832 # in case there's some comments or PI's piggybacking
8833
8834 if( $elt->{gi} >= $XML::Twig::SPECIAL_GI)
8835 {
8836 my $preserve= ($elt->{'att'}->{'xml:space'} || '') eq 'preserve';
8837 $xml_space_preserve++ if $preserve;
8838
8839 push @sprint, $elt->start_tag unless( $no_tag);
8840
8841 # sprint the children
8842 my $child= $elt->{first_child};
8843 while( $child)
8844 { $child->_sprint;
8845 $child= $child->{next_sibling};
8846 }
8847 push @sprint, $elt->end_tag unless( $no_tag);
8848 $xml_space_preserve-- if $preserve;
8849 }
8850 else
8851 { push @sprint, $elt->{extra_data} if( $elt->{extra_data}) ;
8852 if( (exists $elt->{'pcdata'})) { push @sprint, $elt->pcdata_xml_string; }
8853 elsif( (exists $elt->{'cdata'})) { push @sprint, $elt->cdata_string; }
8854 elsif( (exists $elt->{'target'})) { if( ($pretty >= $INDENTED) && !$elt->{parent}->{contains_text}) { push @sprint, "\n" . $INDENT x $elt->level; }
8855 push @sprint, $elt->pi_string;
8856 }
8857 elsif( (exists $elt->{'comment'})) { if( ($pretty >= $INDENTED) && !$elt->{parent}->{contains_text}) { push @sprint, "\n" . $INDENT x $elt->level; }
8858 push @sprint, $elt->comment_string;
8859 }
8860 elsif( (exists $elt->{'ent'})) { push @sprint, $elt->ent_string; }
8861 }
8862
8863 return;
8864 }
8865
8866 # just a shortcut to $elt->sprint( 1)
8867 sub xml_string
8868 { my $elt= shift;
8869 isa( $_[0], 'HASH') ? $elt->sprint( shift(), 1) : $elt->sprint( 1);
8870 }
8871
8872 sub pcdata_xml_string
8873 { my $elt= shift;
8874 if( defined( my $string= $elt->{pcdata}) )
8875 {
8876 if( ! $elt->{extra_data_in_pcdata})
8877 {
8878 $string=~ s/([$replaced_ents])/$XML::Twig::base_ent{$1}/g unless( !$replaced_ents || $keep_encoding || $elt->{asis});
8879 $string=~ s{\Q]]>}{]]&gt;}g;
8880 }
8881 else
8882 { _gen_mark( $string); # used by _(un)?protect_extra_data
8883 foreach my $data (reverse @{$elt->{extra_data_in_pcdata}})
8884 { my $substr= substr( $string, $data->{offset});
8885 if( $keep_encoding || $elt->{asis})
8886 { substr( $string, $data->{offset}, 0, $data->{text}); }
8887 else
8888 { substr( $string, $data->{offset}, 0, _protect_extra_data( $data->{text})); }
8889 }
8890 unless( $keep_encoding || $elt->{asis})
8891 {
8892 $string=~ s{([$replaced_ents])}{$XML::Twig::base_ent{$1}}g ;
8893 $string=~ s{\Q]]>}{]]&gt;}g;
8894 _unprotect_extra_data( $string);
8895 }
8896 }
8897 return $output_text_filter ? $output_text_filter->( $string) : $string;
8898 }
8899 else
8900 { return ''; }
8901 }
8902
89031100ns { my $mark;
89041400ns my( %char2ent, %ent2char);
8905 BEGIN
890611µs
# spent 6µs within XML::Twig::Elt::BEGIN@8906 which was called: # once (6µs+0s) by Spreadsheet::ParseXLSX::BEGIN@15 at line 8908
{ %char2ent= ( '<' => 'lt', '&' => 'amp', '>' => 'gt');
890718µs %ent2char= map { $char2ent{$_} => $_ } keys %char2ent;
89081957µs16µs }
# spent 6µs making 1 call to XML::Twig::Elt::BEGIN@8906
8909
8910 # generate a unique mark (a string) not found in the string,
8911 # used to mark < and & in the extra data
8912 sub _gen_mark
8913 { $mark="AAAA";
8914 $mark++ while( index( $_[0], $mark) > -1);
8915 return $mark;
8916 }
8917
8918 sub _protect_extra_data
8919 { my( $extra_data)= @_;
8920 $extra_data=~ s{([<&>])}{:$mark:$char2ent{$1}:}g;
8921 return $extra_data;
8922 }
8923
8924 sub _unprotect_extra_data
8925 { $_[0]=~ s{:$mark:(\w+):}{$ent2char{$1}}g; }
8926
8927 }
8928
8929 sub cdata_string
893016µs { my $cdata= $_[0]->{cdata};
8931 unless( defined $cdata) { return ''; }
8932 if( $remove_cdata)
8933 { $cdata=~ s/([$replaced_ents])/$XML::Twig::base_ent{$1}/g; }
8934 else
8935 { $cdata= $CDATA_START . $cdata . $CDATA_END; }
8936 return $cdata;
8937 }
8938
8939 sub att_xml_string
8940 { my $elt= shift;
8941 my $att= shift;
8942
8943 my $replace= $replaced_ents . "$quote\n\r\t";
8944 if($_[0] && $_[0]->{escape_gt} && ($replace!~ m{>}) ) { $replace .='>'; }
8945
8946 if( defined (my $string= $elt->{att}->{$att}))
8947 { return _att_xml_string( $string, $replace); }
8948 else
8949 { return ''; }
8950 }
8951
8952 # escaped xml string for an attribute value
8953 sub _att_xml_string
8954 { my( $string, $escape)= @_;
8955 if( !defined( $string)) { return ''; }
8956 if( $keep_encoding)
8957 { $string=~ s{$quote}{$XML::Twig::base_ent{$quote}}g;
8958 }
8959 else
8960 {
8961 if( $do_not_escape_amp_in_atts)
8962 { $escape=~ s{^.}{}; # seems like the most backward compatible way to remove & from the list
8963 $string=~ s{([$escape])}{$XML::Twig::base_ent{$1}}g;
8964 $string=~ s{&(?!(\w+|#\d+|[xX][0-9a-fA-F]+);)}{&amp;}g; # dodgy: escape & that do not start an entity
8965 }
8966 else
8967 { $string=~ s{([$escape])}{$XML::Twig::base_ent{$1}}g;
8968 $string=~ s{\Q]]>}{]]&gt;}g;
8969 }
8970 }
8971
8972 return $output_text_filter ? $output_text_filter->( $string) : $string;
8973 }
8974
8975 sub ent_string
8976 { my $ent= shift;
8977 my $ent_text= $ent->{ent};
8978 my( $t, $el, $ent_string);
8979 if( $expand_external_entities
8980 && ($t= $ent->twig)
8981 && ($el= $t->entity_list)
8982 && ($ent_string= $el->{entities}->{$ent->ent_name}->{val})
8983 )
8984 { return $ent_string; }
8985 else
8986 { return $ent_text; }
8987 }
8988
8989 # returns just the text, no tags, for an element
8990 sub text
899125458230.4ms
# spent 678ms (678+0ns) within XML::Twig::Elt::text which was called 254582 times, avg 3µs/call: # 127291 times (145ms+-145ms) by XML::Twig::Elt::text at line 9008, avg 0s/call # 127276 times (533ms+145ms) by Spreadsheet::ParseXLSX::__ANON__[lib/Spreadsheet/ParseXLSX.pm:443] at line 380 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 5µs/call # 15 times (68µs+33µs) by Spreadsheet::ParseXLSX::_get_text_and_rich_font_by_cell at line 583 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm, avg 7µs/call
{ my( $elt, @options)= @_;
8992
899325458222.8ms if( @options && grep { lc( $_) eq 'no_recurse' } @options) { return $elt->text_only; }
899425458230.6ms my $sep = (@options && grep { lc( $_) eq 'sep' } @options) ? ' ' : '';
8995
899625458217.4ms my $string;
8997
8998254582309ms if( (exists $elt->{'pcdata'})) { return $elt->{pcdata} . $sep; }
8999 elsif( (exists $elt->{'cdata'})) { return $elt->{cdata} . $sep; }
9000 elsif( (exists $elt->{'target'})) { return $elt->pi_string . $sep; }
9001 elsif( (exists $elt->{'comment'})) { return $elt->{comment} . $sep; }
9002 elsif( (exists $elt->{'ent'})) { return $elt->{ent} . $sep ; }
9003
9004
900512729120.3ms my $child= $elt->{first_child} ||'';
900612729160.7ms while( $child)
9007 {
900812729166.0ms1272910s my $child_text= $child->text( @options);
# spent 145ms making 127291 calls to XML::Twig::Elt::text, avg 1µs/call, recursion: max depth 1, sum of overlapping time 145ms
900912729150.6ms $string.= defined( $child_text) ? $sep . $child_text : '';
9010 } continue { $child= $child->{next_sibling}; }
9011
901212729110.7ms unless( defined $string) { $string=''; }
9013
9014127291211ms return $output_text_filter ? $output_text_filter->( $string) : $string;
9015 }
9016
9017 sub text_only
9018 { return join '', map { $_->text if( $_->is_text || (exists $_->{'ent'})) } $_[0]->_children; }
9019
9020 sub trimmed_text
9021 { my $elt= shift;
9022 my $text= $elt->text( @_);
9023 $text=~ s{\s+}{ }sg;
9024 $text=~ s{^\s*}{};
9025 $text=~ s{\s*$}{};
9026 return $text;
9027 }
9028
9029 sub trim
9030 { my( $elt)= @_;
9031 my $pcdata= $elt->first_descendant( $TEXT);
9032 (my $pcdata_text= $pcdata->text)=~ s{^\s+}{}s;
9033 $pcdata->set_text( $pcdata_text);
9034 $pcdata= $elt->last_descendant( $TEXT);
9035 ($pcdata_text= $pcdata->text)=~ s{\s+$}{};
9036 $pcdata->set_text( $pcdata_text);
9037 foreach my $pcdata ($elt->descendants( $TEXT))
9038 { ($pcdata_text= $pcdata->text)=~ s{\s+}{ }g;
9039 $pcdata->set_text( $pcdata_text);
9040 }
9041 return $elt;
9042 }
9043
9044
9045 # remove cdata sections (turns them into regular pcdata) in an element
9046 sub remove_cdata
9047 { my $elt= shift;
9048 foreach my $cdata ($elt->descendants_or_self( $CDATA))
9049 { if( $keep_encoding)
9050 { my $data= $cdata->{cdata};
9051 $data=~ s{([&<"'])}{$XML::Twig::base_ent{$1}}g;
9052 $cdata->{pcdata}= (delete $cdata->{empty} || 1) && $data;
9053 }
9054 else
9055 { $cdata->{pcdata}= (delete $cdata->{empty} || 1) && $cdata->{cdata}; }
9056 $cdata->{gi}=$XML::Twig::gi2index{$PCDATA} or $cdata->set_gi( $PCDATA);
9057 undef $cdata->{cdata};
9058 }
9059 }
9060
9061sub _is_private { return _is_private_name( $_[0]->gi); }
9062sub _is_private_name { return $_[0]=~ m{^#(?!default:)}; }
9063
9064
906513.76ms116µs} # end of block containing package globals ($pretty_print, $quotes, keep_encoding...)
# spent 16µs making 1 call to XML::Twig::Elt::BEGIN@8119
9066
9067# merges consecutive #PCDATAs in am element
9068sub normalize
9069 { my( $elt)= @_;
9070 my @descendants= $elt->descendants( $PCDATA);
9071 while( my $desc= shift @descendants)
9072 { if( ! length $desc->{pcdata}) { $desc->delete; next; }
9073 while( @descendants && $desc->{next_sibling} && $desc->{next_sibling}== $descendants[0])
9074 { my $to_merge= shift @descendants;
9075 $desc->merge_text( $to_merge);
9076 }
9077 }
9078 return $elt;
9079 }
9080
9081# SAX export methods
9082sub toSAX1
9083 { _toSAX(@_, \&_start_tag_data_SAX1, \&_end_tag_data_SAX1); }
9084
9085sub toSAX2
9086 { _toSAX(@_, \&_start_tag_data_SAX2, \&_end_tag_data_SAX2); }
9087
9088sub _toSAX
9089 { my( $elt, $handler, $start_tag_data, $end_tag_data)= @_;
9090 if( $elt->{gi} >= $XML::Twig::SPECIAL_GI)
9091 { my $data= $start_tag_data->( $elt);
9092 _start_prefix_mapping( $elt, $handler, $data);
9093 if( $data && (my $start_element = $handler->can( 'start_element')))
9094 { unless( $elt->{'flushed'}) { $start_element->( $handler, $data); } }
9095
9096 foreach my $child ($elt->_children)
9097 { $child->_toSAX( $handler, $start_tag_data, $end_tag_data); }
9098
9099 if( (my $data= $end_tag_data->( $elt)) && (my $end_element = $handler->can( 'end_element')) )
9100 { $end_element->( $handler, $data); }
9101 _end_prefix_mapping( $elt, $handler);
9102 }
9103 else # text or special element
9104 { if( (exists $elt->{'pcdata'}) && (my $characters= $handler->can( 'characters')))
9105 { $characters->( $handler, { Data => $elt->{pcdata} }); }
9106 elsif( (exists $elt->{'cdata'}))
9107 { if( my $start_cdata= $handler->can( 'start_cdata'))
9108 { $start_cdata->( $handler); }
9109 if( my $characters= $handler->can( 'characters'))
9110 { $characters->( $handler, {Data => $elt->{cdata} }); }
9111 if( my $end_cdata= $handler->can( 'end_cdata'))
9112 { $end_cdata->( $handler); }
9113 }
9114 elsif( ((exists $elt->{'target'})) && (my $pi= $handler->can( 'processing_instruction')))
9115 { $pi->( $handler, { Target =>$elt->{target}, Data => $elt->{data} }); }
9116 elsif( ((exists $elt->{'comment'})) && (my $comment= $handler->can( 'comment')))
9117 { $comment->( $handler, { Data => $elt->{comment} }); }
9118 elsif( ((exists $elt->{'ent'})))
9119 {
9120 if( my $se= $handler->can( 'skipped_entity'))
9121 { $se->( $handler, { Name => $elt->ent_name }); }
9122 elsif( my $characters= $handler->can( 'characters'))
9123 { if( defined $elt->ent_string)
9124 { $characters->( $handler, {Data => $elt->ent_string}); }
9125 else
9126 { $characters->( $handler, {Data => $elt->ent_name}); }
9127 }
9128 }
9129
9130 }
9131 }
9132
9133sub _start_tag_data_SAX1
9134 { my( $elt)= @_;
9135 my $name= $XML::Twig::index2gi[$elt->{'gi'}];
9136 return if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') ));
9137 my $attributes={};
9138 my $atts= $elt->{att};
9139 while( my( $att, $value)= each %$atts)
9140 { $attributes->{$att}= $value unless( ( $att=~ m{^#(?!default:)} )); }
9141 my $data= { Name => $name, Attributes => $attributes};
9142 return $data;
9143 }
9144
9145sub _end_tag_data_SAX1
9146 { my( $elt)= @_;
9147 return if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') ));
9148 return { Name => $XML::Twig::index2gi[$elt->{'gi'}] };
9149 }
9150
9151sub _start_tag_data_SAX2
9152 { my( $elt)= @_;
9153 my $data={};
9154
9155 my $name= $XML::Twig::index2gi[$elt->{'gi'}];
9156 return if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') ));
9157 $data->{Name} = $name;
9158 $data->{Prefix} = $elt->ns_prefix;
9159 $data->{LocalName} = $elt->local_name;
9160 $data->{NamespaceURI} = $elt->namespace;
9161
9162 # save a copy of the data so we can re-use it for the end tag
9163 my %sax2_data= %$data;
9164 $elt->{twig_elt_SAX2_data}= \%sax2_data;
9165
9166 # add the attributes
9167 $data->{Attributes}= $elt->_atts_to_SAX2;
9168
9169 return $data;
9170 }
9171
9172sub _atts_to_SAX2
9173 { my $elt= shift;
9174 my $SAX2_atts= {};
9175 foreach my $att (keys %{$elt->{att}})
9176 {
9177 next if( ( $att=~ m{^#(?!default:)} ));
9178 my $SAX2_att={};
9179 $SAX2_att->{Name} = $att;
9180 $SAX2_att->{Prefix} = _ns_prefix( $att);
9181 $SAX2_att->{LocalName} = _local_name( $att);
9182 $SAX2_att->{NamespaceURI} = $elt->namespace( $SAX2_att->{Prefix});
9183 $SAX2_att->{Value} = $elt->{'att'}->{$att};
9184 my $SAX2_att_name= "{$SAX2_att->{NamespaceURI}}$SAX2_att->{LocalName}";
9185
9186 $SAX2_atts->{$SAX2_att_name}= $SAX2_att;
9187 }
9188 return $SAX2_atts;
9189 }
9190
9191sub _start_prefix_mapping
9192 { my( $elt, $handler, $data)= @_;
9193 if( my $start_prefix_mapping= $handler->can( 'start_prefix_mapping')
9194 and my @new_prefix_mappings= grep { /^\{[^}]*\}xmlns/ || /^\{$XMLNS_URI\}/ } keys %{$data->{Attributes}}
9195 )
9196 { foreach my $prefix (@new_prefix_mappings)
9197 { my $prefix_string= $data->{Attributes}->{$prefix}->{LocalName};
9198 if( $prefix_string eq 'xmlns') { $prefix_string=''; }
9199 my $prefix_data=
9200 { Prefix => $prefix_string,
9201 NamespaceURI => $data->{Attributes}->{$prefix}->{Value}
9202 };
9203 $start_prefix_mapping->( $handler, $prefix_data);
9204 $elt->{twig_end_prefix_mapping} ||= [];
9205 push @{$elt->{twig_end_prefix_mapping}}, $prefix_string;
9206 }
9207 }
9208 }
9209
9210sub _end_prefix_mapping
9211 { my( $elt, $handler)= @_;
9212 if( my $end_prefix_mapping= $handler->can( 'end_prefix_mapping'))
9213 { foreach my $prefix (@{$elt->{twig_end_prefix_mapping}})
9214 { $end_prefix_mapping->( $handler, { Prefix => $prefix} ); }
9215 }
9216 }
9217
9218sub _end_tag_data_SAX2
9219 { my( $elt)= @_;
9220 return if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') ));
9221 return $elt->{twig_elt_SAX2_data};
9222 }
9223
9224sub contains_text
9225 { my $elt= shift;
9226 my $child= $elt->{first_child};
9227 while ($child)
9228 { return 1 if( $child->is_text || (exists $child->{'ent'}));
9229 $child= $child->{next_sibling};
9230 }
9231 return 0;
9232 }
9233
9234# creates a single pcdata element containing the text as child of the element
9235# options:
9236# - force_pcdata: when set to a true value forces the text to be in a #PCDATA
9237# even if the original element was a #CDATA
9238sub set_text
9239 { my( $elt, $string, %option)= @_;
9240
9241 if( $XML::Twig::index2gi[$elt->{'gi'}] eq $PCDATA)
9242 { return $elt->{pcdata}= (delete $elt->{empty} || 1) && $string; }
9243 elsif( $XML::Twig::index2gi[$elt->{'gi'}] eq $CDATA)
9244 { if( $option{force_pcdata})
9245 { $elt->{gi}=$XML::Twig::gi2index{$PCDATA} or $elt->set_gi( $PCDATA);
9246 $elt->{cdata}= '';
9247 return $elt->{pcdata}= (delete $elt->{empty} || 1) && $string;
9248 }
9249 else
9250 { $elt->{cdata}= $string;
9251 return $string;
9252 }
9253 }
9254 elsif( $elt->contains_a_single( $PCDATA) )
9255 { # optimized so we have a slight chance of not losing embedded comments and pi's
9256 $elt->{first_child}->set_pcdata( $string);
9257 return $elt;
9258 }
9259
9260 foreach my $child (@{[$elt->_children]})
9261 { $child->delete; }
9262
9263 my $pcdata= $elt->_new_pcdata( $string);
9264 $pcdata->paste( $elt);
9265
9266 delete $elt->{empty};
9267
9268 return $elt;
9269 }
9270
9271# set the content of an element from a list of strings and elements
9272sub set_content
9273 { my $elt= shift;
9274
9275 return $elt unless defined $_[0];
9276
9277 # attributes can be given as a hash (passed by ref)
9278 if( ref $_[0] eq 'HASH')
9279 { my $atts= shift;
9280 $elt->del_atts; # usually useless but better safe than sorry
9281 $elt->set_atts( $atts);
9282 return $elt unless defined $_[0];
9283 }
9284
9285 # check next argument for #EMPTY
9286 if( !(ref $_[0]) && ($_[0] eq $EMPTY) )
9287 { $elt->{empty}= 1; return $elt; }
9288
9289 # case where we really want to do a set_text, the element is '#PCDATA'
9290 # or contains a single PCDATA and we only want to add text in it
9291 if( ($XML::Twig::index2gi[$elt->{'gi'}] eq $PCDATA || $elt->contains_a_single( $PCDATA))
9292 && (@_ == 1) && !( ref $_[0]))
9293 { $elt->set_text( $_[0]);
9294 return $elt;
9295 }
9296 elsif( ($XML::Twig::index2gi[$elt->{'gi'}] eq $CDATA) && (@_ == 1) && !( ref $_[0]))
9297 { $elt->{cdata}= $_[0];
9298 return $elt;
9299 }
9300
9301 # delete the children
9302 foreach my $child (@{[$elt->_children]})
9303 { $child->delete; }
9304
9305 if( @_) { delete $elt->{empty}; }
9306
9307 foreach my $child (@_)
9308 { if( ref( $child) && isa( $child, 'XML::Twig::Elt'))
9309 { # argument is an element
9310 $child->paste( 'last_child', $elt);
9311 }
9312 else
9313 { # argument is a string
9314 if( (my $pcdata= $elt->{last_child}) && $elt->{last_child}->is_pcdata)
9315 { # previous child is also pcdata: just concatenate
9316 $pcdata->{pcdata}= (delete $pcdata->{empty} || 1) && $pcdata->{pcdata} . $child
9317 }
9318 else
9319 { # previous child is not a string: create a new pcdata element
9320 $pcdata= $elt->_new_pcdata( $child);
9321 $pcdata->paste( 'last_child', $elt);
9322 }
9323 }
9324 }
9325
9326
9327 return $elt;
9328 }
9329
9330# inserts an element (whose gi is given) as child of the element
9331# all children of the element are now children of the new element
9332# returns the new element
9333sub insert
9334 { my ($elt, @args)= @_;
9335 # first cut the children
9336 my @children= do { my $elt= $elt; my @children=(); my $child= $elt->{first_child}; while( $child) { push @children, $child; $child= $child->{next_sibling}; } @children; };
9337 foreach my $child (@children)
9338 { $child->cut; }
9339 # insert elements
9340 while( my $gi= shift @args)
9341 { my $new_elt= $elt->new( $gi);
9342 # add attributes if needed
9343 if( defined( $args[0]) && ( isa( $args[0], 'HASH')) )
9344 { $new_elt->set_atts( shift @args); }
9345 # paste the element
9346 $new_elt->paste( $elt);
9347 delete $elt->{empty};
9348 $elt= $new_elt;
9349 }
9350 # paste back the children
9351 foreach my $child (@children)
9352 { $child->paste( 'last_child', $elt); }
9353 return $elt;
9354 }
9355
9356# insert a new element
9357# $elt->insert_new_element( $opt_position, $gi, $opt_atts_hash, @opt_content);
9358# the element is created with the same syntax as new
9359# position is the same as in paste, first_child by default
9360sub insert_new_elt
9361 { my $elt= shift;
9362 my $position= $_[0];
9363 if( ($position eq 'before') || ($position eq 'after')
9364 || ($position eq 'first_child') || ($position eq 'last_child'))
9365 { shift; }
9366 else
9367 { $position= 'first_child'; }
9368
9369 my $new_elt= $elt->new( @_);
9370 $new_elt->paste( $position, $elt);
9371
9372 #if( defined $new_elt->{'att'}->{$ID}) { $new_elt->set_id( $new_elt->{'att'}->{$ID}); }
9373
9374 return $new_elt;
9375 }
9376
9377# wraps an element in elements which gi's are given as arguments
9378# $elt->wrap_in( 'td', 'tr', 'table') wraps the element as a single
9379# cell in a table for example
9380# returns the new element
9381sub wrap_in
9382 { my $elt= shift;
9383 while( my $gi = shift @_)
9384 { my $new_elt = $elt->new( $gi);
9385 if( $elt->{twig_current})
9386 { my $t= $elt->twig;
9387 $t->{twig_current}= $new_elt;
9388 delete $elt->{'twig_current'};
9389 $new_elt->{'twig_current'}=1;
9390 }
9391
9392 if( my $parent= $elt->{parent})
9393 { $new_elt->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $new_elt->{parent});} ;
9394 if( $parent->{first_child} == $elt) { $parent->{first_child}= $new_elt; }
9395 if( $parent->{last_child} == $elt) { delete $parent->{empty}; $parent->{last_child}=$new_elt; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ; }
9396 }
9397 else
9398 { # wrapping the root
9399 my $twig= $elt->twig;
9400 if( $twig && $twig->root && ($twig->root eq $elt) )
9401 { $twig->set_root( $new_elt);
9402 }
9403 }
9404
9405 if( my $prev_sibling= $elt->{prev_sibling})
9406 { $new_elt->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $new_elt->{prev_sibling});} ;
9407 $prev_sibling->{next_sibling}= $new_elt;
9408 }
9409
9410 if( my $next_sibling= $elt->{next_sibling})
9411 { $new_elt->{next_sibling}= $next_sibling;
9412 $next_sibling->{prev_sibling}=$new_elt; if( $XML::Twig::weakrefs) { weaken( $next_sibling->{prev_sibling});} ;
9413 }
9414 $new_elt->{first_child}= $elt;
9415 delete $new_elt->{empty}; $new_elt->{last_child}=$elt; if( $XML::Twig::weakrefs) { weaken( $new_elt->{last_child});} ;
9416
9417 $elt->{parent}=$new_elt; if( $XML::Twig::weakrefs) { weaken( $elt->{parent});} ;
9418 $elt->{prev_sibling}=undef; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ;
9419 $elt->{next_sibling}= undef;
9420
9421 # add the attributes if the next argument is a hash ref
9422 if( defined( $_[0]) && (isa( $_[0], 'HASH')) )
9423 { $new_elt->set_atts( shift @_); }
9424
9425 $elt= $new_elt;
9426 }
9427
9428 return $elt;
9429 }
9430
9431sub replace
9432 { my( $elt, $ref)= @_;
9433
9434 if( $elt->{parent}) { $elt->cut; }
9435
9436 if( my $parent= $ref->{parent})
9437 { $elt->{parent}=$parent; if( $XML::Twig::weakrefs) { weaken( $elt->{parent});} ;
9438 if( $parent->{first_child} == $ref) { $parent->{first_child}= $elt; }
9439 if( $parent->{last_child} == $ref) { delete $parent->{empty}; $parent->{last_child}=$elt; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ; }
9440 }
9441 elsif( $ref->twig && $ref == $ref->twig->root)
9442 { $ref->twig->set_root( $elt); }
9443
9444 if( my $prev_sibling= $ref->{prev_sibling})
9445 { $elt->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ;
9446 $prev_sibling->{next_sibling}= $elt;
9447 }
9448 if( my $next_sibling= $ref->{next_sibling})
9449 { $elt->{next_sibling}= $next_sibling;
9450 $next_sibling->{prev_sibling}=$elt; if( $XML::Twig::weakrefs) { weaken( $next_sibling->{prev_sibling});} ;
9451 }
9452
9453 $ref->{parent}=undef; if( $XML::Twig::weakrefs) { weaken( $ref->{parent});} ;
9454 $ref->{prev_sibling}=undef; if( $XML::Twig::weakrefs) { weaken( $ref->{prev_sibling});} ;
9455 $ref->{next_sibling}= undef;
9456 return $ref;
9457 }
9458
9459sub replace_with
9460 { my $ref= shift;
9461 my $elt= shift;
9462 $elt->replace( $ref);
9463 foreach my $new_elt (reverse @_)
9464 { $new_elt->paste( after => $elt); }
9465 return $elt;
9466 }
9467
9468
9469# move an element, same syntax as paste, except the element is first cut
9470sub move
9471 { my $elt= shift;
9472 $elt->cut;
9473 $elt->paste( @_);
9474 return $elt;
9475 }
9476
9477
9478# adds a prefix to an element, creating a pcdata child if needed
9479sub prefix
9480 { my ($elt, $prefix, $option)= @_;
9481 my $asis= ($option && ($option eq 'asis')) ? 1 : 0;
9482 if( (exists $elt->{'pcdata'})
9483 && (($asis && $elt->{asis}) || (!$asis && ! $elt->{asis}))
9484 )
9485 { $elt->{pcdata}= (delete $elt->{empty} || 1) && $prefix . $elt->{pcdata}; }
9486 elsif( $elt->{first_child} && $elt->{first_child}->is_pcdata
9487 && ( ($asis && $elt->{first_child}->{asis})
9488 || (!$asis && ! $elt->{first_child}->{asis}))
9489 )
9490 {
9491 $elt->{first_child}->set_pcdata( $prefix . $elt->{first_child}->pcdata);
9492 }
9493 else
9494 { my $new_elt= $elt->_new_pcdata( $prefix);
9495 my $pos= (exists $elt->{'pcdata'}) ? 'before' : 'first_child';
9496 $new_elt->paste( $pos => $elt);
9497 if( $asis) { $new_elt->set_asis; }
9498 }
9499 return $elt;
9500 }
9501
9502# adds a suffix to an element, creating a pcdata child if needed
9503sub suffix
9504 { my ($elt, $suffix, $option)= @_;
9505 my $asis= ($option && ($option eq 'asis')) ? 1 : 0;
9506 if( (exists $elt->{'pcdata'})
9507 && (($asis && $elt->{asis}) || (!$asis && ! $elt->{asis}))
9508 )
9509 { $elt->{pcdata}= (delete $elt->{empty} || 1) && $elt->{pcdata} . $suffix; }
9510 elsif( $elt->{last_child} && $elt->{last_child}->is_pcdata
9511 && ( ($asis && $elt->{last_child}->{asis})
9512 || (!$asis && ! $elt->{last_child}->{asis}))
9513 )
9514 { $elt->{last_child}->set_pcdata( $elt->{last_child}->pcdata . $suffix); }
9515 else
9516 { my $new_elt= $elt->_new_pcdata( $suffix);
9517 my $pos= (exists $elt->{'pcdata'}) ? 'after' : 'last_child';
9518 $new_elt->paste( $pos => $elt);
9519 if( $asis) { $new_elt->set_asis; }
9520 }
9521 return $elt;
9522 }
9523
9524# create a path to an element ('/root/.../gi)
9525sub path
9526 { my $elt= shift;
9527 my @context= ( $elt, $elt->ancestors);
9528 return "/" . join( "/", reverse map {$_->gi} @context);
9529 }
9530
9531sub xpath
9532 { my $elt= shift;
9533 my $xpath;
9534 foreach my $ancestor (reverse $elt->ancestors_or_self)
9535 { my $gi= $XML::Twig::index2gi[$ancestor->{'gi'}];
9536 $xpath.= "/$gi";
9537 my $index= $ancestor->prev_siblings( $gi) + 1;
9538 unless( ($index == 1) && !$ancestor->next_sibling( $gi))
9539 { $xpath.= "[$index]"; }
9540 }
9541 return $xpath;
9542 }
9543
9544# methods used mainly by wrap_children
9545
9546# return a string with the
9547# for an element <foo><elt att="val">...</elt><elt2/><elt>...</elt></foo>
9548# returns '<elt att="val"><elt2><elt>'
9549sub _stringify_struct
9550 { my( $elt, %opt)= @_;
9551 my $string='';
9552 my $pretty_print= set_pretty_print( 'none');
9553 foreach my $child ($elt->_children)
9554 { $child->add_id; $string .= $child->start_tag( { escape_gt => 1 }) ||''; }
9555 set_pretty_print( $pretty_print);
9556 return $string;
9557 }
9558
9559# wrap a series of elements in a new one
9560sub _wrap_range
9561 { my $elt= shift;
9562 my $gi= shift;
9563 my $atts= isa( $_[0], 'HASH') ? shift : undef;
9564 my $range= shift; # the string with the tags to wrap
9565
9566 my $t= $elt->twig;
9567
9568 # get the tags to wrap
9569 my @to_wrap;
9570 while( $range=~ m{<\w+\s+[^>]*id=("[^"]*"|'[^']*')[^>]*>}g)
9571 { push @to_wrap, $t->elt_id( substr( $1, 1, -1)); }
9572
9573 return '' unless @to_wrap;
9574
9575 my $to_wrap= shift @to_wrap;
9576 my %atts= %$atts;
9577 my $new_elt= $to_wrap->wrap_in( $gi, \%atts);
9578 $_->move( last_child => $new_elt) foreach (@to_wrap);
9579
9580 return '';
9581 }
9582
9583# wrap children matching a regexp in a new element
9584sub wrap_children
9585 { my( $elt, $regexp, $gi, $atts)= @_;
9586
9587 $atts ||={};
9588
9589 my $elt_as_string= $elt->_stringify_struct; # stringify the elt structure
9590 $regexp=~ s{(<[^>]*>)}{_match_expr( $1)}eg; # in the regexp, replace gi's by the proper regexp
9591 $elt_as_string=~ s{($regexp)}{$elt->_wrap_range( $gi, $atts, $1)}eg; # then do the actual replace
9592
9593 return $elt;
9594 }
9595
9596sub _match_expr
9597 { my $tag= shift;
9598 my( $gi, %atts)= XML::Twig::_parse_start_tag( $tag);
9599 return _match_tag( $gi, %atts);
9600 }
9601
9602
9603sub _match_tag
9604 { my( $elt, %atts)= @_;
9605 my $string= "<$elt\\b";
9606 foreach my $key (sort keys %atts)
9607 { my $val= qq{\Q$atts{$key}\E};
9608 $string.= qq{[^>]*$key=(?:"$val"|'$val')};
9609 }
9610 $string.= qq{[^>]*>};
9611 return "(?:$string)";
9612 }
9613
9614sub field_to_att
9615 { my( $elt, $cond, $att)= @_;
9616 $att ||= $cond;
9617 my $child= $elt->first_child( $cond) or return undef;
9618 $elt->set_att( $att => $child->text);
9619 $child->cut;
9620 return $elt;
9621 }
9622
9623sub att_to_field
9624 { my( $elt, $att, $tag)= @_;
9625 $tag ||= $att;
9626 my $child= $elt->insert_new_elt( first_child => $tag, $elt->{'att'}->{$att});
9627 $elt->del_att( $att);
9628 return $elt;
9629 }
9630
9631# sort children methods
9632
9633sub sort_children_on_field
9634 { my $elt = shift;
9635 my $field = shift;
9636 my $get_key= sub { return $_[0]->field( $field) };
9637 return $elt->sort_children( $get_key, @_);
9638 }
9639
9640sub sort_children_on_att
9641 { my $elt = shift;
9642 my $att = shift;
9643 my $get_key= sub { return $_[0]->{'att'}->{$att} };
9644 return $elt->sort_children( $get_key, @_);
9645 }
9646
9647sub sort_children_on_value
9648 { my $elt = shift;
9649 #my $get_key= eval qq{ sub { $NO_WARNINGS; return \$_[0]->text } };
9650 my $get_key= \&text;
9651 return $elt->sort_children( $get_key, @_);
9652 }
9653
9654sub sort_children
9655 { my( $elt, $get_key, %opt)=@_;
9656 $opt{order} ||= 'normal';
9657 $opt{type} ||= 'alpha';
9658 my( $par_a, $par_b)= ($opt{order} eq 'reverse') ? qw( b a) : qw ( a b) ;
9659 my $op= ($opt{type} eq 'numeric') ? '<=>' : 'cmp' ;
9660 my @children= $elt->cut_children;
9661 if( $opt{type} eq 'numeric')
9662 { @children= map { $_->[1] }
9663 sort { $a->[0] <=> $b->[0] }
9664 map { [ $get_key->( $_), $_] } @children;
9665 }
9666 elsif( $opt{type} eq 'alpha')
9667 { @children= map { $_->[1] }
9668 sort { $a->[0] cmp $b->[0] }
9669 map { [ $get_key->( $_), $_] } @children;
9670 }
9671 else
9672 { croak "wrong sort type '$opt{type}', should be either 'alpha' or 'numeric'"; }
9673
9674 @children= reverse @children if( $opt{order} eq 'reverse');
9675 $elt->set_content( @children);
9676 }
9677
9678
9679# comparison methods
9680
9681sub before
9682 { my( $a, $b)=@_;
9683 if( $a->cmp( $b) == -1) { return 1; } else { return 0; }
9684 }
9685
9686sub after
9687 { my( $a, $b)=@_;
9688 if( $a->cmp( $b) == 1) { return 1; } else { return 0; }
9689 }
9690
9691sub lt
9692 { my( $a, $b)=@_;
9693 return 1 if( $a->cmp( $b) == -1);
9694 return 0;
9695 }
9696
9697sub le
9698 { my( $a, $b)=@_;
9699 return 1 unless( $a->cmp( $b) == 1);
9700 return 0;
9701 }
9702
9703sub gt
9704 { my( $a, $b)=@_;
9705 return 1 if( $a->cmp( $b) == 1);
9706 return 0;
9707 }
9708
9709sub ge
9710 { my( $a, $b)=@_;
9711 return 1 unless( $a->cmp( $b) == -1);
9712 return 0;
9713 }
9714
9715
9716sub cmp
97177710µs
# spent 1.42ms (479µs+937µs) within XML::Twig::Elt::cmp which was called 77 times, avg 18µs/call: # 77 times (479µs+937µs) by CORE::sort at line 3696, avg 18µs/call
{ my( $a, $b)=@_;
9718
9719 # easy cases
97207710µs return 0 if( $a == $b);
97217728µs77161µs return 1 if( $a->in($b)); # a in b => a starts after b
# spent 161µs making 77 calls to XML::Twig::Elt::in, avg 2µs/call
97227725µs77127µs return -1 if( $b->in($a)); # b in a => a starts before b
# spent 127µs making 77 calls to XML::Twig::Elt::in, avg 2µs/call
9723
9724 # ancestors does not include the element itself
97257734µs77325µs my @a_pile= ($a, $a->ancestors);
# spent 325µs making 77 calls to XML::Twig::Elt::ancestors, avg 4µs/call
97267729µs77324µs my @b_pile= ($b, $b->ancestors);
# spent 324µs making 77 calls to XML::Twig::Elt::ancestors, avg 4µs/call
9727
9728 # the 2 elements are not in the same twig
97297712µs return undef unless( $a_pile[-1] == $b_pile[-1]);
9730
9731 # find the first non common ancestors (they are siblings)
9732778µs my $a_anc= pop @a_pile;
9733776µs my $b_anc= pop @b_pile;
9734
97357716µs while( $a_anc == $b_anc)
973617815µs { $a_anc= pop @a_pile;
973717834µs $b_anc= pop @b_pile;
9738 }
9739
9740 # from there move left and right and figure out the order
97417713µs my( $a_prev, $a_next, $b_prev, $b_next)= ($a_anc, $a_anc, $b_anc, $b_anc);
9742774µs while()
97439725µs { $a_prev= $a_prev->{prev_sibling} || return( -1);
97448333µs return 1 if( $a_prev == $b_next);
9745576µs $a_next= $a_next->{next_sibling} || return( 1);
97465720µs return -1 if( $a_next == $b_prev);
97474219µs $b_prev= $b_prev->{prev_sibling} || return( 1);
97483811µs return -1 if( $b_prev == $a_next);
9749313µs $b_next= $b_next->{next_sibling} || return( -1);
97503114µs return 1 if( $b_next == $a_prev);
9751 }
9752 }
9753
9754sub _dump
9755 { my( $elt, $option)= @_;
9756
9757 my $atts = defined $option->{atts} ? $option->{atts} : 1;
9758 my $extra = defined $option->{extra} ? $option->{extra} : 0;
9759 my $short_text = defined $option->{short_text} ? $option->{short_text} : 40;
9760
9761 my $sp= '| ';
9762 my $indent= $sp x $elt->level;
9763 my $indent_sp= ' ' x $elt->level;
9764
9765 my $dump='';
9766 if( $elt->is_elt)
9767 {
9768 $dump .= $indent . '|-' . $XML::Twig::index2gi[$elt->{'gi'}];
9769
9770 if( $atts && (my @atts= $elt->att_names) )
9771 { $dump .= ' ' . join( ' ', map { qq{$_="} . $elt->{'att'}->{$_} . qq{"} } @atts); }
9772
9773 $dump .= "\n";
9774 if( $extra) { $dump .= $elt->_dump_extra_data( $indent, $indent_sp, $short_text); }
9775 $dump .= join( "", map { $_->_dump( $option) } do { my $elt= $elt; my @children=(); my $child= $elt->{first_child}; while( $child) { push @children, $child; $child= $child->{next_sibling}; } @children; });
9776 }
9777 else
9778 {
9779 if( (exists $elt->{'pcdata'}))
9780 { $dump .= "$indent|-PCDATA: '" . _short_text( $elt->{pcdata}, $short_text) . "'\n" }
9781 elsif( (exists $elt->{'ent'}))
9782 { $dump .= "$indent|-ENTITY: '" . _short_text( $elt->{ent}, $short_text) . "'\n" }
9783 elsif( (exists $elt->{'cdata'}))
9784 { $dump .= "$indent|-CDATA: '" . _short_text( $elt->{cdata}, $short_text) . "'\n" }
9785 elsif( (exists $elt->{'comment'}))
9786 { $dump .= "$indent|-COMMENT: '" . _short_text( $elt->comment_string, $short_text) . "'\n" }
9787 elsif( (exists $elt->{'target'}))
9788 { $dump .= "$indent|-PI: '" . $elt->{target} . "' - '" . _short_text( $elt->{data}, $short_text) . "'\n" }
9789 if( $extra) { $dump .= $elt->_dump_extra_data( $indent, $indent_sp, $short_text); }
9790 }
9791 return $dump;
9792 }
9793
9794sub _dump_extra_data
9795 { my( $elt, $indent, $indent_sp, $short_text)= @_;
9796 my $dump='';
9797 if( $elt->extra_data)
9798 { my $extra_data = $indent . "|-- (cpi before) '" . _short_text( $elt->extra_data, $short_text) . "'";
9799 $extra_data=~ s{\n}{$indent_sp}g;
9800 $dump .= $extra_data . "\n";
9801 }
9802 if( $elt->{extra_data_in_pcdata})
9803 { foreach my $data ( @{$elt->{extra_data_in_pcdata}})
9804 { my $extra_data = $indent . "|-- (cpi offset $data->{offset}) '" . _short_text( $data->{text}, $short_text) . "'";
9805 $extra_data=~ s{\n}{$indent_sp}g;
9806 $dump .= $extra_data . "\n";
9807 }
9808 }
9809 if( $elt->{extra_data_before_end_tag})
9810 { my $extra_data = $indent . "|-- (cpi end) '" . _short_text( $elt->{extra_data_before_end_tag}, $short_text) . "'";
9811 $extra_data=~ s{\n}{$indent_sp}g;
9812 $dump .= $extra_data . "\n";
9813 }
9814 return $dump;
9815 }
9816
9817
9818sub _short_text
9819 { my( $string, $length)= @_;
9820 if( !$length || (length( $string) < $length) ) { return $string; }
9821 my $l1= (length( $string) -5) /2;
9822 my $l2= length( $string) - ($l1 + 5);
9823 return substr( $string, 0, $l1) . ' ... ' . substr( $string, -$l2);
9824 }
9825
9826
9827712µs713µs
# spent 26µs (13+13) within XML::Twig::Elt::_and which was called 7 times, avg 4µs/call: # 7 times (13µs+13µs) by XML::Twig::Elt::_gi_test at line 5917, avg 4µs/call
sub _and { return _join_defined( ' && ', @_); }
# spent 13µs making 7 calls to XML::Twig::Elt::_join_defined, avg 2µs/call
9828715µs
# spent 13µs within XML::Twig::Elt::_join_defined which was called 7 times, avg 2µs/call: # 7 times (13µs+0s) by XML::Twig::Elt::_and at line 9827, avg 2µs/call
sub _join_defined { return join( shift(), grep { $_ } @_); }
9829
9830161µs1;
9831__END__
 
# spent 600ns within Spreadsheet::ParseXLSX::__ANON__ which was called: # once (600ns+0s) by Spreadsheet::ParseXLSX::BEGIN@14 at line 14 of /home/micha/Projekt/spreadsheet-parsexlsx/lib/Spreadsheet/ParseXLSX.pm
sub Spreadsheet::ParseXLSX::__ANON__; # xsub