-
Notifications
You must be signed in to change notification settings - Fork 20
/
speedup
98 lines (69 loc) · 4.55 KB
/
speedup
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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
#!/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 $FORMER = join( '|', qw( parent prev_sibling next_sibling)); # former_$former is inlined
my $SET_FIELD = join( '|', qw( first_child next_sibling ent data pctarget comment flushed));
my $SET_NOT_EMPTY= join( '|', qw( pcdata cdata comment)); # set the field
# depending on the version of perl use either qr or ""
print STDERR "perl version is $]\n";
my $var= '(\$[a-z_]+(?:\[\d\])?|\$t(?:wig)?->root|\$t(?:wig)?->twig_current|\$t(?:wig)?->\{\'?twig_root\'?}|\$t(?:wig)?->\{\'?twig_current\'?})';
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);
(my $version= $])=~ s{\.}{}g;
while( <>)
{
if( $] <= 5.005) { s{qr/(.*?)/}{"$1"} };
# when finding a comment # perl > 5.8 or # perl < 5.5, process accordingly
if( my( $op, $v, $mv)= m{#\s*(>|<|>=|<=)\s*perl\s*5\.(\d+)(?:\.(\d+))?\s*})
{ $v= sprintf( "5%03d%03d", $v, $mv || 0);
my $comp= "$version $op $v";
if( ! eval $comp) { print "#$_"; next; }
else { s{#[^#]*\n}{\n} if m{^=encoding}; }
}
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)/delete $1\->{'$2'}/g;
s/$var->set_(twig_current)/$1\->{'$2'}=1/g;
s/$var->_del_(flushed)/delete $1\->{'$2'}/g;
s/$var->_set_(flushed)/$1\->{'$2'}=1/g;
s/$var->_(flushed)/$1\->{'$2'}/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)->former_($FORMER)}{($1\->{former} && $1\->{former}\->{$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/$var->set_($SET_NOT_EMPTY)\(([^)]*)\)/$1\->\{$2\}= (delete $1->\{empty\} || 1) && $3/g;
s/$var->_set_($SET_NOT_EMPTY)\s*\(([^)]*)\)/$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->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 $_ ;
}