← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 19:05:14 2015
Reported on Fri Jul 31 19:08:10 2015

Filename/var/www/foswiki11/lib/Foswiki/Compatibility.pm
StatementsExecuted 357 statements in 2.39ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1411259µs585µsFoswiki::Compatibility::::readSymmetricallyEncodedMETAFoswiki::Compatibility::readSymmetricallyEncodedMETA
4011123µs123µsFoswiki::Compatibility::::_symmetricalDataDecodeFoswiki::Compatibility::_symmetricalDataDecode
11119µs45µsFoswiki::Compatibility::::BEGIN@4Foswiki::Compatibility::BEGIN@4
11116µs32µsFoswiki::Compatibility::::BEGIN@5Foswiki::Compatibility::BEGIN@5
11115µs45µsFoswiki::Compatibility::::BEGIN@6Foswiki::Compatibility::BEGIN@6
0000s0sFoswiki::Compatibility::::_getOldAttachAttrFoswiki::Compatibility::_getOldAttachAttr
0000s0sFoswiki::Compatibility::::_makeBadAnchorNameFoswiki::Compatibility::_makeBadAnchorName
0000s0sFoswiki::Compatibility::::_upgradeCategoryItemFoswiki::Compatibility::_upgradeCategoryItem
0000s0sFoswiki::Compatibility::::makeCompatibleAnchorsFoswiki::Compatibility::makeCompatibleAnchors
0000s0sFoswiki::Compatibility::::migrateToFileAttachmentMacroFoswiki::Compatibility::migrateToFileAttachmentMacro
0000s0sFoswiki::Compatibility::::upgradeCategoryTableFoswiki::Compatibility::upgradeCategoryTable
0000s0sFoswiki::Compatibility::::upgradeFrom1v0betaFoswiki::Compatibility::upgradeFrom1v0beta
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# See bottom of file for license and copyright information
2package Foswiki::Compatibility;
3
4241µs271µs
# spent 45µs (19+26) within Foswiki::Compatibility::BEGIN@4 which was called: # once (19µs+26µs) by Foswiki::Meta::setEmbeddedStoreForm at line 4
use strict;
# spent 45µs making 1 call to Foswiki::Compatibility::BEGIN@4 # spent 26µs making 1 call to strict::import
5233µs248µs
# spent 32µs (16+15) within Foswiki::Compatibility::BEGIN@5 which was called: # once (16µs+15µs) by Foswiki::Meta::setEmbeddedStoreForm at line 5
use warnings;
# spent 32µs making 1 call to Foswiki::Compatibility::BEGIN@5 # spent 16µs making 1 call to warnings::import
621.93ms275µs
# spent 45µs (15+30) within Foswiki::Compatibility::BEGIN@6 which was called: # once (15µs+30µs) by Foswiki::Meta::setEmbeddedStoreForm at line 6
use Assert;
# spent 45µs making 1 call to Foswiki::Compatibility::BEGIN@6 # spent 30µs making 1 call to Assert::import
7
8=begin TML
9
10---+ package Foswiki::Compatibility
11
12Support for compatibility with old versions. Packaged
13separately because 99.999999% of the time this won't be needed.
14
15=cut
16
17sub _upgradeCategoryItem {
18 my ( $catitems, $ctext ) = @_;
19 my $catname = '';
20 my $scatname = '';
21 my $catmodifier = '';
22 my $catvalue = '';
23 my @cmd = split( /\|/, $catitems );
24 my $src = '';
25 my $len = @cmd;
26 if ( $len < '2' ) {
27
28 # FIXME
29 return ( $catname, $catmodifier, $catvalue );
30 }
31 my $svalue = '';
32
33 my $i;
34 my $itemsPerLine;
35
36 # check for CategoryName=CategoryValue parameter
37 my $paramCmd = '';
38 my $cvalue = ''; # was$query->param( $cmd[1] );
39 if ($cvalue) {
40 $src = "<!---->$cvalue<!---->";
41 }
42 elsif ($ctext) {
43 foreach ( split( /\r?\n/, $ctext ) ) {
44 if (/$cmd[1]/) {
45 $src = $_;
46 last;
47 }
48 }
49 }
50
51 if ( $cmd[0] eq 'select' || $cmd[0] eq 'radio' ) {
52 $catname = $cmd[1];
53 $scatname = $catname;
54
55 #$scatname =~ s/[^a-zA-Z0-9]//g;
56 my $size = $cmd[2];
57 for ( $i = 3 ; $i < $len ; $i++ ) {
58 my $value = $cmd[$i];
59 $svalue = $value;
60 if ( $src =~ /$value/ ) {
61 $catvalue = $svalue;
62 }
63 }
64
65 }
66 elsif ( $cmd[0] eq 'checkbox' ) {
67 $catname = $cmd[1];
68 $scatname = $catname;
69
70 #$scatname =~ s/[^a-zA-Z0-9]//g;
71 if ( $cmd[2] eq 'true' || $cmd[2] eq '1' ) {
72 $i = $len - 4;
73 $catmodifier = 1;
74 }
75 $itemsPerLine = $cmd[3];
76 for ( $i = 4 ; $i < $len ; $i++ ) {
77 my $value = $cmd[$i];
78 $svalue = $value;
79
80 # I18N: FIXME - need to look at this, but since it's upgrading
81 # old forms that probably didn't use I18N, it's not a high
82 # priority.
83 if ( $src =~ /$value[^a-zA-Z0-9\.]/ ) {
84 $catvalue .= ", " if ($catvalue);
85 $catvalue .= $svalue;
86 }
87 }
88
89 }
90 elsif ( $cmd[0] eq 'text' ) {
91 $catname = $cmd[1];
92 $scatname = $catname;
93
94 #$scatname =~ s/[^a-zA-Z0-9]//g;
95 # SMELL: unchecked implicit untaint?
96 $src =~ /<!---->(.*)<!---->/;
97 if ($1) {
98 $src = $1;
99 }
100 else {
101 $src = '';
102 }
103 $catvalue = $src;
104 }
105
106 return ( $catname, $catmodifier, $catvalue );
107}
108
109=begin TML
110
111---++ StaticMethod upgradeCategoryTable( $session, $web, $topic, $meta, $text ) -> $text
112
113Upgrade old style category table
114
115May throw Foswiki::OopsException
116
117=cut
118
119sub upgradeCategoryTable {
120 my ( $session, $web, $topic, $meta, $text ) = @_;
121
122 my $icat =
123 $session->templates->readTemplate( 'twikicatitems', no_oops => 1 );
124
125 if ($icat) {
126 my @items = ();
127
128 # extract category section and build category form elements
129 my ( $before, $ctext, $after ) = split( /<!--TWikiCat-->/, $text );
130
131 # cut TWikiCat part
132 $text = $before || '';
133 $text .= $after if ($after);
134 $ctext = '' if ( !$ctext );
135
136 my $ttext = '';
137 foreach ( split( /\r?\n/, $icat ) ) {
138 my ( $catname, $catmod, $catvalue ) =
139 _upgradeCategoryItem( $_, $ctext );
140 if ($catname) {
141 push @items, ( [ $catname, $catmod, $catvalue ] );
142 }
143 }
144 my $prefs = $session->{prefs};
145 my $webObject = Foswiki::Meta->new( $session, $web );
146 my $listForms = $webObject->getPreference('WEBFORMS');
147 $listForms =~ s/^\s*//go;
148 $listForms =~ s/\s*$//go;
149 my @formTemplates = split( /\s*,\s*/, $listForms );
150 my $defaultFormTemplate = '';
151 $defaultFormTemplate = $formTemplates[0] if (@formTemplates);
152
153 if ( !$defaultFormTemplate ) {
154 $session->logger->log( 'warning',
155 "Form: can't get form definition to convert category table "
156 . " for topic $web.$topic" );
157 foreach my $oldCat (@items) {
158 my $name = $oldCat->[0];
159 my $value = $oldCat->[2];
160 $meta->put( 'FORM', { name => '' } );
161 $meta->putKeyed(
162 'FIELD',
163 {
164 name => $name,
165 title => $name,
166 value => $value
167 }
168 );
169 }
170 return;
171 }
172
173 require Foswiki::Form;
174 my $def = new Foswiki::Form( $session, $web, $defaultFormTemplate );
175 $meta->put( 'FORM', { name => $defaultFormTemplate } );
176
177 foreach my $fieldDef ( @{ $def->getFields() } ) {
178 my $value = '';
179 foreach my $oldCatP (@items) {
180 my @oldCat = @$oldCatP;
181 my $name = $oldCat[0] || '';
182 $name =~ s/[^A-Za-z0-9_\.]//go;
183 if ( $name eq $fieldDef->{name} ) {
184 $value = $oldCat[2];
185 last;
186 }
187 }
188 $meta->putKeyed(
189 'FIELD',
190 {
191 name => $fieldDef->{name},
192 title => $fieldDef->{title},
193 value => $value,
194 }
195 );
196 }
197
198 }
199 else {
200
201 # We used to log a warning but it only made noise and trouble
202 # People will not need to be warned any longer. Item1440
203 }
204 return $text;
205}
206
207#Get file attachment attributes for old html
208#format.
209sub _getOldAttachAttr {
210 my ( $session, $atext ) = @_;
211 my $fileName = '';
212 my $filePath = '';
213 my $fileSize = '';
214 my $fileDate = '';
215 my $fileUser = '';
216 my $fileComment = '';
217 my $before = '';
218 my $item = '';
219 my $after = '';
220 my $users = $session->{users};
221
222 ( $before, $fileName, $after ) = split( /<(?:\/)*TwkFileName>/, $atext );
223 if ( !$fileName ) { $fileName = ''; }
224 if ($fileName) {
225 ( $before, $filePath, $after ) =
226 split( /<(?:\/)*TwkFilePath>/, $atext );
227 if ( !$filePath ) { $filePath = ''; }
228
229 # SMELL: unchecked implicit untaint
230 $filePath =~ s/<TwkData value="(.*)">//go;
231 if ($1) { $filePath = $1; }
232 else { $filePath = ''; }
233 $filePath =~
234 s/\%NOP\%//goi; # delete placeholder that prevents WikiLinks
235 ( $before, $fileSize, $after ) =
236 split( /<(?:\/)*TwkFileSize>/, $atext );
237 if ( !$fileSize ) { $fileSize = '0'; }
238 ( $before, $fileDate, $after ) =
239 split( /<(?:\/)*TwkFileDate>/, $atext );
240
241 if ( !$fileDate ) {
242 $fileDate = '';
243 }
244 else {
245 $fileDate =~ s/&nbsp;/ /go;
246 require Foswiki::Time;
247 $fileDate = Foswiki::Time::parseTime($fileDate);
248 }
249 ( $before, $fileUser, $after ) =
250 split( /<(?:\/)*TwkFileUser>/, $atext );
251 if ( !$fileUser ) {
252 $fileUser = '';
253 }
254 else {
255 $fileUser = $users->getLoginName($fileUser) if $fileUser;
256 }
257 $fileUser ||= '';
258 $fileUser =~ s/ //go;
259 ( $before, $fileComment, $after ) =
260 split( /<(?:\/)*TwkFileComment>/, $atext );
261 if ( !$fileComment ) { $fileComment = ''; }
262 }
263
264 return ( $fileName, $filePath, $fileSize, $fileDate, $fileUser,
265 $fileComment );
266}
267
268=begin TML
269
270---++ migrateToFileAttachmentMacro ( $session, $meta, $text ) -> $text
271
272Migrate old HTML format
273
274=cut
275
276sub migrateToFileAttachmentMacro {
277 my ( $session, $meta, $text ) = @_;
278 ASSERT( $meta->isa('Foswiki::Meta') ) if DEBUG;
279
280 my ( $before, $atext, $after ) = split( /<!--TWikiAttachment-->/, $text );
281 $text = $before || '';
282 $text .= $after if ($after);
283 $atext = '' if ( !$atext );
284
285 if ( $atext =~ /<TwkNextItem>/ ) {
286 my $line = '';
287 foreach $line ( split( /<TwkNextItem>/, $atext ) ) {
288 my (
289 $fileName, $filePath, $fileSize,
290 $fileDate, $fileUser, $fileComment
291 ) = _getOldAttachAttr( $session, $line );
292
293 if ($fileName) {
294 $meta->putKeyed(
295 'FILEATTACHMENT',
296 {
297 name => $fileName,
298 version => '',
299 path => $filePath,
300 size => $fileSize,
301 date => $fileDate,
302 user => $fileUser,
303 comment => $fileComment,
304 attr => ''
305 }
306 );
307 }
308 }
309 }
310 else {
311
312 # Format of macro that came before META:ATTACHMENT
313 my $line = '';
314 require Foswiki::Attrs;
315 foreach $line ( split( /\r?\n/, $atext ) ) {
316 if ( $line =~ /%FILEATTACHMENT{\s"([^"]*)"([^}]*)}%/ ) {
317 my $name = $1;
318 my $values = new Foswiki::Attrs($2);
319 $values->{name} = $name;
320 $meta->putKeyed( 'FILEATTACHMENT', $values );
321 }
322 }
323 }
324
325 return $text;
326}
327
328=begin TML
329
330---++ upgradeFrom1v0beta ( $session, $meta ) -> $text
331
332=cut
333
334sub upgradeFrom1v0beta {
335 my ( $session, $meta ) = @_;
336 my $users = $session->{users};
337 require Foswiki::Time;
338
339 my @attach = $meta->find('FILEATTACHMENT');
340 foreach my $att (@attach) {
341 my $date = $att->{date} || 0;
342 if ( $date =~ /-/ ) {
343 $date =~ s/&nbsp;/ /go;
344 $date = Foswiki::Time::parseTime($date);
345 }
346 $att->{date} = $date;
347 $att->{user} = $users->webDotWikiName( $att->{user} );
348 }
349}
350
351# Read meta-data encoded using the discredited symmetrical encoding
352# method from pre 1.1
353
# spent 585µs (259+325) within Foswiki::Compatibility::readSymmetricallyEncodedMETA which was called 14 times, avg 42µs/call: # 14 times (259µs+325µs) by Foswiki::Meta::setEmbeddedStoreForm at line 3614 of /var/www/foswiki11/lib/Foswiki/Meta.pm, avg 42µs/call
sub readSymmetricallyEncodedMETA {
3541420µs my ( $meta, $type, $args ) = @_;
355
356146µs my $keys = {};
357
3581477µs $args =~ s/\s*([^=]+)="([^"]*)"/
3594040µs40123µs _symmetricalDataDecode( $1, $2, $keys )/ge;
# spent 123µs making 40 calls to Foswiki::Compatibility::_symmetricalDataDecode, avg 3µs/call
360
3611422µs14203µs if ( defined( $keys->{name} ) ) {
# spent 203µs making 14 calls to Foswiki::Meta::putKeyed, avg 14µs/call
362
363 # don't attempt to save it keyed unless it has a name
364 $meta->putKeyed( $type, $keys );
365 }
366 else {
367 $meta->put( $type, $keys );
368 }
3691429µs return 1;
370}
371
372
# spent 123µs within Foswiki::Compatibility::_symmetricalDataDecode which was called 40 times, avg 3µs/call: # 40 times (123µs+0s) by Foswiki::Compatibility::readSymmetricallyEncodedMETA at line 359, avg 3µs/call
sub _symmetricalDataDecode {
3734033µs my ( $key, $value, $res ) = @_;
374
375 # Old decoding retained for backward compatibility.
376 # This encoding is badly broken, because the encoded
377 # symbols are symmetrical, and use an encoded symbol (%).
3784010µs $value =~ s/%_N_%/\n/g;
379406µs $value =~ s/%_Q_%/\"/g;
380406µs $value =~ s/%_P_%/%/g;
381
3824027µs $res->{$key} = $value;
383
3844099µs return '';
385}
386
387# IF cfg{RequireCompatibleAnchors}
388
389# Return a list of alternative anchor names generated using old generations
390# of anchor name generator
391sub makeCompatibleAnchors {
392 my ($text) = @_;
393 my @anchors;
394
395 # Use the old algorithm to generate the old style, non-unique, anchor
396 # target.
397 my $badAnchor = _makeBadAnchorName( $text, 0 );
398 push( @anchors, $badAnchor ),
399
400 # There's an even older algorithm we have to allow for
401 my $worseAnchor = _makeBadAnchorName( $text, 1 );
402 if ( $worseAnchor ne $badAnchor ) {
403 push( @anchors, $worseAnchor ),;
404 }
405
406 return @anchors;
407}
408
409# Make an anchor name using the seriously flawed (tm)Wiki anchor generation
410# algorithm(s). This code is taken verbatim from Foswiki 1.0.4.
411sub _makeBadAnchorName {
412 my ( $anchorName, $compatibilityMode ) = @_;
413 if ( !$compatibilityMode
414 && $anchorName =~ /^$Foswiki::regex{anchorRegex}$/ )
415 {
416
417 # accept, already valid -- just remove leading #
418 return substr( $anchorName, 1 );
419 }
420
421 # strip out potential links so they don't get rendered.
422 # remove double bracket link
423 $anchorName =~ s/\[(?:\[.*?\])?\[(.*?)\]\s*\]/$1/g;
424
425 # add an _ before bare WikiWords
426 $anchorName =~ s/($Foswiki::regex{wikiWordRegex})/_$1/go;
427
428 if ($compatibilityMode) {
429
430 # remove leading/trailing underscores first, allowing them to be
431 # reintroduced
432 $anchorName =~ s/^[\s#_]*//;
433 $anchorName =~ s/[\s_]*$//;
434 }
435 $anchorName =~ s/<\/?[a-zA-Z][^>]*>//gi; # remove HTML tags
436 $anchorName =~ s/&#?[a-zA-Z0-9]+;//g; # remove HTML entities
437 $anchorName =~ s/&//g; # remove &
438 # filter TOC excludes if not at beginning
439 $anchorName =~ s/^(.+?)\s*$Foswiki::regex{headerPatternNoTOC}.*/$1/o;
440
441 # filter '!!', '%NOTOC%'
442 $anchorName =~ s/$Foswiki::regex{headerPatternNoTOC}//o;
443
444 # No matter what character set we use, the HTML standard does not allow
445 # anything else than English alphanum characters in anchors
446 # So we convert anything non A-Za-z0-9_ to underscores
447 # and limit the number consecutive of underscores to 1
448 # This means that pure non-English anchors will become A, A_AN1, A_AN2, ...
449 # We accept anchors starting with 0-9. It is non RFC but it works and it
450 # is very important for compatibility
451 $anchorName =~ s/[^A-Za-z0-9]+/_/g;
452 $anchorName =~ s/__+/_/g; # remove excessive '_' chars
453
454 if ( !$compatibilityMode ) {
455 $anchorName =~ s/^[\s#_]+//; # no leading space nor '#', '_'
456 }
457
458 $anchorName =~ s/^$/A/; # prevent empty anchor
459
460 # limit to 32 chars
461 $anchorName =~ s/^(.{32})(.*)$/$1/;
462 if ( !$compatibilityMode ) {
463 $anchorName =~ s/[\s_]+$//; # no trailing space, nor '_'
464 }
465 return $anchorName;
466}
467
46813µs1;
469__END__