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

Filename/var/www/foswikidev/core/lib/Foswiki/Attach.pm
StatementsExecuted 22 statements in 2.65ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11116µs29µsFoswiki::Attach::::BEGIN@13Foswiki::Attach::BEGIN@13
11112µs12µsFoswiki::Attach::::newFoswiki::Attach::new
11111µs17µsFoswiki::Attach::::renderMetaDataFoswiki::Attach::renderMetaData
11110µs15µsFoswiki::Attach::::BEGIN@14Foswiki::Attach::BEGIN@14
11110µs36µsFoswiki::Attach::::BEGIN@15Foswiki::Attach::BEGIN@15
1115µs5µsFoswiki::Attach::::BEGIN@17Foswiki::Attach::BEGIN@17
1114µs4µsFoswiki::Attach::::finishFoswiki::Attach::finish
0000s0sFoswiki::Attach::::_NEWgifsizeFoswiki::Attach::_NEWgifsize
0000s0sFoswiki::Attach::::_OLDgifsizeFoswiki::Attach::_OLDgifsize
0000s0sFoswiki::Attach::::_cUIDFoswiki::Attach::_cUID
0000s0sFoswiki::Attach::::_expandAttrsFoswiki::Attach::_expandAttrs
0000s0sFoswiki::Attach::::_expandRowAttrsFoswiki::Attach::_expandRowAttrs
0000s0sFoswiki::Attach::::_formatFileSizeFoswiki::Attach::_formatFileSize
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µs242µs
# spent 29µ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 29µs making 1 call to Foswiki::Attach::BEGIN@13 # spent 13µs making 1 call to strict::import
14225µs219µs
# spent 15µs (10+4) within Foswiki::Attach::BEGIN@14 which was called: # once (10µs+4µs) by Foswiki::attach at line 14
use warnings;
# spent 15µs making 1 call to Foswiki::Attach::BEGIN@14 # spent 4µs making 1 call to warnings::import
15248µs263µs
# spent 36µs (10+27) within Foswiki::Attach::BEGIN@15 which was called: # once (10µs+27µs) by Foswiki::attach at line 15
use Assert;
# spent 36µs making 1 call to Foswiki::Attach::BEGIN@15 # spent 27µs making 1 call to Exporter::import
16
17
# spent 5µs within Foswiki::Attach::BEGIN@17 which was called: # once (5µs+0s) by Foswiki::attach at line 22
BEGIN {
1814µs if ( $Foswiki::cfg{UseLocale} ) {
19 require locale;
20 import locale();
21 }
2212.51ms15µs}
# spent 5µs making 1 call to Foswiki::Attach::BEGIN@17
23
241600nsour $MARKER = "\0";
25
26=begin TML
27
28---++ ClassMethod new($session)
29
30Constructor.
31
32=cut
33
34
# spent 12µs within Foswiki::Attach::new which was called: # once (12µs+0s) by Foswiki::attach at line 2305 of /var/www/foswikidev/core/lib/Foswiki.pm
sub new {
3511µs my ( $class, $session ) = @_;
3619µs my $this = bless( { session => $session }, $class );
37
3816µs return $this;
39}
40
41=begin TML
42
43---++ ObjectMethod finish()
44Break circular references.
45
46=cut
47
48# Note to developers; please undef *all* fields in the object explicitly,
49# whether they are references or not. That way this method is "golden
50# documentation" of the live fields in the object.
51
# spent 4µs within Foswiki::Attach::finish which was called: # once (4µs+0s) by Foswiki::finish at line 2488 of /var/www/foswikidev/core/lib/Foswiki.pm
sub finish {
521600ns my $this = shift;
5314µs undef $this->{session};
54}
55
56=begin TML
57
58---++ ObjectMethod renderMetaData( $topicObject, $args ) -> $text
59
60Generate a table of attachments suitable for the bottom of a topic
61view, using templates for the header, footer and each row.
62 * =$topicObject= the topic
63 * =$args= hash of attachment arguments
64
65Renders these tokens for each attachment:
66 * %<nop>A_ATTRS% - attributes
67 * %<nop>A_COMMENT% - comment
68 * %<nop>A_DATE% - upload date in user friendly format
69 * %<nop>A_EPOCH% - upload date in epoch seconds
70 * %<nop>A_EFILE% - encoded file name
71 * %<nop>A_EXT% - file extension
72 * %<nop>A_FILE% - file name
73 * %<nop>A_FILESIZE% - filesize in bytes to be used in sorting
74 * %<nop>A_ICON% - =%<nop>ICON{}%= macro around file extension
75 * %<nop>A_REV% - revision
76 * %<nop>A_SIZE% - filesize in user friendly notation
77 * %<nop>A_URL% - attachment file url
78 * %<nop>A_USER% - user who has uploaded the last version in 'web.usertopic' notation
79 * %<nop>A_USERNAME% - user who has uploaded the last version in 'usertopic' notation
80 * %<nop>A_COUNT% - attachment number (starting from 1)
81
82Renders these row helper tokens:
83 * %<nop>R_STARTROW_N% - where N is the desired number of attachments in a row; true if a new row should be started
84 * %<nop>R_ENDROW_N% - where N is the desired number of attachments in a row; true if a row should be closed
85=cut
86
87
# spent 17µs (11+6) within Foswiki::Attach::renderMetaData which was called: # once (11µs+6µs) by Foswiki::META at line 40 of /var/www/foswikidev/core/lib/Foswiki/Macros/META.pm
sub renderMetaData {
881500ns my ( $this, $topicObject, $attrs ) = @_;
89
901600ns my $showAll = $attrs->{all} || '';
911400ns my $showAttr = $showAll ? 'h' : '';
921200ns my $A = ($showAttr) ? ':A' : '';
931400ns my $title = $attrs->{title} || '';
941300ns my $tmplname = $attrs->{template} || 'attachtables';
95
9613µs16µs my @attachments = $topicObject->find('FILEATTACHMENT');
# spent 6µs making 1 call to Foswiki::Meta::find
9716µs return '' unless @attachments;
98
99 my $templates = $this->{session}->templates;
100 $templates->readTemplate($tmplname);
101
102 my $rows = '';
103 my $row = $templates->expandTemplate( 'ATTACH:files:row' . $A );
104 my $attachmentCount = scalar(@attachments);
105 my $attachmentNum = 1;
106 foreach
107 my $attachment ( sort { ( $a->{name} || '' ) cmp( $b->{name} || '' ) }
108 @attachments )
109 {
110 my $attrAttr = $attachment->{attr};
111
112 if ( !$attrAttr || ( $showAttr && $attrAttr =~ m/^[$showAttr]*$/ ) ) {
113 $rows .=
114 _formatRow( $this, $topicObject, $attachment, $row,
115 $attachmentNum, ( $attachmentNum == $attachmentCount ) );
116 $attachmentNum++;
117 }
118 else {
119 # not a visible attachment
120 $attachmentCount--;
121 }
122 }
123
124 my $text = '';
125
126 if ( $showAll || $rows ne '' ) {
127 my $header = $templates->expandTemplate( 'ATTACH:files:header' . $A );
128 my $footer = $templates->expandTemplate( 'ATTACH:files:footer' . $A );
129
130 $text = $header . $rows . $footer;
131 }
132 return $title . $text;
133}
134
135=begin TML
136
137---++ ObjectMethod formatVersions ( $topicObject, $attrs ) -> $text
138
139Generate a version history table for a single attachment
140 * =$topicObject= - the topic
141 * =$attrs= - Hash of meta-data attributes
142
143=cut
144
145sub formatVersions {
146 my ( $this, $topicObject, %attrs ) = @_;
147
148 my $users = $this->{session}->{users};
149
150 $attrs{name} =
151 Foswiki::Sandbox::untaint( $attrs{name},
152 \&Foswiki::Sandbox::validateAttachmentName );
153
154 my $revIt = $topicObject->getRevisionHistory( $attrs{name} );
155
156 my $templates = $this->{session}->templates;
157 $templates->readTemplate('attachtables');
158
159 my $header = $templates->expandTemplate('ATTACH:versions:header');
160 my $footer = $templates->expandTemplate('ATTACH:versions:footer');
161 my $row = $templates->expandTemplate('ATTACH:versions:row');
162
163 my @rows;
164 my $attachmentNum = 1;
165
166 while ( $revIt->hasNext() ) {
167 my $rev = $revIt->next();
168 my $info = $topicObject->getRevisionInfo( $attrs{name}, $rev );
169 $info->{name} = $attrs{name};
170 $info->{attr} = $attrs{attr};
171 $info->{size} = $attrs{size};
172
173 push(
174 @rows,
175 _formatRow(
176 $this, $topicObject, $info,
177 $row, $attachmentNum, $revIt->hasNext()
178 )
179 );
180 $attachmentNum++;
181 }
182
183 return $header . join( '', @rows ) . $footer;
184}
185
186#Format a single row in an attachment table by expanding a template.
187#| =$web= | the web |
188#| =$topic= | the topic |
189#| =$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) |
190#| =$tmpl= | The template of a row |
191#| =$attachmentNum= | The sequential number of this attachment (starting with 1) |
192#| =$isLast= | True if this is the last attachment |
193sub _formatRow {
194 my ( $this, $topicObject, $info, $tmpl, $attachmentNum, $isLast ) = @_;
195
196 my $row = $tmpl;
197
198 $row =~
199s/%A_(\w+)%/_expandAttrs( $this, $1, $topicObject, $info, $attachmentNum)/ge;
200 $row =~
201s/%R_(\w+)%/_expandRowAttrs( $this, $1, $topicObject, $info, $attachmentNum, $isLast)/ge;
202 $row =~ s/$MARKER/%/go;
203
204 return $row;
205}
206
207sub _expandAttrs {
208 my ( $this, $attr, $topicObject, $info, $attachmentNum ) = @_;
209 my $file = $info->{name} || '';
210 my $users = $this->{session}->{users};
211
212 require Foswiki::Time;
213
214 if ( $attr eq 'REV' ) {
215 return $info->{version};
216 }
217 elsif ( $attr eq 'ICON' ) {
218 return '%ICON{"' . $file . '" default="else"}%';
219 }
220 elsif ( $attr eq 'EXT' ) {
221
222 # $fileExtension is used to map the attachment to its MIME type
223 # only grab the last extension in case of multiple extensions
224 $file =~ m/\.([^.]*)$/;
225 return $1;
226 }
227 elsif ( $attr eq 'URL' ) {
228 return $this->{session}->getScriptUrl(
229 0, 'viewfile', $topicObject->web, $topicObject->topic,
230 rev => $info->{version} || undef,
231 filename => $file
232 );
233 }
234 elsif ( $attr eq 'FILESIZE' ) {
235 return $info->{size};
236 }
237 elsif ( $attr eq 'SIZE' ) {
238
239 # size in user friendly notation
240 my $attrSize = $info->{size};
241 $attrSize = 1 if ( !$attrSize || $attrSize < 1 );
242 return _formatFileSize( $attrSize, 0, ' ' );
243 }
244 elsif ( $attr eq 'COMMENT' ) {
245 my $comment = $info->{comment};
246 if ($comment) {
247 $comment =~ s/\|/&#124;/g;
248 }
249 else {
250 $comment = '';
251 }
252 return $comment;
253 }
254 elsif ( $attr eq 'ATTRS' ) {
255 if ( $info->{attr} ) {
256 return $info->{attr};
257 }
258 else {
259 return "&nbsp;";
260 }
261 }
262 elsif ( $attr eq 'FILE' ) {
263 return $file;
264 }
265 elsif ( $attr eq 'EFILE' ) {
266
267 # Really aggressive URL encoding, required to protect wikiwords
268 # See Bugs:Item3289, Bugs:Item3623
269 $file =~ s/([^A-Za-z0-9])/'%'.sprintf('%02x',ord($1))/ge;
270 return $file;
271 }
272 elsif ( $attr eq 'DATE' ) {
273 return Foswiki::Time::formatTime( $info->{date} || 0 );
274 }
275 elsif ( $attr eq 'EPOCH' ) {
276 return $info->{date} || 0;
277 }
278 elsif ( $attr eq 'USER' ) {
279 return $users->webDotWikiName( $this->_cUID($info) );
280 }
281 elsif ( $attr eq 'USERNAME' ) {
282 return $users->getWikiName( $this->_cUID($info) );
283 }
284 elsif ( $attr eq 'COUNT' ) {
285 return $attachmentNum;
286 }
287 else {
288 return $MARKER . 'A_' . $attr . $MARKER;
289 }
290}
291
292sub _expandRowAttrs {
293 my ( $this, $attr, $topicObject, $info, $attachmentNum, $isLast ) = @_;
294
295 my $num = $attachmentNum - 1;
296
297 if ( $attr =~ s/STARTROW_(\d+)/$num % $1 == 0/ge ) {
298 return $attr;
299 }
300 elsif ( $attr =~ s/ENDROW_(\d+)/$isLast || $num % $1 == ($1 - 1)/ge ) {
301 return $attr;
302 }
303}
304
305sub _cUID {
306 my ( $this, $info ) = @_;
307
308 my $users = $this->{session}->{users};
309 my $user = $info->{author} || $info->{user} || 'UnknownUser';
310 my $cUID;
311 if ($user) {
312 $cUID = $users->getCanonicalUserID($user);
313 if ( !$cUID ) {
314
315 # Not a login name or a wiki name. Is it a valid cUID?
316 my $ln = $users->getLoginName($user);
317 $cUID = $user if defined $ln && $ln ne 'unknown';
318 }
319 }
320 return $cUID;
321}
322
323# prints the filesize in user friendly format
324sub _formatFileSize {
325
326 my $fs = $_[0]; # First variable is the size in bytes
327 my $dp = $_[1]; # Number of decimal places required
328 my $sep = $_[2] || '';
329 my @units = ( 'bytes', 'K', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB' );
330 my $u = 0;
331 $dp = ( $dp > 0 ) ? 10**$dp : 1;
332 while ( $fs >= 1024 ) {
333 $fs /= 1024;
334 $u++;
335 }
336 if ( $units[$u] ) {
337 my $size = int( $fs * $dp ) / $dp;
338 my $unit = $units[$u];
339 if ( $u == 0 && $size == 1 ) {
340
341 # single byte
342 $unit = 'byte';
343 }
344 return "$size$sep$unit";
345 }
346 else {
347 return int($fs);
348 }
349}
350
351=begin TML
352
353---++ ObjectMethod getAttachmentLink( $topicObject, $name ) -> $html
354
355 * =$topicObject= - The topic
356 * =$name= - Name of the attachment
357
358Build a link to the attachment, suitable for insertion in the topic.
359
360=cut
361
362sub getAttachmentLink {
363 my ( $this, $topicObject, $attName ) = @_;
364
365 my $att = $topicObject->get( 'FILEATTACHMENT', $attName );
366 my $fileComment = $att->{comment};
367 my $fileTime = $att->{date} || 0;
368 $fileComment = $attName unless ($fileComment);
369 my ($fileExt) = $attName =~ m/(?:.*\.)*([^.]*)/;
370 $fileExt ||= '';
371
372 my $fileLink = '';
373 my $imgSize = '';
374 my $prefs = $this->{session}->{prefs};
375
376 # I18N: URL-encode the attachment filename
377 my $fileURL = Foswiki::urlEncode($attName);
378
379 if ( $attName =~ m/\.(gif|jpg|jpeg|png)$/i ) {
380
381 # inline image
382
383 # The pixel size calculation is done for performance reasons
384 # Some browsers wait with rendering a page until the size of
385 # embedded images is known, e.g. after all images of a page are
386 # downloaded. When you upload an image to Foswiki and checkmark
387 # the link checkbox, Foswiki will generate the width and height
388 # img parameters, speeding up the page rendering.
389 my $stream = $topicObject->openAttachment( $attName, '<' );
390 my ( $nx, $ny ) = _imgsize( $stream, $attName );
391 $stream->close();
392 my %attrs;
393
394 if ( $nx > 0 && $ny > 0 ) {
395 $attrs{width} = $nx;
396 $attrs{height} = $ny;
397 $imgSize = "width='$nx' height='$ny'";
398 }
399
400 $fileLink = $prefs->getPreference('ATTACHEDIMAGEFORMAT');
401 unless ($fileLink) {
402 $attrs{src} = "%ATTACHURLPATH%/$fileURL";
403 $attrs{alt} = $attName;
404 return " * $fileComment: " . CGI::br() . CGI::img( \%attrs );
405 }
406 }
407 else {
408
409 # normal attached file
410 $fileLink = $prefs->getPreference('ATTACHEDFILELINKFORMAT');
411 unless ($fileLink) {
412 return " * [[%ATTACHURL%/$fileURL][$attName]]: $fileComment";
413 }
414 }
415
416 # I18N: Site specified %ATTACHEDIMAGEFORMAT% or %ATTACHEDFILELINKFORMAT%,
417 # ensure that filename is URL encoded - first $name must be URL.
418 $fileLink =~ s/\$name/$fileURL/; # deprecated
419 $fileLink =~ s/\$name/$attName/; # deprecated, see Item1814
420 $fileLink =~ s/\$filename/$attName/g;
421 $fileLink =~ s/\$fileurl/$fileURL/g;
422 $fileLink =~ s/\$fileext/$fileExt/;
423
424 # Expand \t and \n early (only in the format, not
425 # in the comment) - TWikibug:Item4581
426 $fileLink =~ s/\\t/\t/g;
427 $fileLink =~ s/\\n/\n/g;
428 $fileLink =~ s/\$comment/$fileComment/g;
429 $fileLink =~ s/\$size/$imgSize/g;
430 $fileLink =~ s/([^\n])$/$1\n/;
431
432 require Foswiki::Time;
433 $fileLink = Foswiki::Time::formatTime( $fileTime, $fileLink );
434 $fileLink = Foswiki::expandStandardEscapes($fileLink);
435
436 return $fileLink;
437}
438
439# code fragment to extract pixel size from images
440# taken from http://www.tardis.ed.ac.uk/~ark/wwwis/
441# subroutines: _imgsize, _gifsize, _OLDgifsize, _gif_blockskip,
442# _NEWgifsize, _jpegsize
443#
444sub _imgsize {
445 my ( $file, $att ) = @_;
446 my ( $x, $y ) = ( 0, 0 );
447
448 if ( defined($file) ) {
449 binmode($file); # For Windows
450 my $s;
451 return ( 0, 0 ) unless ( read( $file, $s, 4 ) == 4 );
452 seek( $file, 0, 0 );
453 if ( $s eq 'GIF8' ) {
454
455 # GIF 47 49 46 38
456 ( $x, $y ) = _gifsize($file);
457 }
458 else {
459 my ( $a, $b, $c, $d ) = unpack( 'C4', $s );
460 if ( $a == 0x89
461 && $b == 0x50
462 && $c == 0x4E
463 && $d == 0x47 )
464 {
465
466 # PNG 89 50 4e 47
467 ( $x, $y ) = _pngsize($file);
468 }
469 elsif ($a == 0xFF
470 && $b == 0xD8
471 && $c == 0xFF
472 && ( $d == 0xE0 || $d == 0xE1 ) )
473 {
474
475 # JPG ff d8 ff e0/e1
476 ( $x, $y ) = _jpegsize($file);
477 }
478 }
479 close($file);
480 }
481 return ( $x, $y );
482}
483
484sub _gifsize {
485 my ($GIF) = @_;
486 if (0) {
487 return &_NEWgifsize($GIF);
488 }
489 else {
490 return &_OLDgifsize($GIF);
491 }
492}
493
494sub _OLDgifsize {
495 my ($GIF) = @_;
496 my ( $type, $a, $b, $c, $d, $s ) = ( 0, 0, 0, 0, 0, 0 );
497
498 if ( defined($GIF)
499 && read( $GIF, $type, 6 )
500 && $type =~ m/GIF8[7,9]a/
501 && read( $GIF, $s, 4 ) == 4 )
502 {
503 ( $a, $b, $c, $d ) = unpack( 'C' x 4, $s );
504 return ( $b << 8 | $a, $d << 8 | $c );
505 }
506 return ( 0, 0 );
507}
508
509# part of _NEWgifsize
510sub _gif_blockskip {
511 my ( $GIF, $skip, $type ) = @_;
512 my ($s) = 0;
513 my ($dummy) = '';
514
515 read( $GIF, $dummy, $skip ); # Skip header (if any)
516 while (1) {
517 if ( eof($GIF) ) {
518
519 #warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n";
520 return '';
521 }
522 read( $GIF, $s, 1 ); # Block size
523 last if ord($s) == 0; # Block terminator
524 read( $GIF, $dummy, ord($s) ); # Skip data
525 }
526}
527
528# this code by "Daniel V. Klein" <dvk@lonewolf.com>
529sub _NEWgifsize {
530 my ($GIF) = @_;
531 my ( $cmapsize, $a, $b, $c, $d, $e ) = 0;
532 my ( $type, $s ) = ( 0, 0 );
533 my ( $x, $y ) = ( 0, 0 );
534 my ($dummy) = '';
535
536 return ( $x, $y ) if ( !defined $GIF );
537
538 read( $GIF, $type, 6 );
539 if ( $type !~ /GIF8[7,9]a/ || read( $GIF, $s, 7 ) != 7 ) {
540
541 #warn "Invalid/Corrupted GIF (bad header)\n";
542 return ( $x, $y );
543 }
544 ($e) = unpack( "x4 C", $s );
545 if ( $e & 0x80 ) {
546 $cmapsize = 3 * 2**( ( $e & 0x07 ) + 1 );
547 if ( !read( $GIF, $dummy, $cmapsize ) ) {
548
549 #warn "Invalid/Corrupted GIF (global color map too small?)\n";
550 return ( $x, $y );
551 }
552 }
553 FINDIMAGE:
554 while (1) {
555 if ( eof($GIF) ) {
556
557 #warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n";
558 return ( $x, $y );
559 }
560 read( $GIF, $s, 1 );
561 ($e) = unpack( 'C', $s );
562 if ( $e == 0x2c ) { # Image Descriptor (GIF87a, GIF89a 20.c.i)
563 if ( read( $GIF, $s, 8 ) != 8 ) {
564
565 #warn "Invalid/Corrupted GIF (missing image header?)\n";
566 return ( $x, $y );
567 }
568 ( $a, $b, $c, $d ) = unpack( "x4 C4", $s );
569 $x = $b << 8 | $a;
570 $y = $d << 8 | $c;
571 return ( $x, $y );
572 }
573 if ( $type eq 'GIF89a' ) {
574 if ( $e == 0x21 ) { # Extension Introducer (GIF89a 23.c.i)
575 read( $GIF, $s, 1 );
576 ($e) = unpack( 'C', $s );
577 if ( $e == 0xF9 ) { # Graphic Control Extension (GIF89a 23.c.ii)
578 read( $GIF, $dummy, 6 ); # Skip it
579 next FINDIMAGE; # Look again for Image Descriptor
580 }
581 elsif ( $e == 0xFE ) { # Comment Extension (GIF89a 24.c.ii)
582 &_gif_blockskip( $GIF, 0, 'Comment' );
583 next FINDIMAGE; # Look again for Image Descriptor
584 }
585 elsif ( $e == 0x01 ) { # Plain Text Label (GIF89a 25.c.ii)
586 &_gif_blockskip( $GIF, 12, 'text data' );
587 next FINDIMAGE; # Look again for Image Descriptor
588 }
589 elsif ( $e == 0xFF )
590 { # Application Extension Label (GIF89a 26.c.ii)
591 &_gif_blockskip( $GIF, 11, 'application data' );
592 next FINDIMAGE; # Look again for Image Descriptor
593 }
594 else {
595
596 #printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e;
597 return ( $x, $y );
598 }
599 }
600 else {
601
602 #printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e;
603 return ( $x, $y );
604 }
605 }
606 else {
607
608 #warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n";
609 return ( $x, $y );
610 }
611 }
612}
613
614# _jpegsize : gets the width and height (in pixels) of a jpeg file
615# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
616# modified slightly by alex@ed.ac.uk
617sub _jpegsize {
618 my ($JPEG) = @_;
619 my ($done) = 0;
620 my ( $c1, $c2, $ch, $s, $length, $dummy ) = ( 0, 0, 0, 0, 0, 0 );
621 my ( $a, $b, $c, $d );
622
623 if ( defined($JPEG)
624 && read( $JPEG, $c1, 1 )
625 && read( $JPEG, $c2, 1 )
626 && ord($c1) == 0xFF
627 && ord($c2) == 0xD8 )
628 {
629 while ( ord($ch) != 0xDA && !$done ) {
630
631 # Find next marker (JPEG markers begin with 0xFF)
632 # This can hang the program!!
633 while ( ord($ch) != 0xFF ) {
634 return ( 0, 0 ) unless read( $JPEG, $ch, 1 );
635 }
636
637 # JPEG markers can be padded with unlimited 0xFF's
638 while ( ord($ch) == 0xFF ) {
639 return ( 0, 0 ) unless read( $JPEG, $ch, 1 );
640 }
641
642 # Now, $ch contains the value of the marker.
643 if ( ( ord($ch) >= 0xC0 ) && ( ord($ch) <= 0xC3 ) ) {
644 return ( 0, 0 ) unless read( $JPEG, $dummy, 3 );
645 return ( 0, 0 ) unless read( $JPEG, $s, 4 );
646 ( $a, $b, $c, $d ) = unpack( 'C' x 4, $s );
647 return ( $c << 8 | $d, $a << 8 | $b );
648 }
649 else {
650
651 # We **MUST** skip variables, since FF's within variable
652 # names are NOT valid JPEG markers
653 return ( 0, 0 ) unless read( $JPEG, $s, 2 );
654 ( $c1, $c2 ) = unpack( 'C' x 2, $s );
655 $length = $c1 << 8 | $c2;
656 last if ( !defined($length) || $length < 2 );
657 read( $JPEG, $dummy, $length - 2 );
658 }
659 }
660 }
661 return ( 0, 0 );
662}
663
664# _pngsize : gets the width & height (in pixels) of a png file
665# source: http://www.la-grange.net/2000/05/04-png.html
666sub _pngsize {
667 my ($PNG) = @_;
668 my ($head) = '';
669 my ( $a, $b, $c, $d, $e, $f, $g, $h ) = 0;
670 if ( defined($PNG)
671 && read( $PNG, $head, 8 ) == 8
672 && $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"
673 && read( $PNG, $head, 4 ) == 4
674 && read( $PNG, $head, 4 ) == 4
675 && $head eq 'IHDR'
676 && read( $PNG, $head, 8 ) == 8 )
677 {
678 ( $a, $b, $c, $d, $e, $f, $g, $h ) = unpack( 'C' x 8, $head );
679 return (
680 $a << 24 | $b << 16 | $c << 8 | $d,
681 $e << 24 | $f << 16 | $g << 8 | $h
682 );
683 }
684 return ( 0, 0 );
685}
686
68712µs1;
688__END__