Filename | /var/www/foswikidev/core/lib/Foswiki/Attach.pm |
Statements | Executed 22 statements in 2.65ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 16µs | 29µs | BEGIN@13 | Foswiki::Attach::
1 | 1 | 1 | 12µs | 12µs | new | Foswiki::Attach::
1 | 1 | 1 | 11µs | 17µs | renderMetaData | Foswiki::Attach::
1 | 1 | 1 | 10µs | 15µs | BEGIN@14 | Foswiki::Attach::
1 | 1 | 1 | 10µs | 36µs | BEGIN@15 | Foswiki::Attach::
1 | 1 | 1 | 5µs | 5µs | BEGIN@17 | Foswiki::Attach::
1 | 1 | 1 | 4µs | 4µs | finish | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _NEWgifsize | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _OLDgifsize | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _cUID | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _expandAttrs | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _expandRowAttrs | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _formatFileSize | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _formatRow | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _gif_blockskip | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _gifsize | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _imgsize | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _jpegsize | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | _pngsize | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | formatVersions | Foswiki::Attach::
0 | 0 | 0 | 0s | 0s | getAttachmentLink | Foswiki::Attach::
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 | |||||
7 | A singleton object of this class is used to deal with attachments to topics. | ||||
8 | |||||
9 | =cut | ||||
10 | |||||
11 | package Foswiki::Attach; | ||||
12 | |||||
13 | 2 | 30µs | 2 | 42µ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 # spent 29µs making 1 call to Foswiki::Attach::BEGIN@13
# spent 13µs making 1 call to strict::import |
14 | 2 | 25µs | 2 | 19µ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 # spent 15µs making 1 call to Foswiki::Attach::BEGIN@14
# spent 4µs making 1 call to warnings::import |
15 | 2 | 48µs | 2 | 63µ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 # 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 | ||||
18 | 1 | 4µs | if ( $Foswiki::cfg{UseLocale} ) { | ||
19 | require locale; | ||||
20 | import locale(); | ||||
21 | } | ||||
22 | 1 | 2.51ms | 1 | 5µs | } # spent 5µs making 1 call to Foswiki::Attach::BEGIN@17 |
23 | |||||
24 | 1 | 600ns | our $MARKER = "\0"; | ||
25 | |||||
26 | =begin TML | ||||
27 | |||||
28 | ---++ ClassMethod new($session) | ||||
29 | |||||
30 | Constructor. | ||||
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 | ||||
35 | 1 | 1µs | my ( $class, $session ) = @_; | ||
36 | 1 | 9µs | my $this = bless( { session => $session }, $class ); | ||
37 | |||||
38 | 1 | 6µs | return $this; | ||
39 | } | ||||
40 | |||||
41 | =begin TML | ||||
42 | |||||
43 | ---++ ObjectMethod finish() | ||||
44 | Break 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 | ||||
52 | 1 | 600ns | my $this = shift; | ||
53 | 1 | 4µs | undef $this->{session}; | ||
54 | } | ||||
55 | |||||
56 | =begin TML | ||||
57 | |||||
58 | ---++ ObjectMethod renderMetaData( $topicObject, $args ) -> $text | ||||
59 | |||||
60 | Generate a table of attachments suitable for the bottom of a topic | ||||
61 | view, using templates for the header, footer and each row. | ||||
62 | * =$topicObject= the topic | ||||
63 | * =$args= hash of attachment arguments | ||||
64 | |||||
65 | Renders 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 | |||||
82 | Renders 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 | ||||
88 | 1 | 500ns | my ( $this, $topicObject, $attrs ) = @_; | ||
89 | |||||
90 | 1 | 600ns | my $showAll = $attrs->{all} || ''; | ||
91 | 1 | 400ns | my $showAttr = $showAll ? 'h' : ''; | ||
92 | 1 | 200ns | my $A = ($showAttr) ? ':A' : ''; | ||
93 | 1 | 400ns | my $title = $attrs->{title} || ''; | ||
94 | 1 | 300ns | my $tmplname = $attrs->{template} || 'attachtables'; | ||
95 | |||||
96 | 1 | 3µs | 1 | 6µs | my @attachments = $topicObject->find('FILEATTACHMENT'); # spent 6µs making 1 call to Foswiki::Meta::find |
97 | 1 | 6µ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 | |||||
139 | Generate a version history table for a single attachment | ||||
140 | * =$topicObject= - the topic | ||||
141 | * =$attrs= - Hash of meta-data attributes | ||||
142 | |||||
143 | =cut | ||||
144 | |||||
145 | sub 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 | | ||||
193 | sub _formatRow { | ||||
194 | my ( $this, $topicObject, $info, $tmpl, $attachmentNum, $isLast ) = @_; | ||||
195 | |||||
196 | my $row = $tmpl; | ||||
197 | |||||
198 | $row =~ | ||||
199 | s/%A_(\w+)%/_expandAttrs( $this, $1, $topicObject, $info, $attachmentNum)/ge; | ||||
200 | $row =~ | ||||
201 | s/%R_(\w+)%/_expandRowAttrs( $this, $1, $topicObject, $info, $attachmentNum, $isLast)/ge; | ||||
202 | $row =~ s/$MARKER/%/go; | ||||
203 | |||||
204 | return $row; | ||||
205 | } | ||||
206 | |||||
207 | sub _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/\|/|/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 " "; | ||||
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 | |||||
292 | sub _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 | |||||
305 | sub _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 | ||||
324 | sub _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 | |||||
358 | Build a link to the attachment, suitable for insertion in the topic. | ||||
359 | |||||
360 | =cut | ||||
361 | |||||
362 | sub 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 | # | ||||
444 | sub _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 | |||||
484 | sub _gifsize { | ||||
485 | my ($GIF) = @_; | ||||
486 | if (0) { | ||||
487 | return &_NEWgifsize($GIF); | ||||
488 | } | ||||
489 | else { | ||||
490 | return &_OLDgifsize($GIF); | ||||
491 | } | ||||
492 | } | ||||
493 | |||||
494 | sub _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 | ||||
510 | sub _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> | ||||
529 | sub _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 | ||||
617 | sub _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 | ||||
666 | sub _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 | |||||
687 | 1 | 2µs | 1; | ||
688 | __END__ |