← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 18:42:36 2015
Reported on Fri Jul 31 18:48:15 2015

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