← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/local/src/github.com/foswiki/core/bin/view
  Run on Sun Dec 4 17:17:59 2011
Reported on Sun Dec 4 17:27:00 2011

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