1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
#!/usr/bin/perl
my $FIELD = join( '|', qw( parent first_child last_child prev_sibling next_sibling pcdata cdata ent data target cdata pcdata comment flushed));
my $PRIVATE = join( '|', qw( parent first_child last_child prev_sibling next_sibling pcdata cdata comment
extra_data_in_pcdata extra_data_before_end_tag
)
); # _$private is inlined
my $SET_FIELD = join( '|', qw( first_child next_sibling ent data target comment flushed));
# depending on the version of perl use either qr or ""
print STDERR "perl version is $]\n";
my $var= '(\$[a-z_]+(?:\[\d\])?)';
my $set_to = '(?:undef|\$\w+|\$\w+->{\w+}|\$\w+->\w+|\$\w+->\w+\([^)]+\))';
my $elt = '\$(?:elt|new_elt|child|cdata|ent|_?parent|twig_current|next_sibling|first_child|prev_sibling|last_child|ref|elt->_parent)';
my %gi2index=( '', 0, PCDATA => 1, CDATA => 2, PI => 3, COMMENT => 4, ENT => 5);
while( <>)
{
if( $] <= 5.005) { s{qr/(.*?)/}{"$1"} };
if( $] < 5.006) { if( m{# > perl 5.5}) { next; } }
if( $] !~ m{^5.006}) { if( m{# = perl 5.6}) { next; } }
if( $] < 5.006) { s{^(\s*)no warnings;} {$1# no warnings;}; }
else { s{^(\s*)# no warnings; } {$1no warnings;}; }
if( /=/)
{ s/$var->_children/do { my \$elt= $1; my \@children=(); my \$child= \$elt->_first_child; while( \$child) { push \@children, \$child; \$child= \$child->_next_sibling; } \@children; }/; }
s/$var->set_gi\(\s*(PCDATA|CDATA|PI|COMMENT|ENT)\s*\)/$1\->{gi}= $gi2index{$2}/;
s/$var->del_(twig_current|flushed)/delete $1\->{'$2'}/g;
s/$var->set_(twig_current|flushed)/$1\->{'$2'}=1/g;
s/$var->set_($SET_FIELD)\(([^)]*)\)/$1\->\{$2\}= $3/g;
s/$var->($FIELD)\b(?!\()/$1\->\{$2\}/g;
#s/$var->_($PRIVATE)\b(?!\()/$1\->\{$2\}/g;
s/$var->_($PRIVATE)\b(\s*\(\s*\))?(?!\s*\()/$1\->\{$2\}/g;
s{($elt)->set_(parent|prev_sibling)\(\s*($set_to)\s*\)}{$1\->{$2}=$3; if( \$XML::Twig::weakrefs) { weaken( $1\->{$2});} }g;
s{($elt)->set_(first_child)\(\s*($set_to)\s*\)}{ $1\->set_not_empty; $1\->{$2}=$3; }g;
s{($elt)->set_(next_sibling)\(\s*($set_to)\s*\)}{ $1\->{$2}=$3; }g;
s{($elt)->set_(last_child)\(\s*($set_to)\s*\)}{ $1\->set_not_empty; $1\->{$2}=$3; if( \$XML::Twig::weakrefs) { weaken( $1\->{$2});} }g;
s/$var->atts/$1\->{att}/g;
s/$var->append_(pcdata|cdata)\(([^)]*)\)/$1\->\{$2\}.= $3/g;
s/(\$[a-z][a-z_]*(?:\[\d\])?)->gi/\$XML::Twig::index2gi\[$1\->{'gi'}\]/g;
s/$var->id/$1\->{'att'}->{\$ID}/g;
s/$var->att\(\s*([^)]+)\)/$1\->{'att'}->\{$2\}/g;
s/(\$[a-z][a-z_]*(?:\[\d\])?)->is_pcdata/(exists $1\->{'pcdata'})/g;
s/(\$[a-z][a-z_]*(?:\[\d\])?)->is_cdata/(exists $1\->{'cdata'})/g;
s/$var->is_pi/(exists $1\->{'target'})/g;
s/$var->is_comment/(exists $1\->{'comment'})/g;
s/$var->is_ent/(exists $1\->{'ent'})/g;
s/(\$,a-z][a-z_]*(?:\[\d\])?)->is_text/((exists $1\->{'pcdata'}) || (exists $1\->{'cdata'}))/g;
s/$var->is_empty/$1\->{'empty'}/g;
s/$var->set_empty(?:\(([^)]*)\))?(?!_)/"$1\->{empty}= " . ($2 || 1)/ge;
s/$var->set_not_empty/delete $1\->{empty}/g;
s/$var->_is_private/( (substr( \$XML::Twig::index2gi\[$1\->{'gi'}\], 0, 1) eq '#') && (substr( \$XML::Twig::index2gi\[$1\->{'gi'}\], 0, 9) ne '#default:') )/g;
#s/_is_private_name\(\s*$var\s*\)/( (substr( $1, 0, 1) eq '#') && (substr( $1, 0, 9) ne '#default:') )/g;
s/_is_private_name\(\s*$var\s*\)/( $1=~ m{^#(?!default:)} )/g;
s{_is_fh\(\s*$var\)}{isa( $1, 'GLOB') || isa( $1, 'IO::Scalar')}g;
# $var->set_gi( $gi): set the gi, but if it doesn't exist, call the original set_gi
s/$var->set_gi\s*\(\s*([^)]*)\s*\)/$1\->{gi}=\$XML::Twig::gi2index{$2} or $1->set_gi( $2)/g;
s/$var->xml_string/$1->sprint( 1)/g;
print $_ ;
}
|
