647 lines
21 KiB
Perl
647 lines
21 KiB
Perl
|
# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
|
||
|
|
#
|
||
|
|
# Copyright (C) 2001-2007 Peter Thoeny, peter@thoeny.org
|
||
|
|
# and TWiki Contributors. All Rights Reserved. TWiki Contributors
|
||
|
|
# are listed in the AUTHORS file in the root of this distribution.
|
||
|
|
# NOTE: Please extend that file, not this notice.
|
||
|
|
#
|
||
|
|
# This program is free software; you can redistribute it and/or
|
||
|
|
# modify it under the terms of the GNU General Public License
|
||
|
|
# as published by the Free Software Foundation; either version 2
|
||
|
|
# of the License, or (at your option) any later version. For
|
||
|
|
# more details read LICENSE in the root of this distribution.
|
||
|
|
#
|
||
|
|
# This program is distributed in the hope that it will be useful,
|
||
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||
|
|
#
|
||
|
|
# As per the GPL, removal of this notice is prohibited.
|
||
|
|
|
||
|
|
=begin twiki
|
||
|
|
|
||
|
|
---+ package TWiki::Attach
|
||
|
|
|
||
|
|
A singleton object of this class is used to deal with attachments to topics.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
# Note: Meta-data is stored in topics fo performance. You need to use the
|
||
|
|
# official API to manipulate attachments. Dropping files into the
|
||
|
|
# attachments directory works only if the {AutoAttachPubFiles} configure
|
||
|
|
# setting is enabled.
|
||
|
|
|
||
|
|
package TWiki::Attach;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use Assert;
|
||
|
|
|
||
|
|
use TWiki::Attrs;
|
||
|
|
use TWiki::Store;
|
||
|
|
use TWiki::User;
|
||
|
|
use TWiki::Prefs;
|
||
|
|
use TWiki::Meta;
|
||
|
|
use TWiki::Time;
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ClassMethod new( $session )
|
||
|
|
|
||
|
|
Constructor
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub new {
|
||
|
|
my ( $class, $session ) = @_;
|
||
|
|
my $this = bless( {}, $class );
|
||
|
|
ASSERT($session->isa( 'TWiki')) if DEBUG;
|
||
|
|
$this->{session} = $session;
|
||
|
|
return $this;
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod renderMetaData( $web, $topic, $meta, $args ) -> $text
|
||
|
|
|
||
|
|
Generate a table of attachments suitable for the bottom of a topic
|
||
|
|
view, using templates for the header, footer and each row.
|
||
|
|
* =$web= the web
|
||
|
|
* =$topic= the topic
|
||
|
|
* =$meta= meta-data hash for the topic
|
||
|
|
* =$args= hash of attachment arguments
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub renderMetaData {
|
||
|
|
my( $this, $web, $topic, $meta, $attrs ) = @_;
|
||
|
|
ASSERT($this->isa( 'TWiki::Attach')) if DEBUG;
|
||
|
|
|
||
|
|
my $showAll = $attrs->{all};
|
||
|
|
my $showAttr = $showAll ? 'h' : '';
|
||
|
|
my $A = ( $showAttr ) ? ':A' : '';
|
||
|
|
my $title = $attrs->{title} || '';
|
||
|
|
my $tmplname = $attrs->{template} || 'attachtables';
|
||
|
|
|
||
|
|
my @attachments = $meta->find( 'FILEATTACHMENT' );
|
||
|
|
return '' unless @attachments;
|
||
|
|
|
||
|
|
my $templates = $this->{session}->{templates};
|
||
|
|
$templates->readTemplate($tmplname);
|
||
|
|
|
||
|
|
my $rows = '';
|
||
|
|
my $row = $templates->expandTemplate('ATTACH:files:row'.$A);
|
||
|
|
foreach my $attachment (
|
||
|
|
sort { ( $a->{name} || '') cmp ( $b->{name} || '' )}
|
||
|
|
@attachments ) {
|
||
|
|
my $attrAttr = $attachment->{attr};
|
||
|
|
|
||
|
|
if( ! $attrAttr || ( $showAttr && $attrAttr =~ /^[$showAttr]*$/ )) {
|
||
|
|
$rows .= $this->_formatRow( $web, $topic, $attachment, $row );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
my $text = '';
|
||
|
|
|
||
|
|
if( $showAll || $rows ne '' ) {
|
||
|
|
my $header = $templates->expandTemplate('ATTACH:files:header'.$A);
|
||
|
|
my $footer = $templates->expandTemplate('ATTACH:files:footer'.$A);
|
||
|
|
|
||
|
|
$text = $header.$rows.$footer;
|
||
|
|
}
|
||
|
|
return $title.$text;
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod formatVersions ( $web, $topic, $attrs ) -> $text
|
||
|
|
|
||
|
|
Generate a version history table for a single attachment
|
||
|
|
* =$web= - the web
|
||
|
|
* =$topic= - the topic
|
||
|
|
* =$attrs= - Hash of meta-data attributes
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub formatVersions {
|
||
|
|
my( $this, $web, $topic, %attrs ) = @_;
|
||
|
|
ASSERT($this->isa( 'TWiki::Attach')) if DEBUG;
|
||
|
|
|
||
|
|
my $store = $this->{session}->{store};
|
||
|
|
my $latestRev =
|
||
|
|
$store->getRevisionNumber( $web, $topic, $attrs{name} );
|
||
|
|
|
||
|
|
my $templates = $this->{session}->{templates};
|
||
|
|
$templates->readTemplate('attachtables');
|
||
|
|
|
||
|
|
my $header = $templates->expandTemplate('ATTACH:versions:header');
|
||
|
|
my $footer = $templates->expandTemplate('ATTACH:versions:footer');
|
||
|
|
my $row = $templates->expandTemplate('ATTACH:versions:row');
|
||
|
|
|
||
|
|
my $rows ='';
|
||
|
|
|
||
|
|
for( my $rev = $latestRev; $rev >= 1; $rev-- ) {
|
||
|
|
my( $date, $user, $minorRev, $comment ) =
|
||
|
|
$store->getRevisionInfo( $web, $topic, $rev, $attrs{name} );
|
||
|
|
$user = $user->webDotWikiName() if( $user );
|
||
|
|
|
||
|
|
$rows .= $this->_formatRow( $web, $topic,
|
||
|
|
{
|
||
|
|
name => $attrs{name},
|
||
|
|
version => $rev,
|
||
|
|
date => $date,
|
||
|
|
user => $user,
|
||
|
|
comment => $comment,
|
||
|
|
attr => $attrs{attr},
|
||
|
|
size => $attrs{size}
|
||
|
|
},
|
||
|
|
$row );
|
||
|
|
}
|
||
|
|
|
||
|
|
return "$header$rows$footer";
|
||
|
|
}
|
||
|
|
|
||
|
|
#Format a single row in an attachment table by expanding a template.
|
||
|
|
#| =$web= | the web |
|
||
|
|
#| =$topic= | the topic |
|
||
|
|
#| =$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) |
|
||
|
|
#| =$tmpl= | The template of a row |
|
||
|
|
sub _formatRow {
|
||
|
|
my ( $this, $web, $topic, $info, $tmpl ) = @_;
|
||
|
|
|
||
|
|
my $row = $tmpl;
|
||
|
|
|
||
|
|
$row =~ s/%A_(\w+)%/$this->_expandAttrs($1,$web,$topic,$info)/ge;
|
||
|
|
$row =~ s/$TWiki::TranslationToken/%/go;
|
||
|
|
|
||
|
|
return $row;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _expandAttrs {
|
||
|
|
my ( $this, $attr, $web, $topic, $info ) = @_;
|
||
|
|
my $file = $info->{name};
|
||
|
|
|
||
|
|
if ( $attr eq 'REV' ) {
|
||
|
|
return $info->{version};
|
||
|
|
}
|
||
|
|
elsif ( $attr eq 'ICON' ) {
|
||
|
|
my $picked = $this->{session}->mapToIconFileName( $file );
|
||
|
|
my $url = $this->{session}->getIconUrl( 0, $picked );
|
||
|
|
return CGI::img( { src => $url, width => 16, height=>16,
|
||
|
|
align => 'top',
|
||
|
|
alt => $picked || '',
|
||
|
|
border => 0 });
|
||
|
|
}
|
||
|
|
elsif ( $attr eq 'EXT' ) {
|
||
|
|
# $fileExtension is used to map the attachment to its MIME type
|
||
|
|
# only grab the last extension in case of multiple extensions
|
||
|
|
$file =~ m/\.([^.]*)$/;
|
||
|
|
return $1;
|
||
|
|
}
|
||
|
|
elsif ( $attr eq 'URL' ) {
|
||
|
|
return $this->{session}->getScriptUrl
|
||
|
|
( 0, 'viewfile', $web, $topic,
|
||
|
|
rev => $info->{version} || undef, filename => $file );
|
||
|
|
}
|
||
|
|
elsif ( $attr eq 'SIZE' ) {
|
||
|
|
my $attrSize = $info->{size};
|
||
|
|
$attrSize = 100 if( !$attrSize || $attrSize < 100 );
|
||
|
|
return sprintf( "%1.1f K", $attrSize / 1024 );
|
||
|
|
}
|
||
|
|
elsif ( $attr eq 'COMMENT' ) {
|
||
|
|
my $comment = $info->{comment};
|
||
|
|
if ( $comment) {
|
||
|
|
$comment =~ s/\|/|/g;
|
||
|
|
} else {
|
||
|
|
$comment = " ";
|
||
|
|
}
|
||
|
|
return $comment;
|
||
|
|
}
|
||
|
|
elsif ( $attr eq 'ATTRS' ) {
|
||
|
|
return $info->{attr} or " ";
|
||
|
|
}
|
||
|
|
elsif ( $attr eq 'FILE' ) {
|
||
|
|
return $file;
|
||
|
|
}
|
||
|
|
elsif ( $attr eq 'DATE' ) {
|
||
|
|
return TWiki::Time::formatTime( $info->{date} || 0 );
|
||
|
|
}
|
||
|
|
elsif ( $attr eq 'USER' ) {
|
||
|
|
my $user = $this->{session}->{users}->findUser($info->{user});
|
||
|
|
if (defined($user)) {
|
||
|
|
return $user->webDotWikiName();
|
||
|
|
} else {
|
||
|
|
return $info->{user};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
return $TWiki::TranslationToken.'A_'.$attr.$TWiki::TranslationToken;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod getAttachmentLink( $user, $web, $topic, $name, $meta ) -> $html
|
||
|
|
|
||
|
|
* =$user= - User doing the reading
|
||
|
|
* =$web= - Name of the web
|
||
|
|
* =$topic= - Name of the topic
|
||
|
|
* =$name= - Name of the attachment
|
||
|
|
* =$meta= - Meta object that contains the meta info
|
||
|
|
|
||
|
|
Build a link to the attachment, suitable for insertion in the topic.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub getAttachmentLink {
|
||
|
|
my ( $this, $user, $web, $topic, $attName, $meta ) = @_;
|
||
|
|
ASSERT($this->isa( 'TWiki::Attach')) if DEBUG;
|
||
|
|
|
||
|
|
my $att = $meta->get( 'FILEATTACHMENT', $attName );
|
||
|
|
my $fileComment = $att->{comment};
|
||
|
|
$fileComment = $attName unless ( $fileComment );
|
||
|
|
|
||
|
|
my $fileLink = '';
|
||
|
|
my $imgSize = '';
|
||
|
|
my $prefs = $this->{session}->{prefs};
|
||
|
|
my $store = $this->{session}->{store};
|
||
|
|
|
||
|
|
if( $attName =~ /\.(gif|jpg|jpeg|png)$/i ) {
|
||
|
|
# inline image
|
||
|
|
|
||
|
|
# The pixel size calculation is done for performance reasons
|
||
|
|
# Some browsers wait with rendering a page until the size of
|
||
|
|
# embedded images is known, e.g. after all images of a page are
|
||
|
|
# downloaded. When you upload an image to TWiki and checkmark
|
||
|
|
# the link checkbox, TWiki will generate the width and height
|
||
|
|
# img parameters, speeding up the page rendering.
|
||
|
|
my $stream = $store->getAttachmentStream( $user, $web, $topic, $attName );
|
||
|
|
my( $nx, $ny ) = &_imgsize( $stream, $attName );
|
||
|
|
my @attrs;
|
||
|
|
|
||
|
|
if( $nx > 0 && $ny > 0 ) {
|
||
|
|
push( @attrs, width=>$nx, height=>$ny );
|
||
|
|
$imgSize = "width='$nx' height='$ny'";
|
||
|
|
}
|
||
|
|
|
||
|
|
$fileLink = $prefs->getPreferencesValue( 'ATTACHEDIMAGEFORMAT' );
|
||
|
|
unless( $fileLink ) {
|
||
|
|
push( @attrs, src=>"%ATTACHURLPATH%/$attName" );
|
||
|
|
push( @attrs, alt=>$attName );
|
||
|
|
return " * $fileComment: ".CGI::br().CGI::img({ @attrs });
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# normal attached file
|
||
|
|
$fileLink = $prefs->getPreferencesValue( 'ATTACHEDFILELINKFORMAT' );
|
||
|
|
unless( $fileLink ) {
|
||
|
|
return " * [[%ATTACHURL%/$attName][$attName]]: $fileComment";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$fileLink =~ s/\$name/$attName/g;
|
||
|
|
$fileLink =~ s/\$comment/$fileComment/g;
|
||
|
|
$fileLink =~ s/\$size/$imgSize/g;
|
||
|
|
$fileLink =~ s/\\t/\t/go;
|
||
|
|
$fileLink =~ s/\\n/\n/go;
|
||
|
|
$fileLink =~ s/([^\n])$/$1\n/;
|
||
|
|
|
||
|
|
return $fileLink;
|
||
|
|
}
|
||
|
|
|
||
|
|
# code fragment to extract pixel size from images
|
||
|
|
# taken from http://www.tardis.ed.ac.uk/~ark/wwwis/
|
||
|
|
# subroutines: _imgsize, _gifsize, _OLDgifsize, _gif_blockskip,
|
||
|
|
# _NEWgifsize, _jpegsize
|
||
|
|
#
|
||
|
|
sub _imgsize {
|
||
|
|
my( $file, $att ) = @_;
|
||
|
|
my( $x, $y) = ( 0, 0 );
|
||
|
|
|
||
|
|
if( defined( $file ) ) {
|
||
|
|
# for crappy MS OSes - Win/Dos/NT use is NOT SUPPORTED
|
||
|
|
binmode( $file );
|
||
|
|
my $s;
|
||
|
|
return ( 0, 0 ) unless ( read( $file, $s, 4 ) == 4 );
|
||
|
|
seek( $file, 0, 0 );
|
||
|
|
if ( $s eq 'GIF8' ) {
|
||
|
|
# GIF 47 49 46 38
|
||
|
|
( $x, $y ) = _gifsize( $file );
|
||
|
|
} else {
|
||
|
|
my ( $a, $b, $c, $d ) = unpack( 'C4', $s );
|
||
|
|
if ( $a == 0x89 && $b == 0x50 &&
|
||
|
|
$c == 0x4E && $d == 0x47 ) {
|
||
|
|
# PNG 89 50 4e 47
|
||
|
|
( $x, $y ) = _pngsize( $file );
|
||
|
|
} elsif ( $a == 0xFF && $b == 0xD8 &&
|
||
|
|
$c == 0xFF && $d == 0xE0 ) {
|
||
|
|
# JPG ff d8 ff e0
|
||
|
|
( $x, $y ) = _jpegsize( $file );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
close( $file );
|
||
|
|
}
|
||
|
|
return( $x, $y );
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _gifsize
|
||
|
|
{
|
||
|
|
my( $GIF ) = @_;
|
||
|
|
if( 0 ) {
|
||
|
|
return &_NEWgifsize( $GIF );
|
||
|
|
} else {
|
||
|
|
return &_OLDgifsize( $GIF );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _OLDgifsize {
|
||
|
|
my( $GIF ) = @_;
|
||
|
|
my( $type, $a, $b, $c, $d, $s ) = ( 0, 0, 0, 0, 0, 0 );
|
||
|
|
|
||
|
|
if( defined( $GIF ) &&
|
||
|
|
read( $GIF, $type, 6 ) &&
|
||
|
|
$type =~ /GIF8[7,9]a/ &&
|
||
|
|
read( $GIF, $s, 4 ) == 4 ) {
|
||
|
|
( $a, $b, $c, $d ) = unpack( 'C'x4, $s );
|
||
|
|
return( $b<<8|$a, $d<<8|$c );
|
||
|
|
}
|
||
|
|
return( 0, 0 );
|
||
|
|
}
|
||
|
|
|
||
|
|
# part of _NEWgifsize
|
||
|
|
sub _gif_blockskip {
|
||
|
|
my ( $GIF, $skip, $type ) = @_;
|
||
|
|
my ( $s ) = 0;
|
||
|
|
my ( $dummy ) = '';
|
||
|
|
|
||
|
|
read( $GIF, $dummy, $skip ); # Skip header (if any)
|
||
|
|
while( 1 ) {
|
||
|
|
if( eof( $GIF ) ) {
|
||
|
|
#warn "Invalid/Corrupted GIF (at EOF in GIF $type)\n";
|
||
|
|
return '';
|
||
|
|
}
|
||
|
|
read( $GIF, $s, 1 ); # Block size
|
||
|
|
last if ord( $s ) == 0; # Block terminator
|
||
|
|
read( $GIF, $dummy, ord( $s ) ); # Skip data
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# this code by "Daniel V. Klein" <dvk@lonewolf.com>
|
||
|
|
sub _NEWgifsize {
|
||
|
|
my( $GIF ) = @_;
|
||
|
|
my( $cmapsize, $a, $b, $c, $d, $e ) = 0;
|
||
|
|
my( $type, $s ) = ( 0, 0 );
|
||
|
|
my( $x, $y ) = ( 0, 0 );
|
||
|
|
my( $dummy ) = '';
|
||
|
|
|
||
|
|
return( $x,$y ) if( !defined $GIF );
|
||
|
|
|
||
|
|
read( $GIF, $type, 6 );
|
||
|
|
if( $type !~ /GIF8[7,9]a/ || read( $GIF, $s, 7 ) != 7 ) {
|
||
|
|
#warn "Invalid/Corrupted GIF (bad header)\n";
|
||
|
|
return( $x, $y );
|
||
|
|
}
|
||
|
|
( $e ) = unpack( "x4 C", $s );
|
||
|
|
if( $e & 0x80 ) {
|
||
|
|
$cmapsize = 3 * 2**(($e & 0x07) + 1);
|
||
|
|
if( !read( $GIF, $dummy, $cmapsize ) ) {
|
||
|
|
#warn "Invalid/Corrupted GIF (global color map too small?)\n";
|
||
|
|
return( $x, $y );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
FINDIMAGE:
|
||
|
|
while( 1 ) {
|
||
|
|
if( eof( $GIF ) ) {
|
||
|
|
#warn "Invalid/Corrupted GIF (at EOF w/o Image Descriptors)\n";
|
||
|
|
return( $x, $y );
|
||
|
|
}
|
||
|
|
read( $GIF, $s, 1 );
|
||
|
|
( $e ) = unpack( 'C', $s );
|
||
|
|
if( $e == 0x2c ) { # Image Descriptor (GIF87a, GIF89a 20.c.i)
|
||
|
|
if( read( $GIF, $s, 8 ) != 8 ) {
|
||
|
|
#warn "Invalid/Corrupted GIF (missing image header?)\n";
|
||
|
|
return( $x, $y );
|
||
|
|
}
|
||
|
|
( $a, $b, $c, $d ) = unpack( "x4 C4", $s );
|
||
|
|
$x = $b<<8|$a;
|
||
|
|
$y = $d<<8|$c;
|
||
|
|
return( $x, $y );
|
||
|
|
}
|
||
|
|
if( $type eq 'GIF89a' ) {
|
||
|
|
if( $e == 0x21 ) { # Extension Introducer (GIF89a 23.c.i)
|
||
|
|
read( $GIF, $s, 1 );
|
||
|
|
( $e ) = unpack( 'C', $s );
|
||
|
|
if( $e == 0xF9 ) { # Graphic Control Extension (GIF89a 23.c.ii)
|
||
|
|
read( $GIF, $dummy, 6 ); # Skip it
|
||
|
|
next FINDIMAGE; # Look again for Image Descriptor
|
||
|
|
} elsif( $e == 0xFE ) { # Comment Extension (GIF89a 24.c.ii)
|
||
|
|
&_gif_blockskip( $GIF, 0, 'Comment' );
|
||
|
|
next FINDIMAGE; # Look again for Image Descriptor
|
||
|
|
} elsif( $e == 0x01 ) { # Plain Text Label (GIF89a 25.c.ii)
|
||
|
|
&_gif_blockskip( $GIF, 12, 'text data' );
|
||
|
|
next FINDIMAGE; # Look again for Image Descriptor
|
||
|
|
} elsif( $e == 0xFF ) { # Application Extension Label (GIF89a 26.c.ii)
|
||
|
|
&_gif_blockskip( $GIF, 11, 'application data' );
|
||
|
|
next FINDIMAGE; # Look again for Image Descriptor
|
||
|
|
} else {
|
||
|
|
#printf STDERR "Invalid/Corrupted GIF (Unknown extension %#x)\n", $e;
|
||
|
|
return( $x, $y );
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
#printf STDERR "Invalid/Corrupted GIF (Unknown code %#x)\n", $e;
|
||
|
|
return( $x, $y );
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
#warn "Invalid/Corrupted GIF (missing GIF87a Image Descriptor)\n";
|
||
|
|
return( $x, $y );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# _jpegsize : gets the width and height (in pixels) of a jpeg file
|
||
|
|
# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
|
||
|
|
# modified slightly by alex@ed.ac.uk
|
||
|
|
sub _jpegsize {
|
||
|
|
my( $JPEG ) = @_;
|
||
|
|
my( $done ) = 0;
|
||
|
|
my( $c1, $c2, $ch, $s, $length, $dummy ) = ( 0, 0, 0, 0, 0, 0 );
|
||
|
|
my( $a, $b, $c, $d );
|
||
|
|
|
||
|
|
if( defined( $JPEG ) &&
|
||
|
|
read( $JPEG, $c1, 1 ) &&
|
||
|
|
read( $JPEG, $c2, 1 ) &&
|
||
|
|
ord( $c1 ) == 0xFF &&
|
||
|
|
ord( $c2 ) == 0xD8 ) {
|
||
|
|
while ( ord( $ch ) != 0xDA && !$done ) {
|
||
|
|
# Find next marker (JPEG markers begin with 0xFF)
|
||
|
|
# This can hang the program!!
|
||
|
|
while( ord( $ch ) != 0xFF ) {
|
||
|
|
return( 0, 0 ) unless read( $JPEG, $ch, 1 );
|
||
|
|
}
|
||
|
|
# JPEG markers can be padded with unlimited 0xFF's
|
||
|
|
while( ord( $ch ) == 0xFF ) {
|
||
|
|
return( 0, 0 ) unless read( $JPEG, $ch, 1 );
|
||
|
|
}
|
||
|
|
# Now, $ch contains the value of the marker.
|
||
|
|
if( ( ord( $ch ) >= 0xC0 ) && ( ord( $ch ) <= 0xC3 ) ) {
|
||
|
|
return( 0, 0 ) unless read( $JPEG, $dummy, 3 );
|
||
|
|
return( 0, 0 ) unless read( $JPEG, $s, 4 );
|
||
|
|
( $a, $b, $c, $d ) = unpack( 'C'x4, $s );
|
||
|
|
return( $c<<8|$d, $a<<8|$b );
|
||
|
|
} else {
|
||
|
|
# We **MUST** skip variables, since FF's within variable
|
||
|
|
# names are NOT valid JPEG markers
|
||
|
|
return( 0, 0 ) unless read( $JPEG, $s, 2 );
|
||
|
|
( $c1, $c2 ) = unpack( 'C'x2, $s );
|
||
|
|
$length = $c1<<8|$c2;
|
||
|
|
last if( !defined( $length ) || $length < 2 );
|
||
|
|
read( $JPEG, $dummy, $length-2 );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return( 0, 0 );
|
||
|
|
}
|
||
|
|
|
||
|
|
# _pngsize : gets the width & height (in pixels) of a png file
|
||
|
|
# source: http://www.la-grange.net/2000/05/04-png.html
|
||
|
|
sub _pngsize {
|
||
|
|
my ($PNG) = @_;
|
||
|
|
my ($head) = '';
|
||
|
|
my($a, $b, $c, $d, $e, $f, $g, $h)=0;
|
||
|
|
if( defined($PNG) &&
|
||
|
|
read( $PNG, $head, 8 ) == 8 &&
|
||
|
|
$head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a" &&
|
||
|
|
read($PNG, $head, 4) == 4 &&
|
||
|
|
read($PNG, $head, 4) == 4 &&
|
||
|
|
$head eq 'IHDR' &&
|
||
|
|
read($PNG, $head, 8) == 8 ){
|
||
|
|
($a,$b,$c,$d,$e,$f,$g,$h)=unpack('C'x8,$head);
|
||
|
|
return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h);
|
||
|
|
}
|
||
|
|
return (0,0);
|
||
|
|
}
|
||
|
|
|
||
|
|
#Get file attachment attributes for old html
|
||
|
|
#format.
|
||
|
|
sub _getOldAttachAttr {
|
||
|
|
my( $this, $atext ) = @_;
|
||
|
|
my $fileName='';
|
||
|
|
my $filePath='';
|
||
|
|
my $fileSize='';
|
||
|
|
my $fileDate='';
|
||
|
|
my $fileUser='';
|
||
|
|
my $fileComment='';
|
||
|
|
my $before='';
|
||
|
|
my $item='';
|
||
|
|
my $after='';
|
||
|
|
|
||
|
|
( $before, $fileName, $after ) = split( /<(?:\/)*TwkFileName>/, $atext );
|
||
|
|
if( ! $fileName ) { $fileName = ''; }
|
||
|
|
if( $fileName ) {
|
||
|
|
( $before, $filePath, $after ) = split( /<(?:\/)*TwkFilePath>/, $atext );
|
||
|
|
if( ! $filePath ) { $filePath = ''; }
|
||
|
|
$filePath =~ s/<TwkData value="(.*)">//go;
|
||
|
|
if( $1 ) { $filePath = $1; } else { $filePath = ''; }
|
||
|
|
$filePath =~ s/\%NOP\%//goi; # delete placeholder that prevents WikiLinks
|
||
|
|
( $before, $fileSize, $after ) = split( /<(?:\/)*TwkFileSize>/, $atext );
|
||
|
|
if( ! $fileSize ) { $fileSize = '0'; }
|
||
|
|
( $before, $fileDate, $after ) = split( /<(?:\/)*TwkFileDate>/, $atext );
|
||
|
|
if( ! $fileDate ) {
|
||
|
|
$fileDate = '';
|
||
|
|
} else {
|
||
|
|
$fileDate =~ s/ / /go;
|
||
|
|
$fileDate = TWiki::Time::parseTime( $fileDate );
|
||
|
|
}
|
||
|
|
( $before, $fileUser, $after ) = split( /<(?:\/)*TwkFileUser>/, $atext );
|
||
|
|
if( ! $fileUser ) {
|
||
|
|
$fileUser = '';
|
||
|
|
} else {
|
||
|
|
my $u = $this->{session}->{users}->findUser( $fileUser );
|
||
|
|
$fileUser = $u->login() if $u;
|
||
|
|
}
|
||
|
|
$fileUser =~ s/ //go;
|
||
|
|
( $before, $fileComment, $after ) = split( /<(?:\/)*TwkFileComment>/, $atext );
|
||
|
|
if( ! $fileComment ) { $fileComment = ''; }
|
||
|
|
}
|
||
|
|
|
||
|
|
return ( $fileName, $filePath, $fileSize, $fileDate, $fileUser, $fileComment );
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod migrateToFileAttachmentMacro ( $meta, $text ) -> $text
|
||
|
|
|
||
|
|
Migrate old HTML format
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub migrateToFileAttachmentMacro {
|
||
|
|
my ( $this, $meta, $text ) = @_;
|
||
|
|
ASSERT($this->isa( 'TWiki::Attach')) if DEBUG;
|
||
|
|
ASSERT($meta->isa( 'TWiki::Meta')) if DEBUG;
|
||
|
|
|
||
|
|
my ( $before, $atext, $after ) = split( /<!--TWikiAttachment-->/, $text );
|
||
|
|
$text = $before || '';
|
||
|
|
$text .= $after if( $after );
|
||
|
|
$atext = '' if( ! $atext );
|
||
|
|
|
||
|
|
if( $atext =~ /<TwkNextItem>/ ) {
|
||
|
|
my $line = '';
|
||
|
|
foreach $line ( split( /<TwkNextItem>/, $atext ) ) {
|
||
|
|
my( $fileName, $filePath, $fileSize, $fileDate, $fileUser, $fileComment ) =
|
||
|
|
$this->_getOldAttachAttr( $line );
|
||
|
|
|
||
|
|
if( $fileName ) {
|
||
|
|
$meta->putKeyed( 'FILEATTACHMENT',
|
||
|
|
{
|
||
|
|
name => $fileName,
|
||
|
|
version => '',
|
||
|
|
path => $filePath,
|
||
|
|
size => $fileSize,
|
||
|
|
date => $fileDate,
|
||
|
|
user => $fileUser,
|
||
|
|
comment => $fileComment,
|
||
|
|
attr => ''
|
||
|
|
});
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# Format of macro that came before META:ATTACHMENT
|
||
|
|
my $line = '';
|
||
|
|
foreach $line ( split( /\r?\n/, $atext ) ) {
|
||
|
|
if( $line =~ /%FILEATTACHMENT{\s"([^"]*)"([^}]*)}%/ ) {
|
||
|
|
my $name = $1;
|
||
|
|
my $values = new TWiki::Attrs( $2 );
|
||
|
|
$values->{name} = $name;
|
||
|
|
$meta->putKeyed( 'FILEATTACHMENT', $values );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
return $text;
|
||
|
|
}
|
||
|
|
|
||
|
|
=pod
|
||
|
|
|
||
|
|
---++ ObjectMethod upgradeFrom1v0beta ( $meta ) -> $text
|
||
|
|
|
||
|
|
CODE_SMELL: Is this really necessary? upgradeFrom1v0beta?
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub upgradeFrom1v0beta {
|
||
|
|
my( $this, $meta ) = @_;
|
||
|
|
ASSERT($this->isa( 'TWiki::Attach')) if DEBUG;
|
||
|
|
|
||
|
|
my @attach = $meta->find( 'FILEATTACHMENT' );
|
||
|
|
foreach my $att ( @attach ) {
|
||
|
|
my $date = $att->{date} || 0;
|
||
|
|
if( $date =~ /-/ ) {
|
||
|
|
$date =~ s/ / /go;
|
||
|
|
$date = TWiki::Time::parseTime( $date );
|
||
|
|
}
|
||
|
|
$att->{date} = $date;
|
||
|
|
my $u = $this->{session}->{users}->findUser( $att->{user} );
|
||
|
|
$att->{user} = $u->webDotWikiName() if $u;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|