← Back to branch summary

~kosova/+junk/tuxfamily-twiki

« back to all changes in this revision

Viewing changes to foswiki/lib/Foswiki/Attach.pm

  • Committer: James Michael DuPont
  • Date: 2009-07-18 19:58:49 UTC
  • Revision ID: jamesmikedupont@gmail.com-20090718195849-vgbmaht2ys791uo2
added foswiki

Show diffs side-by-side

added added

removed removed

Lines of Context:
foswiki/lib/Foswiki/Attach.pm
 
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
# Note: Meta-data is stored in topics fo performance. You need to use the
 
12
# official API to manipulate attachments. Dropping files into the
 
13
# attachments directory works only if the {AutoAttachPubFiles} configure
 
14
# setting is enabled.
 
15
 
 
16
package Foswiki::Attach;
 
17
 
 
18
use strict;
 
19
use Assert;
 
20
 
 
21
=begin TML
 
22
 
 
23
---++ ClassMethod new($session)
 
24
 
 
25
Constructor.
 
26
 
 
27
=cut
 
28
 
 
29
sub new {
 
30
    my ( $class, $session ) = @_;
 
31
    my $this = bless( { session => $session }, $class );
 
32
 
 
33
    return $this;
 
34
}
 
35
 
 
36
=begin TML
 
37
 
 
38
---++ ObjectMethod finish()
 
39
Break circular references.
 
40
 
 
41
=cut
 
42
 
 
43
# Note to developers; please undef *all* fields in the object explicitly,
 
44
# whether they are references or not. That way this method is "golden
 
45
# documentation" of the live fields in the object.
 
46
sub finish {
 
47
    my $this = shift;
 
48
    undef $this->{session};
 
49
}
 
50
 
 
51
=begin TML
 
52
 
 
53
---++ ObjectMethod renderMetaData( $web, $topic, $meta, $args ) -> $text
 
54
 
 
55
Generate a table of attachments suitable for the bottom of a topic
 
56
view, using templates for the header, footer and each row.
 
57
   * =$web= the web
 
58
   * =$topic= the topic
 
59
   * =$meta= meta-data hash for the topic
 
60
   * =$args= hash of attachment arguments
 
61
 
 
62
=cut
 
63
 
 
64
sub renderMetaData {
 
65
    my ( $this, $web, $topic, $meta, $attrs ) = @_;
 
66
 
 
67
    my $showAll  = $attrs->{all};
 
68
    my $showAttr = $showAll ? 'h' : '';
 
69
    my $A        = ($showAttr) ? ':A' : '';
 
70
    my $title    = $attrs->{title} || '';
 
71
    my $tmplname = $attrs->{template} || 'attachtables';
 
72
 
 
73
    my @attachments = $meta->find('FILEATTACHMENT');
 
74
    return '' unless @attachments;
 
75
 
 
76
    my $templates = $this->{session}->templates;
 
77
    $templates->readTemplate($tmplname);
 
78
 
 
79
    my $rows = '';
 
80
    my $row  = $templates->expandTemplate( 'ATTACH:files:row' . $A );
 
81
    foreach
 
82
      my $attachment ( sort { ( $a->{name} || '' ) cmp( $b->{name} || '' ) }
 
83
        @attachments )
 
84
    {
 
85
        my $attrAttr = $attachment->{attr};
 
86
 
 
87
        if ( !$attrAttr || ( $showAttr && $attrAttr =~ /^[$showAttr]*$/ ) ) {
 
88
            $rows .= _formatRow( $this, $web, $topic, $attachment, $row );
 
89
        }
 
90
    }
 
91
 
 
92
    my $text = '';
 
93
 
 
94
    if ( $showAll || $rows ne '' ) {
 
95
        my $header = $templates->expandTemplate( 'ATTACH:files:header' . $A );
 
96
        my $footer = $templates->expandTemplate( 'ATTACH:files:footer' . $A );
 
97
 
 
98
        $text = $header . $rows . $footer;
 
99
    }
 
100
    return $title . $text;
 
101
}
 
102
 
 
103
=begin TML
 
104
 
 
105
---++ ObjectMethod formatVersions ( $web, $topic, $attrs ) -> $text
 
106
 
 
107
Generate a version history table for a single attachment
 
108
   * =$web= - the web
 
109
   * =$topic= - the topic
 
110
   * =$attrs= - Hash of meta-data attributes
 
111
 
 
112
=cut
 
113
 
 
114
sub formatVersions {
 
115
    my ( $this, $web, $topic, %attrs ) = @_;
 
116
 
 
117
    my $store     = $this->{session}->{store};
 
118
    my $users     = $this->{session}->{users};
 
119
    my $latestRev = $store->getRevisionNumber( $web, $topic, $attrs{name} );
 
120
 
 
121
    my $templates = $this->{session}->templates;
 
122
    $templates->readTemplate('attachtables');
 
123
 
 
124
    my $header = $templates->expandTemplate('ATTACH:versions:header');
 
125
    my $footer = $templates->expandTemplate('ATTACH:versions:footer');
 
126
    my $row    = $templates->expandTemplate('ATTACH:versions:row');
 
127
 
 
128
    my $rows = '';
 
129
 
 
130
    for ( my $rev = $latestRev ; $rev >= 1 ; $rev-- ) {
 
131
        my ( $date, $user, $minorRev, $comment ) =
 
132
          $store->getRevisionInfo( $web, $topic, $rev, $attrs{name} );
 
133
 
 
134
        $rows .= _formatRow(
 
135
            $this, $web, $topic,
 
136
            {
 
137
                name    => $attrs{name},
 
138
                version => $rev,
 
139
                date    => $date,
 
140
                user    => $user,
 
141
                comment => $comment,
 
142
                attr    => $attrs{attr},
 
143
                size    => $attrs{size}
 
144
            },
 
145
            $row
 
146
        );
 
147
    }
 
148
 
 
149
    return "$header$rows$footer";
 
150
}
 
151
 
 
152
#Format a single row in an attachment table by expanding a template.
 
153
#| =$web= | the web |
 
154
#| =$topic= | the topic |
 
155
#| =$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) |
 
156
#| =$tmpl= | The template of a row |
 
157
sub _formatRow {
 
158
    my ( $this, $web, $topic, $info, $tmpl ) = @_;
 
159
 
 
160
    my $row = $tmpl;
 
161
 
 
162
    $row =~ s/%A_(\w+)%/_expandAttrs( $this,$1,$web,$topic,$info)/ge;
 
163
    $row =~ s/$Foswiki::TranslationToken/%/go;
 
164
 
 
165
    return $row;
 
166
}
 
167
 
 
168
sub _expandAttrs {
 
169
    my ( $this, $attr, $web, $topic, $info ) = @_;
 
170
    my $file  = $info->{name} || '';
 
171
    my $users = $this->{session}->{users};
 
172
 
 
173
    require Foswiki::Time;
 
174
 
 
175
    if ( $attr eq 'REV' ) {
 
176
        return $info->{version};
 
177
    }
 
178
    elsif ( $attr eq 'ICON' ) {
 
179
        my $picked = $this->{session}->mapToIconFileName($file);
 
180
        if (!defined($picked) || ($picked eq '')) {
 
181
            return '';
 
182
        }
 
183
        my $url = $this->{session}->getIconUrl( 0, $picked );
 
184
        return CGI::img(
 
185
            {
 
186
                src    => $url,
 
187
                width  => 16,
 
188
                height => 16,
 
189
                align  => 'top',
 
190
                alt    => $picked || '',
 
191
                border => 0
 
192
            }
 
193
        );
 
194
    }
 
195
    elsif ( $attr eq 'EXT' ) {
 
196
 
 
197
        # $fileExtension is used to map the attachment to its MIME type
 
198
        # only grab the last extension in case of multiple extensions
 
199
        $file =~ m/\.([^.]*)$/;
 
200
        return $1;
 
201
    }
 
202
    elsif ( $attr eq 'URL' ) {
 
203
        return $this->{session}->getScriptUrl(
 
204
            0, 'viewfile', $web, $topic,
 
205
            rev => $info->{version} || undef,
 
206
            filename => $file
 
207
        );
 
208
    }
 
209
    elsif ( $attr eq 'SIZE' ) {
 
210
        my $attrSize = $info->{size};
 
211
        $attrSize = 100 if ( !$attrSize || $attrSize < 100 );
 
212
        return sprintf( "%1.1f&nbsp;K", $attrSize / 1024 );
 
213
    }
 
214
    elsif ( $attr eq 'COMMENT' ) {
 
215
        my $comment = $info->{comment};
 
216
        if ($comment) {
 
217
            $comment =~ s/\|/&#124;/g;
 
218
        }
 
219
        else {
 
220
            $comment = "&nbsp;";
 
221
        }
 
222
        return $comment;
 
223
    }
 
224
    elsif ( $attr eq 'ATTRS' ) {
 
225
        return $info->{attr} or "&nbsp;";
 
226
    }
 
227
    elsif ( $attr eq 'FILE' ) {
 
228
        return $file;
 
229
    }
 
230
    elsif ( $attr eq 'EFILE' ) {
 
231
 
 
232
        # Really aggressive URL encoding, required to protect wikiwords
 
233
        # See Bugs:Item3289, Bugs:Item3623
 
234
        $file =~ s/([^A-Za-z0-9])/'%'.sprintf('%02x',ord($1))/ge;
 
235
        return $file;
 
236
    }
 
237
    elsif ( $attr eq 'DATE' ) {
 
238
        return Foswiki::Time::formatTime( $info->{date} || 0 );
 
239
    }
 
240
    elsif ( $attr eq 'USER' ) {
 
241
        my $user = $info->{user} || 'UnknownUser';
 
242
        my $cUID;
 
243
        if ($user) {
 
244
            $cUID = $users->getCanonicalUserID($user);
 
245
            if ( !$cUID ) {
 
246
 
 
247
                # Not a login name or a wiki name. Is it a valid cUID?
 
248
                my $ln = $users->getLoginName($user);
 
249
                $cUID = $user if defined $ln && $ln ne 'unknown';
 
250
            }
 
251
        }
 
252
 
 
253
        return $users->webDotWikiName($cUID);
 
254
    }
 
255
    else {
 
256
        return $Foswiki::TranslationToken . 'A_' . $attr
 
257
          . $Foswiki::TranslationToken;
 
258
    }
 
259
}
 
260
 
 
261
=begin TML
 
262
 
 
263
---++ ObjectMethod getAttachmentLink( $user, $web, $topic, $name, $meta ) -> $html
 
264
 
 
265
   * =$user= - User doing the reading
 
266
   * =$web= - Name of the web
 
267
   * =$topic= - Name of the topic
 
268
   * =$name= - Name of the attachment
 
269
   * =$meta= - Meta object that contains the meta info
 
270
 
 
271
Build a link to the attachment, suitable for insertion in the topic.
 
272
 
 
273
=cut
 
274
 
 
275
sub getAttachmentLink {
 
276
    my ( $this, $user, $web, $topic, $attName, $meta ) = @_;
 
277
 
 
278
    my $att = $meta->get( 'FILEATTACHMENT', $attName );
 
279
    my $fileComment = $att->{comment};
 
280
    $fileComment = $attName unless ($fileComment);
 
281
 
 
282
    my $fileLink = '';
 
283
    my $imgSize  = '';
 
284
    my $prefs    = $this->{session}->{prefs};
 
285
    my $store    = $this->{session}->{store};
 
286
 
 
287
    # I18N: URL-encode the attachment filename
 
288
    my $fileURL = Foswiki::urlEncodeAttachment($attName);
 
289
 
 
290
    if ( $attName =~ /\.(gif|jpg|jpeg|png)$/i ) {
 
291
 
 
292
        # inline image
 
293
 
 
294
        # The pixel size calculation is done for performance reasons
 
295
        # Some browsers wait with rendering a page until the size of
 
296
        # embedded images is known, e.g. after all images of a page are
 
297
        # downloaded. When you upload an image to Foswiki and checkmark
 
298
        # the link checkbox, Foswiki will generate the width and height
 
299
        # img parameters, speeding up the page rendering.
 
300
        my $stream =
 
301
          $store->getAttachmentStream( $user, $web, $topic, $attName );
 
302
        my ( $nx, $ny ) = &_imgsize( $stream, $attName );
 
303
        my @attrs;
 
304
 
 
305
        if ( $nx > 0 && $ny > 0 ) {
 
306
            push( @attrs, width => $nx, height => $ny );
 
307
            $imgSize = "width='$nx' height='$ny'";
 
308
        }
 
309
 
 
310
        $fileLink = $prefs->getPreferencesValue('ATTACHEDIMAGEFORMAT');
 
311
        unless ($fileLink) {
 
312
            push( @attrs, src => "%ATTACHURLPATH%/$fileURL" );
 
313
            push( @attrs, alt => $attName );
 
314
            return "   * $fileComment: " . CGI::br() . CGI::img( {@attrs} );
 
315
        }
 
316
    }
 
317
    else {
 
318
 
 
319
        # normal attached file
 
320
        $fileLink = $prefs->getPreferencesValue('ATTACHEDFILELINKFORMAT');
 
321
        unless ($fileLink) {
 
322
            return "   * [[%ATTACHURL%/$fileURL][$attName]]: $fileComment";
 
323
        }
 
324
    }
 
325
 
 
326
    # I18N: Site specified %ATTACHEDIMAGEFORMAT% or %ATTACHEDFILELINKFORMAT%,
 
327
    # ensure that filename is URL encoded - first $name must be URL.
 
328
    $fileLink =~ s/\$name/$fileURL/;
 
329
    $fileLink =~ s/\$name/$attName/;
 
330
 
 
331
# Expand \t and \n early (only in the format, not in the comment) - Bugs:Item4581
 
332
    $fileLink =~ s/\\t/\t/go;
 
333
    $fileLink =~ s/\\n/\n/go;
 
334
    $fileLink =~ s/\$comment/$fileComment/g;
 
335
    $fileLink =~ s/\$size/$imgSize/g;
 
336
    $fileLink =~ s/([^\n])$/$1\n/;
 
337
 
 
338
    return $fileLink;
 
339
}
 
340
 
 
341
# code fragment to extract pixel size from images
 
342
# taken from http://www.tardis.ed.ac.uk/~ark/wwwis/
 
343
# subroutines: _imgsize, _gifsize, _OLDgifsize, _gif_blockskip,
 
344
#              _NEWgifsize, _jpegsize
 
345
#
 
346
sub _imgsize {
 
347
    my ( $file, $att ) = @_;
 
348
    my ( $x, $y ) = ( 0, 0 );
 
349
 
 
350
    if ( defined($file) ) {
 
351
        binmode($file);    # For Windows
 
352
        my $s;
 
353
        return ( 0, 0 ) unless ( read( $file, $s, 4 ) == 4 );
 
354
        seek( $file, 0, 0 );
 
355
        if ( $s eq 'GIF8' ) {
 
356
 
 
357
            #  GIF 47 49 46 38
 
358
            ( $x, $y ) = _gifsize($file);
 
359
        }
 
360
        else {
 
361
            my ( $a, $b, $c, $d ) = unpack( 'C4', $s );
 
362
            if (   $a == 0x89
 
363
                && $b == 0x50
 
364
                && $c == 0x4E
 
365
                && $d == 0x47 )
 
366
            {
 
367
 
 
368
                #  PNG 89 50 4e 47
 
369
                ( $x, $y ) = _pngsize($file);
 
370
            }
 
371
            elsif ($a == 0xFF
 
372
                && $b == 0xD8
 
373
                && $c == 0xFF
 
374
                && $d == 0xE0 )
 
375
            {
 
376
 
 
377
                #  JPG ff d8 ff e0
 
378
                ( $x, $y ) = _jpegsize($file);
 
379
            }
 
380
        }
 
381
        close($file);
 
382
    }
 
383
    return ( $x, $y );
 
384
}
 
385
 
 
386
sub _gifsize {
 
387
    my ($GIF) = @_;
 
388
    if (0) {
 
389
        return &_NEWgifsize($GIF);
 
390
    }
 
391
    else {
 
392
        return &_OLDgifsize($GIF);
 
393
    }
 
394
}
 
395
 
 
396
sub _OLDgifsize {
 
397
    my ($GIF) = @_;
 
398
    my ( $type, $a, $b, $c, $d, $s ) = ( 0, 0, 0, 0, 0, 0 );
 
399
 
 
400
    if (   defined($GIF)
 
401
        && read( $GIF, $type, 6 )
 
402
        && $type =~ /GIF8[7,9]a/
 
403
        && read( $GIF, $s, 4 ) == 4 )
 
404
    {
 
405
        ( $a, $b, $c, $d ) = unpack( 'C' x 4, $s );
 
406
        return ( $b << 8 | $a, $d << 8 | $c );
 
407
    }
 
408
    return ( 0, 0 );
 
409
}
 
410
 
 
411
# part of _NEWgifsize
 
412
sub _gif_blockskip {
 
413
    my ( $GIF, $skip, $type ) = @_;
 
414
    my ($s)     = 0;
 
415
    my ($dummy) = '';
 
416
 
 
417
    read( $GIF, $dummy, $skip );    # Skip header (if any)
 
418
    while (1) {
 
419
        if ( eof($GIF) ) {
 
420
 
 
421
            #warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n";
 
422
            return '';
 
423
        }
 
424
        read( $GIF, $s, 1 );        # Block size
 
425
        last if ord($s) == 0;       # Block terminator
 
426
        read( $GIF, $dummy, ord($s) );    # Skip data
 
427
    }
 
428
}
 
429
 
 
430
# this code by "Daniel V. Klein" <dvk@lonewolf.com>
 
431
sub _NEWgifsize {
 
432
    my ($GIF) = @_;
 
433
    my ( $cmapsize, $a, $b, $c, $d, $e ) = 0;
 
434
    my ( $type, $s ) = ( 0, 0 );
 
435
    my ( $x,    $y ) = ( 0, 0 );
 
436
    my ($dummy) = '';
 
437
 
 
438
    return ( $x, $y ) if ( !defined $GIF );
 
439
 
 
440
    read( $GIF, $type, 6 );
 
441
    if ( $type !~ /GIF8[7,9]a/ || read( $GIF, $s, 7 ) != 7 ) {
 
442
 
 
443
        #warn "Invalid/Corrupted GIF (bad header)\n";
 
444
        return ( $x, $y );
 
445
    }
 
446
    ($e) = unpack( "x4 C", $s );
 
447
    if ( $e & 0x80 ) {
 
448
        $cmapsize = 3 * 2**( ( $e & 0x07 ) + 1 );
 
449
        if ( !read( $GIF, $dummy, $cmapsize ) ) {
 
450
 
 
451
            #warn "Invalid/Corrupted GIF (global color map too small?)\n";
 
452
            return ( $x, $y );
 
453
        }
 
454
    }
 
455
  FINDIMAGE:
 
456
    while (1) {
 
457
        if ( eof($GIF) ) {
 
458
 
 
459
            #warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n";
 
460
            return ( $x, $y );
 
461
        }
 
462
        read( $GIF, $s, 1 );
 
463
        ($e) = unpack( 'C', $s );
 
464
        if ( $e == 0x2c ) {    # Image Descriptor (GIF87a, GIF89a 20.c.i)
 
465
            if ( read( $GIF, $s, 8 ) != 8 ) {
 
466
 
 
467
                #warn "Invalid/Corrupted GIF (missing image header?)\n";
 
468
                return ( $x, $y );
 
469
            }
 
470
            ( $a, $b, $c, $d ) = unpack( "x4 C4", $s );
 
471
            $x = $b << 8 | $a;
 
472
            $y = $d << 8 | $c;
 
473
            return ( $x, $y );
 
474
        }
 
475
        if ( $type eq 'GIF89a' ) {
 
476
            if ( $e == 0x21 ) {    # Extension Introducer (GIF89a 23.c.i)
 
477
                read( $GIF, $s, 1 );
 
478
                ($e) = unpack( 'C', $s );
 
479
                if ( $e == 0xF9 ) { # Graphic Control Extension (GIF89a 23.c.ii)
 
480
                    read( $GIF, $dummy, 6 );    # Skip it
 
481
                    next FINDIMAGE;    # Look again for Image Descriptor
 
482
                }
 
483
                elsif ( $e == 0xFE ) {    # Comment Extension (GIF89a 24.c.ii)
 
484
                    &_gif_blockskip( $GIF, 0, 'Comment' );
 
485
                    next FINDIMAGE;       # Look again for Image Descriptor
 
486
                }
 
487
                elsif ( $e == 0x01 ) {    # Plain Text Label (GIF89a 25.c.ii)
 
488
                    &_gif_blockskip( $GIF, 12, 'text data' );
 
489
                    next FINDIMAGE;       # Look again for Image Descriptor
 
490
                }
 
491
                elsif ( $e == 0xFF )
 
492
                {    # Application Extension Label (GIF89a 26.c.ii)
 
493
                    &_gif_blockskip( $GIF, 11, 'application data' );
 
494
                    next FINDIMAGE;    # Look again for Image Descriptor
 
495
                }
 
496
                else {
 
497
 
 
498
           #printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e;
 
499
                    return ( $x, $y );
 
500
                }
 
501
            }
 
502
            else {
 
503
 
 
504
                #printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e;
 
505
                return ( $x, $y );
 
506
            }
 
507
        }
 
508
        else {
 
509
 
 
510
            #warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n";
 
511
            return ( $x, $y );
 
512
        }
 
513
    }
 
514
}
 
515
 
 
516
# _jpegsize : gets the width and height (in pixels) of a jpeg file
 
517
# Andrew Tong, werdna@ugcs.caltech.edu           February 14, 1995
 
518
# modified slightly by alex@ed.ac.uk
 
519
sub _jpegsize {
 
520
    my ($JPEG) = @_;
 
521
    my ($done) = 0;
 
522
    my ( $c1, $c2, $ch, $s, $length, $dummy ) = ( 0, 0, 0, 0, 0, 0 );
 
523
    my ( $a, $b, $c, $d );
 
524
 
 
525
    if (   defined($JPEG)
 
526
        && read( $JPEG, $c1, 1 )
 
527
        && read( $JPEG, $c2, 1 )
 
528
        && ord($c1) == 0xFF
 
529
        && ord($c2) == 0xD8 )
 
530
    {
 
531
        while ( ord($ch) != 0xDA && !$done ) {
 
532
 
 
533
            # Find next marker (JPEG markers begin with 0xFF)
 
534
            # This can hang the program!!
 
535
            while ( ord($ch) != 0xFF ) {
 
536
                return ( 0, 0 ) unless read( $JPEG, $ch, 1 );
 
537
            }
 
538
 
 
539
            # JPEG markers can be padded with unlimited 0xFF's
 
540
            while ( ord($ch) == 0xFF ) {
 
541
                return ( 0, 0 ) unless read( $JPEG, $ch, 1 );
 
542
            }
 
543
 
 
544
            # Now, $ch contains the value of the marker.
 
545
            if ( ( ord($ch) >= 0xC0 ) && ( ord($ch) <= 0xC3 ) ) {
 
546
                return ( 0, 0 ) unless read( $JPEG, $dummy, 3 );
 
547
                return ( 0, 0 ) unless read( $JPEG, $s,     4 );
 
548
                ( $a, $b, $c, $d ) = unpack( 'C' x 4, $s );
 
549
                return ( $c << 8 | $d, $a << 8 | $b );
 
550
            }
 
551
            else {
 
552
 
 
553
                # We **MUST** skip variables, since FF's within variable
 
554
                # names are NOT valid JPEG markers
 
555
                return ( 0, 0 ) unless read( $JPEG, $s, 2 );
 
556
                ( $c1, $c2 ) = unpack( 'C' x 2, $s );
 
557
                $length = $c1 << 8 | $c2;
 
558
                last if ( !defined($length) || $length < 2 );
 
559
                read( $JPEG, $dummy, $length - 2 );
 
560
            }
 
561
        }
 
562
    }
 
563
    return ( 0, 0 );
 
564
}
 
565
 
 
566
#  _pngsize : gets the width & height (in pixels) of a png file
 
567
#  source: http://www.la-grange.net/2000/05/04-png.html
 
568
sub _pngsize {
 
569
    my ($PNG)  = @_;
 
570
    my ($head) = '';
 
571
    my ( $a, $b, $c, $d, $e, $f, $g, $h ) = 0;
 
572
    if (   defined($PNG)
 
573
        && read( $PNG, $head, 8 ) == 8
 
574
        && $head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a"
 
575
        && read( $PNG, $head, 4 ) == 4
 
576
        && read( $PNG, $head, 4 ) == 4
 
577
        && $head eq 'IHDR'
 
578
        && read( $PNG, $head, 8 ) == 8 )
 
579
    {
 
580
        ( $a, $b, $c, $d, $e, $f, $g, $h ) = unpack( 'C' x 8, $head );
 
581
        return (
 
582
            $a << 24 | $b << 16 | $c << 8 | $d,
 
583
            $e << 24 | $f << 16 | $g << 8 | $h
 
584
        );
 
585
    }
 
586
    return ( 0, 0 );
 
587
}
 
588
 
 
589
1;
 
590
__DATA__
 
591
# Module of Foswiki - The Free and Open Source Wiki, http://foswiki.org/
 
592
#
 
593
# Copyright (C) 2008-2009 Foswiki Contributors. Foswiki Contributors
 
594
# are listed in the AUTHORS file in the root of this distribution.
 
595
# NOTE: Please extend that file, not this notice.
 
596
#
 
597
# Additional copyrights apply to some or all of the code in this
 
598
# file as follows:
 
599
#
 
600
# Copyright (C) 2001-2007 Peter Thoeny, peter@thoeny.org
 
601
# and TWiki Contributors. All Rights Reserved. TWiki Contributors
 
602
# are listed in the AUTHORS file in the root of this distribution.
 
603
#
 
604
# This program is free software; you can redistribute it and/or
 
605
# modify it under the terms of the GNU General Public License
 
606
# as published by the Free Software Foundation; either version 2
 
607
# of the License, or (at your option) any later version. For
 
608
# more details read LICENSE in the root of this distribution.
 
609
#
 
610
# This program is distributed in the hope that it will be useful,
 
611
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
612
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
613
#
 
614
# As per the GPL, removal of this notice is prohibited.