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