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

Filename/var/www/foswiki11/lib/Foswiki/Attach.pm
StatementsExecuted 21 statements in 2.22ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11132µs44µsFoswiki::Attach::::BEGIN@15Foswiki::Attach::BEGIN@15
11116µs30µsFoswiki::Attach::::BEGIN@13Foswiki::Attach::BEGIN@13
11114µs14µsFoswiki::Attach::::newFoswiki::Attach::new
11112µs17µsFoswiki::Attach::::BEGIN@14Foswiki::Attach::BEGIN@14
11110µs23µsFoswiki::Attach::::renderMetaDataFoswiki::Attach::renderMetaData
1115µs5µsFoswiki::Attach::::finishFoswiki::Attach::finish
0000s0sFoswiki::Attach::::_NEWgifsizeFoswiki::Attach::_NEWgifsize
0000s0sFoswiki::Attach::::_OLDgifsizeFoswiki::Attach::_OLDgifsize
0000s0sFoswiki::Attach::::_expandAttrsFoswiki::Attach::_expandAttrs
0000s0sFoswiki::Attach::::_formatRowFoswiki::Attach::_formatRow
0000s0sFoswiki::Attach::::_gif_blockskipFoswiki::Attach::_gif_blockskip
0000s0sFoswiki::Attach::::_gifsizeFoswiki::Attach::_gifsize
0000s0sFoswiki::Attach::::_imgsizeFoswiki::Attach::_imgsize
0000s0sFoswiki::Attach::::_jpegsizeFoswiki::Attach::_jpegsize
0000s0sFoswiki::Attach::::_pngsizeFoswiki::Attach::_pngsize
0000s0sFoswiki::Attach::::formatVersionsFoswiki::Attach::formatVersions
0000s0sFoswiki::Attach::::getAttachmentLinkFoswiki::Attach::getAttachmentLink
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
2
3=begin TML
4
5---+ package Foswiki::Attach
6
7A singleton object of this class is used to deal with attachments to topics.
8
9=cut
10
11package Foswiki::Attach;
12
13230µs243µs
# spent 30µs (16+13) within Foswiki::Attach::BEGIN@13 which was called: # once (16µs+13µs) by Foswiki::attach at line 13
use strict;
# spent 30µs making 1 call to Foswiki::Attach::BEGIN@13 # spent 13µs making 1 call to strict::import
14225µs223µs
# spent 17µs (12+5) within Foswiki::Attach::BEGIN@14 which was called: # once (12µs+5µs) by Foswiki::attach at line 14
use warnings;
# spent 17µs making 1 call to Foswiki::Attach::BEGIN@14 # spent 5µs making 1 call to warnings::import
1522.13ms257µs
# spent 44µs (32+12) within Foswiki::Attach::BEGIN@15 which was called: # once (32µs+12µs) by Foswiki::attach at line 15
use Assert;
# spent 44µs making 1 call to Foswiki::Attach::BEGIN@15 # spent 12µs making 1 call to Assert::import
16
171700nsour $MARKER = "\0";
18
19=begin TML
20
21---++ ClassMethod new($session)
22
23Constructor.
24
25=cut
26
27
# spent 14µs within Foswiki::Attach::new which was called: # once (14µs+0s) by Foswiki::attach at line 2014 of /var/www/foswiki11/lib/Foswiki.pm
sub new {
2811µs my ( $class, $session ) = @_;
29110µs my $this = bless( { session => $session }, $class );
30
3116µs return $this;
32}
33
34=begin TML
35
36---++ ObjectMethod finish()
37Break circular references.
38
39=cut
40
41# Note to developers; please undef *all* fields in the object explicitly,
42# whether they are references or not. That way this method is "golden
43# documentation" of the live fields in the object.
44
# spent 5µs within Foswiki::Attach::finish which was called: # once (5µs+0s) by Foswiki::finish at line 2163 of /var/www/foswiki11/lib/Foswiki.pm
sub finish {
4511µs my $this = shift;
4615µs undef $this->{session};
47}
48
49=begin TML
50
51---++ ObjectMethod renderMetaData( $topicObject, $args ) -> $text
52
53Generate a table of attachments suitable for the bottom of a topic
54view, using templates for the header, footer and each row.
55 * =$topicObject= the topic
56 * =$args= hash of attachment arguments
57
58=cut
59
60
# spent 23µs (10+13) within Foswiki::Attach::renderMetaData which was called: # once (10µs+13µs) by Foswiki::META at line 19 of /var/www/foswiki11/lib/Foswiki/Macros/META.pm
sub renderMetaData {
611600ns my ( $this, $topicObject, $attrs ) = @_;
62
631700ns my $showAll = $attrs->{all} || '';
641400ns my $showAttr = $showAll ? 'h' : '';
651200ns my $A = ($showAttr) ? ':A' : '';
661400ns my $title = $attrs->{title} || '';
671400ns my $tmplname = $attrs->{template} || 'attachtables';
68
6915µs113µs my @attachments = $topicObject->find('FILEATTACHMENT');
# spent 13µs making 1 call to Foswiki::Meta::find
7014µs return '' unless @attachments;
71
72 my $templates = $this->{session}->templates;
73 $templates->readTemplate($tmplname);
74
75 my $rows = '';
76 my $row = $templates->expandTemplate( 'ATTACH:files:row' . $A );
77 foreach
78 my $attachment ( sort { ( $a->{name} || '' ) cmp( $b->{name} || '' ) }
79 @attachments )
80 {
81 my $attrAttr = $attachment->{attr};
82
83 if ( !$attrAttr || ( $showAttr && $attrAttr =~ /^[$showAttr]*$/ ) ) {
84 $rows .= _formatRow( $this, $topicObject, $attachment, $row );
85 }
86 }
87
88 my $text = '';
89
90 if ( $showAll || $rows ne '' ) {
91 my $header = $templates->expandTemplate( 'ATTACH:files:header' . $A );
92 my $footer = $templates->expandTemplate( 'ATTACH:files:footer' . $A );
93
94 $text = $header . $rows . $footer;
95 }
96 return $title . $text;
97}
98
99=begin TML
100
101---++ ObjectMethod formatVersions ( $topicObject, $attrs ) -> $text
102
103Generate a version history table for a single attachment
104 * =$topicObject= - the topic
105 * =$attrs= - Hash of meta-data attributes
106
107=cut
108
109sub formatVersions {
110 my ( $this, $topicObject, %attrs ) = @_;
111
112 my $users = $this->{session}->{users};
113
114 $attrs{name} =
115 Foswiki::Sandbox::untaint( $attrs{name},
116 \&Foswiki::Sandbox::validateAttachmentName );
117
118 my $revIt = $topicObject->getRevisionHistory( $attrs{name} );
119
120 my $templates = $this->{session}->templates;
121 $templates->readTemplate('attachtables');
122
123 my $header = $templates->expandTemplate('ATTACH:versions:header');
124 my $footer = $templates->expandTemplate('ATTACH:versions:footer');
125 my $row = $templates->expandTemplate('ATTACH:versions:row');
126
127 my @rows;
128
129 while ( $revIt->hasNext() ) {
130 my $rev = $revIt->next();
131 my $info =
132 $topicObject->getAttachmentRevisionInfo( $attrs{name}, $rev );
133 $info->{name} = $attrs{name};
134 $info->{attr} = $attrs{attr};
135 $info->{size} = $attrs{size};
136
137 push( @rows, _formatRow( $this, $topicObject, $info, $row ) );
138 }
139
140 return $header . join( '', @rows ) . $footer;
141}
142
143#Format a single row in an attachment table by expanding a template.
144#| =$web= | the web |
145#| =$topic= | the topic |
146#| =$info= | hash containing fields name, user (user (not wikiname) who uploaded this revision), date (date of _this revision_ of the attachment), command and version (the required revision; required to be a full (major.minor) revision number) |
147#| =$tmpl= | The template of a row |
148sub _formatRow {
149 my ( $this, $topicObject, $info, $tmpl ) = @_;
150
151 my $row = $tmpl;
152
153 $row =~ s/%A_(\w+)%/_expandAttrs( $this, $1, $topicObject, $info)/ge;
154 $row =~ s/$MARKER/%/go;
155
156 return $row;
157}
158
159sub _expandAttrs {
160 my ( $this, $attr, $topicObject, $info ) = @_;
161 my $file = $info->{name} || '';
162 my $users = $this->{session}->{users};
163
164 require Foswiki::Time;
165
166 if ( $attr eq 'REV' ) {
167 return $info->{version};
168 }
169 elsif ( $attr eq 'ICON' ) {
170 return '%ICON{"' . $file . '" default="else"}%';
171 }
172 elsif ( $attr eq 'EXT' ) {
173
174 # $fileExtension is used to map the attachment to its MIME type
175 # only grab the last extension in case of multiple extensions
176 $file =~ m/\.([^.]*)$/;
177 return $1;
178 }
179 elsif ( $attr eq 'URL' ) {
180 return $this->{session}->getScriptUrl(
181 0, 'viewfile', $topicObject->web, $topicObject->topic,
182 rev => $info->{version} || undef,
183 filename => $file
184 );
185 }
186 elsif ( $attr eq 'SIZE' ) {
187 my $attrSize = $info->{size};
188 $attrSize = 100 if ( !$attrSize || $attrSize < 100 );
189 return sprintf( "%1.1f&nbsp;K", $attrSize / 1024 );
190 }
191 elsif ( $attr eq 'COMMENT' ) {
192 my $comment = $info->{comment};
193 if ($comment) {
194 $comment =~ s/\|/&#124;/g;
195 }
196 else {
197 $comment = "&nbsp;";
198 }
199 return $comment;
200 }
201 elsif ( $attr eq 'ATTRS' ) {
202 if ( $info->{attr} ) {
203 return $info->{attr};
204 }
205 else {
206 return "&nbsp;";
207 }
208 }
209 elsif ( $attr eq 'FILE' ) {
210 return $file;
211 }
212 elsif ( $attr eq 'EFILE' ) {
213
214 # Really aggressive URL encoding, required to protect wikiwords
215 # See Bugs:Item3289, Bugs:Item3623
216 $file =~ s/([^A-Za-z0-9])/'%'.sprintf('%02x',ord($1))/ge;
217 return $file;
218 }
219 elsif ( $attr eq 'DATE' ) {
220 return Foswiki::Time::formatTime( $info->{date} || 0 );
221 }
222 elsif ( $attr eq 'USER' ) {
223
224 # Must be able to expand either user or author, depending on whether
225 # info came from attachment meta-data (user), or
226 # revision info (author)
227 my $user = $info->{author} || $info->{user} || 'UnknownUser';
228 my $cUID;
229 if ($user) {
230 $cUID = $users->getCanonicalUserID($user);
231 if ( !$cUID ) {
232
233 # Not a login name or a wiki name. Is it a valid cUID?
234 my $ln = $users->getLoginName($user);
235 $cUID = $user if defined $ln && $ln ne 'unknown';
236 }
237 }
238
239 return $users->webDotWikiName($cUID);
240 }
241 else {
242 return $MARKER . 'A_' . $attr . $MARKER;
243 }
244}
245
246=begin TML
247
248---++ ObjectMethod getAttachmentLink( $topicObject, $name ) -> $html
249
250 * =$topicObject= - The topic
251 * =$name= - Name of the attachment
252
253Build a link to the attachment, suitable for insertion in the topic.
254
255=cut
256
257sub getAttachmentLink {
258 my ( $this, $topicObject, $attName ) = @_;
259
260 my $att = $topicObject->get( 'FILEATTACHMENT', $attName );
261 my $fileComment = $att->{comment};
262 $fileComment = $attName unless ($fileComment);
263
264 my $fileLink = '';
265 my $imgSize = '';
266 my $prefs = $this->{session}->{prefs};
267
268 # I18N: URL-encode the attachment filename
269 my $fileURL = Foswiki::urlEncodeAttachment($attName);
270
271 if ( $attName =~ /\.(gif|jpg|jpeg|png|svg)$/i ) {
272
273 # inline image
274
275 # The pixel size calculation is done for performance reasons
276 # Some browsers wait with rendering a page until the size of
277 # embedded images is known, e.g. after all images of a page are
278 # downloaded. When you upload an image to Foswiki and checkmark
279 # the link checkbox, Foswiki will generate the width and height
280 # img parameters, speeding up the page rendering.
281 my $stream = $topicObject->openAttachment( $attName, '<' );
282 my ( $nx, $ny ) = _imgsize( $stream, $attName );
283 $stream->close();
284 my %attrs;
285
286 if ( $nx > 0 && $ny > 0 ) {
287 $attrs{width} = $nx;
288 $attrs{height} = $ny;
289 $imgSize = "width='$nx' height='$ny'";
290 }
291
292 $fileLink = $prefs->getPreference('ATTACHEDIMAGEFORMAT');
293 unless ($fileLink) {
294 $attrs{src} = "%ATTACHURLPATH%/$fileURL";
295 $attrs{alt} = $attName;
296 return " * $fileComment: " . CGI::br() . CGI::img( \%attrs );
297 }
298 }
299 else {
300
301 # normal attached file
302 $fileLink = $prefs->getPreference('ATTACHEDFILELINKFORMAT');
303 unless ($fileLink) {
304 return " * [[%ATTACHURL%/$fileURL][$attName]]: $fileComment";
305 }
306 }
307
308 # I18N: Site specified %ATTACHEDIMAGEFORMAT% or %ATTACHEDFILELINKFORMAT%,
309 # ensure that filename is URL encoded - first $name must be URL.
310 $fileLink =~ s/\$name/$fileURL/; # deprecated
311 $fileLink =~ s/\$name/$attName/; # deprecated, see Item1814
312 $fileLink =~ s/\$filename/$attName/g;
313 $fileLink =~ s/\$fileurl/$fileURL/g;
314
315 # Expand \t and \n early (only in the format, not
316 # in the comment) - TWikibug:Item4581
317 $fileLink =~ s/\\t/\t/go;
318 $fileLink =~ s/\\n/\n/go;
319 $fileLink =~ s/\$comment/$fileComment/g;
320 $fileLink =~ s/\$size/$imgSize/g;
321 $fileLink =~ s/([^\n])$/$1\n/;
322
323 return $fileLink;
324}
325
326# code fragment to extract pixel size from images
327# taken from http://www.tardis.ed.ac.uk/~ark/wwwis/
328# subroutines: _imgsize, _gifsize, _OLDgifsize, _gif_blockskip,
329# _NEWgifsize, _jpegsize
330#
331sub _imgsize {
332 my ( $file, $att ) = @_;
333 my ( $x, $y ) = ( 0, 0 );
334
335 if ( defined($file) ) {
336 binmode($file); # For Windows
337 my $s;
338 return ( 0, 0 ) unless ( read( $file, $s, 4 ) == 4 );
339 seek( $file, 0, 0 );
340 if ( $s eq 'GIF8' ) {
341
342 # GIF 47 49 46 38
343 ( $x, $y ) = _gifsize($file);
344 }
345 else {
346 my ( $a, $b, $c, $d ) = unpack( 'C4', $s );
347 if ( $a == 0x89
348 && $b == 0x50
349 && $c == 0x4E
350 && $d == 0x47 )
351 {
352
353 # PNG 89 50 4e 47
354 ( $x, $y ) = _pngsize($file);
355 }
356 elsif ($a == 0xFF
357 && $b == 0xD8
358 && $c == 0xFF
359 && ( $d == 0xE0 || $d == 0xE1 ) )
360 {
361
362 # JPG ff d8 ff e0/e1
363 ( $x, $y ) = _jpegsize($file);
364 }
365 }
366 close($file);
367 }
368 return ( $x, $y );
369}
370
371sub _gifsize {
372 my ($GIF) = @_;
373 if (0) {
374 return &_NEWgifsize($GIF);
375 }
376 else {
377 return &_OLDgifsize($GIF);
378 }
379}
380
381sub _OLDgifsize {
382 my ($GIF) = @_;
383 my ( $type, $a, $b, $c, $d, $s ) = ( 0, 0, 0, 0, 0, 0 );
384
385 if ( defined($GIF)
386 && read( $GIF, $type, 6 )
387 && $type =~ /GIF8[7,9]a/
388 && read( $GIF, $s, 4 ) == 4 )
389 {
390 ( $a, $b, $c, $d ) = unpack( 'C' x 4, $s );
391 return ( $b << 8 | $a, $d << 8 | $c );
392 }
393 return ( 0, 0 );
394}
395
396# part of _NEWgifsize
397sub _gif_blockskip {
398 my ( $GIF, $skip, $type ) = @_;
399 my ($s) = 0;
400 my ($dummy) = '';
401
402 read( $GIF, $dummy, $skip ); # Skip header (if any)
403 while (1) {
404 if ( eof($GIF) ) {
405
406 #warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n";
407 return '';
408 }
409 read( $GIF, $s, 1 ); # Block size
410 last if ord($s) == 0; # Block terminator
411 read( $GIF, $dummy, ord($s) ); # Skip data
412 }
413}
414
415# this code by "Daniel V. Klein" <dvk@lonewolf.com>
416sub _NEWgifsize {
417 my ($GIF) = @_;
418 my ( $cmapsize, $a, $b, $c, $d, $e ) = 0;
419 my ( $type, $s ) = ( 0, 0 );
420 my ( $x, $y ) = ( 0, 0 );
421 my ($dummy) = '';
422
423 return ( $x, $y ) if ( !defined $GIF );
424
425 read( $GIF, $type, 6 );
426 if ( $type !~ /GIF8[7,9]a/ || read( $GIF, $s, 7 ) != 7 ) {
427
428 #warn "Invalid/Corrupted GIF (bad header)\n";
429 return ( $x, $y );
430 }
431 ($e) = unpack( "x4 C", $s );
432 if ( $e & 0x80 ) {
433 $cmapsize = 3 * 2**( ( $e & 0x07 ) + 1 );
434 if ( !read( $GIF, $dummy, $cmapsize ) ) {
435
436 #warn "Invalid/Corrupted GIF (global color map too small?)\n";
437 return ( $x, $y );
438 }
439 }
440 FINDIMAGE:
441 while (1) {
442 if ( eof($GIF) ) {
443
444 #warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n";
445 return ( $x, $y );
446 }
447 read( $GIF, $s, 1 );
448 ($e) = unpack( 'C', $s );
449 if ( $e == 0x2c ) { # Image Descriptor (GIF87a, GIF89a 20.c.i)
450 if ( read( $GIF, $s, 8 ) != 8 ) {
451
452 #warn "Invalid/Corrupted GIF (missing image header?)\n";
453 return ( $x, $y );
454 }
455 ( $a, $b, $c, $d ) = unpack( "x4 C4", $s );
456 $x = $b << 8 | $a;
457 $y = $d << 8 | $c;
458 return ( $x, $y );
459 }
460 if ( $type eq 'GIF89a' ) {
461 if ( $e == 0x21 ) { # Extension Introducer (GIF89a 23.c.i)
462 read( $GIF, $s, 1 );
463 ($e) = unpack( 'C', $s );
464 if ( $e == 0xF9 ) { # Graphic Control Extension (GIF89a 23.c.ii)
465 read( $GIF, $dummy, 6 ); # Skip it
466 next FINDIMAGE; # Look again for Image Descriptor
467 }
468 elsif ( $e == 0xFE ) { # Comment Extension (GIF89a 24.c.ii)
469 &_gif_blockskip( $GIF, 0, 'Comment' );
470 next FINDIMAGE; # Look again for Image Descriptor
471 }
472 elsif ( $e == 0x01 ) { # Plain Text Label (GIF89a 25.c.ii)
473 &_gif_blockskip( $GIF, 12, 'text data' );
474 next FINDIMAGE; # Look again for Image Descriptor
475 }
476 elsif ( $e == 0xFF )
477 { # Application Extension Label (GIF89a 26.c.ii)
478 &_gif_blockskip( $GIF, 11, 'application data' );
479 next FINDIMAGE; # Look again for Image Descriptor
480 }
481 else {
482
483 #printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e;
484 return ( $x, $y );
485 }
486 }
487 else {
488
489 #printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e;
490 return ( $x, $y );
491 }
492 }
493 else {
494
495 #warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n";
496 return ( $x, $y );
497 }
498 }
499}
500
501# _jpegsize : gets the width and height (in pixels) of a jpeg file
502# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
503# modified slightly by alex@ed.ac.uk
504sub _jpegsize {
505 my ($JPEG) = @_;
506 my ($done) = 0;
507 my ( $c1, $c2, $ch, $s, $length, $dummy ) = ( 0, 0, 0, 0, 0, 0 );
508 my ( $a, $b, $c, $d );
509
510 if ( defined($JPEG)
511 && read( $JPEG, $c1, 1 )
512 && read( $JPEG, $c2, 1 )
513 && ord($c1) == 0xFF
514 && ord($c2) == 0xD8 )
515 {
516 while ( ord($ch) != 0xDA && !$done ) {
517
518 # Find next marker (JPEG markers begin with 0xFF)
519 # This can hang the program!!
520 while ( ord($ch) != 0xFF ) {
521 return ( 0, 0 ) unless read( $JPEG, $ch, 1 );
522 }
523
524 # JPEG markers can be padded with unlimited 0xFF's
525 while ( ord($ch) == 0xFF ) {
526 return ( 0, 0 ) unless read( $JPEG, $ch, 1 );
527 }
528
529 # Now, $ch contains the value of the marker.
530 if ( ( ord($ch) >= 0xC0 ) && ( ord($ch) <= 0xC3 ) ) {
531 return ( 0, 0 ) unless read( $JPEG, $dummy, 3 );
532 return ( 0, 0 ) unless read( $JPEG, $s, 4 );
533 ( $a, $b, $c, $d ) = unpack( 'C' x 4, $s );
534 return ( $c << 8 | $d, $a << 8 | $b );
535 }
536 else {
537
538 # We **MUST** skip variables, since FF's within variable
539 # names are NOT valid JPEG markers
540 return ( 0, 0 ) unless read( $JPEG, $s, 2 );
541 ( $c1, $c2 ) = unpack( 'C' x 2, $s );
542 $length = $c1 << 8 | $c2;
543 last if ( !defined($length) || $length < 2 );
544 read( $JPEG, $dummy, $length - 2 );
545 }
546 }
547 }
548 return ( 0, 0 );
549}
550
551# _pngsize : gets the width & height (in pixels) of a png file
552# source: http://www.la-grange.net/2000/05/04-png.html
553sub _pngsize {
554 my ($PNG) = @_;
555 my ($head) = '';
556 my ( $a, $b, $c, $d, $e, $f, $g, $h ) = 0;
557 if ( defined($PNG)
558 && read( $PNG, $head, 8 ) == 8
559 && $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"
560 && read( $PNG, $head, 4 ) == 4
561 && read( $PNG, $head, 4 ) == 4
562 && $head eq 'IHDR'
563 && read( $PNG, $head, 8 ) == 8 )
564 {
565 ( $a, $b, $c, $d, $e, $f, $g, $h ) = unpack( 'C' x 8, $head );
566 return (
567 $a << 24 | $b << 16 | $c << 8 | $d,
568 $e << 24 | $f << 16 | $g << 8 | $h
569 );
570 }
571 return ( 0, 0 );
572}
573
57413µs1;
575__END__