Filename | /var/www/foswikidev/core/lib/Foswiki/Macros/ENCODE.pm |
Statements | Executed 202 statements in 667µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
15 | 1 | 1 | 99µs | 99µs | ENCODE | Foswiki::
1 | 1 | 1 | 17µs | 31µs | BEGIN@4.116 | Foswiki::
1 | 1 | 1 | 10µs | 15µs | BEGIN@5.117 | Foswiki::
1 | 1 | 1 | 4µs | 4µs | BEGIN@8.118 | Foswiki::
0 | 0 | 0 | 0s | 0s | _s2d | Foswiki::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # See bottom of file for license and copyright information | ||||
2 | package Foswiki; | ||||
3 | |||||
4 | 2 | 29µs | 2 | 46µs | # spent 31µs (17+15) within Foswiki::BEGIN@4.116 which was called:
# once (17µs+15µs) by Foswiki::_expandMacroOnTopicRendering at line 4 # spent 31µs making 1 call to Foswiki::BEGIN@4.116
# spent 15µs making 1 call to strict::import |
5 | 2 | 73µs | 2 | 20µs | # spent 15µs (10+5) within Foswiki::BEGIN@5.117 which was called:
# once (10µs+5µs) by Foswiki::_expandMacroOnTopicRendering at line 5 # spent 15µs making 1 call to Foswiki::BEGIN@5.117
# spent 5µs making 1 call to warnings::import |
6 | 1 | 5µs | my @DIG = map { chr($_) } ( 0 .. 9 ); | ||
7 | |||||
8 | # spent 4µs within Foswiki::BEGIN@8.118 which was called:
# once (4µs+0s) by Foswiki::_expandMacroOnTopicRendering at line 13 | ||||
9 | 1 | 5µs | if ( $Foswiki::cfg{UseLocale} ) { | ||
10 | require locale; | ||||
11 | import locale(); | ||||
12 | } | ||||
13 | 1 | 435µs | 1 | 4µs | } # spent 4µs making 1 call to Foswiki::BEGIN@8.118 |
14 | |||||
15 | # Returns a decimal number encoded as a string where each digit is | ||||
16 | # replaced by an unprintable character | ||||
17 | sub _s2d { | ||||
18 | return join( '', map { chr( int($_) ) } split( '', shift ) ); | ||||
19 | } | ||||
20 | |||||
21 | # spent 99µs within Foswiki::ENCODE which was called 15 times, avg 7µs/call:
# 15 times (99µs+0s) by Foswiki::_expandMacroOnTopicRendering at line 3435 of /var/www/foswikidev/core/lib/Foswiki.pm, avg 7µs/call | ||||
22 | 15 | 6µs | my ( $this, $params ) = @_; | ||
23 | |||||
24 | 15 | 4µs | my $old = $params->{old}; | ||
25 | 15 | 3µs | my $new = $params->{new}; | ||
26 | 15 | 5µs | my $type = $params->{type}; | ||
27 | |||||
28 | 15 | 5µs | if ( defined $type && ( defined $old || defined $new ) ) { | ||
29 | return $this->inlineAlert( 'alerts', 'ENCODE_bad_1' ); | ||||
30 | } | ||||
31 | 15 | 5µs | if ( defined $old && !defined $new || !defined $old && defined $new ) { | ||
32 | return $this->inlineAlert( 'alerts', 'ENCODE_bad_2' ); | ||||
33 | } | ||||
34 | |||||
35 | 15 | 5µs | my $text = $params->{_DEFAULT}; | ||
36 | 15 | 2µs | $text = '' unless defined $text; | ||
37 | |||||
38 | 15 | 1µs | if ( defined $old ) { | ||
39 | my @old = split( ',', $old ); | ||||
40 | my @new = split( ',', $new ); | ||||
41 | while ( scalar(@new) < scalar(@old) ) { | ||||
42 | push( @new, '' ); | ||||
43 | } | ||||
44 | |||||
45 | # The double loop is to make it behave like tr///. The first loop | ||||
46 | # locates the tokens to replace, and the second loop subs them. | ||||
47 | my %toks; # detect repeated tokens | ||||
48 | for ( my $i = 0 ; $i <= $#old ; $i++ ) { | ||||
49 | my $e = _s2d($i); | ||||
50 | my $o = $old[$i]; | ||||
51 | if ( $toks{$o} ) { | ||||
52 | return $this->inlineAlert( 'alerts', 'ENCODE_bad_3', $o ); | ||||
53 | } | ||||
54 | $toks{$o} = 1; | ||||
55 | $o = quotemeta( expandStandardEscapes($o) ); | ||||
56 | $text =~ s/$o/$e/ge; | ||||
57 | } | ||||
58 | for ( my $i = 0 ; $i <= $#new ; $i++ ) { | ||||
59 | my $e = _s2d($i); | ||||
60 | my $n = expandStandardEscapes( $new[$i] ); | ||||
61 | $text =~ s/$e/$n/g; | ||||
62 | } | ||||
63 | return $text; | ||||
64 | } | ||||
65 | |||||
66 | 15 | 2µs | $type ||= 'url'; | ||
67 | |||||
68 | 15 | 28µs | if ( $type =~ m/^entit(y|ies)$/i ) { | ||
69 | return entityEncode($text); | ||||
70 | } | ||||
71 | elsif ( $type =~ m/^html$/i ) { | ||||
72 | return entityEncode( $text, "\n\r" ); | ||||
73 | } | ||||
74 | elsif ( $type =~ m/^quotes?$/i ) { | ||||
75 | |||||
76 | # escape quotes with backslash (Bugs:Item3383 fix) | ||||
77 | 15 | 10µs | $text =~ s/\"/\\"/g; | ||
78 | 15 | 40µs | return $text; | ||
79 | } | ||||
80 | elsif ( $type =~ m/^url$/i ) { | ||||
81 | |||||
82 | # This is legacy, stretching back to 2001. Checkin comment was: | ||||
83 | # "Fixed URL encoding". At that time it related to the encoding of | ||||
84 | # parameters to the "oops" script exclusively. I'm taking it out | ||||
85 | # because I can't see any situation in which it might have been | ||||
86 | # used in anger. | ||||
87 | # $text =~ s/\r*\n\r*/<br \/>/; | ||||
88 | return urlEncode($text); | ||||
89 | } | ||||
90 | elsif ( $type =~ m/^(off|none)$/i ) { | ||||
91 | |||||
92 | # no encoding | ||||
93 | return $text; | ||||
94 | } | ||||
95 | else { # safe | ||||
96 | # entity encode ' " < > and % | ||||
97 | $text =~ s/([<>%'"])/'&#'.ord($1).';'/ge; | ||||
98 | return $text; | ||||
99 | } | ||||
100 | } | ||||
101 | |||||
102 | 1 | 4µs | 1; | ||
103 | __END__ |