1 rizwank 1.1 # Module of TWiki Collaboration Platform, http://TWiki.org/
2 #
3 # Copyright (C) 2001-2004 Peter Thoeny, peter@thoeny.com
4 #
5 # For licensing info read license.txt file in the TWiki root.
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License
8 # as published by the Free Software Foundation; either version 2
9 # of the License, or (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details, published at
15 # http://www.gnu.org/copyleft/gpl.html
16 #
17 # Notes:
18 # - Latest version at http://twiki.org/
19 # - Installation instructions in $dataDir/TWiki/TWikiDocumentation.txt
20 # - Customize variables in TWiki.cfg when installing TWiki.
21
22 rizwank 1.1 use strict;
23
24 =begin twiki
25
26 ---+ TWiki::Attach Module
27
28 This package contains routines for dealing with attachments to topics.
29
30 =cut
31
32 package TWiki::Attach;
33
34 use vars qw( %templateVars );
35
36 # ======================
37 =pod
38
39 ---++ sub renderMetaData ( $web, $topic, $meta, $args, $isTopRev )
40
41 Generate a table of attachments suitable for the bottom of a topic
42 view, using templates for the header, footer and each row.
43 rizwank 1.1 | =$web= | the web |
44 | =$topic= | the topic |
45 | =$meta= | meta-data hash for the topic |
46 | =$attrs= | hash of attachment arguments |
47 | $isTopTopicRev | 1 if this topic is being rendered at the most recent revision |
48
49 =cut
50
51 sub renderMetaData
52 {
53 my( $web, $topic, $meta, $attrs, $isTopTopicRev ) = @_;
54
55 my $showAll = TWiki::extractNameValuePair( $attrs, "all" );
56 my $showAttr = $showAll ? "h" : "";
57 my $a = ( $showAttr ) ? ":A" : "";
58
59 my @attachments = $meta->find( "FILEATTACHMENT" );
60
61 my $rows = "";
62 my $row = _getTemplate("ATTACH:files:row$a");
63 foreach my $attachment ( @attachments ) {
64 rizwank 1.1 my $attrAttr = $attachment->{attr};
65
66 if( ! $attrAttr || ( $showAttr && $attrAttr =~ /^[$showAttr]*$/ )) {
67 $rows .= _formatRow( $web,
68 $topic,
69 $attachment->{name},
70 $attachment->{version},
71 $isTopTopicRev,
72 $attachment->{date},
73 $attachment->{user},
74 $attachment->{comment},
75 $attachment,
76 $row );
77 }
78 }
79
80 my $text = "";
81
82 if( $showAll || $rows ne "" ) {
83 my $header = _getTemplate("ATTACH:files:header$a");
84 my $footer = _getTemplate("ATTACH:files:footer$a");
85 rizwank 1.1
86 $text = "$header$rows$footer";
87 }
88 return $text;
89 }
90
91 # PRIVATE get a template, reading the attachment tables template
92 # if not already defined.
93 sub _getTemplate {
94 my $template = shift;
95
96 if ( ! defined( $templateVars{$template} )) {
97 TWiki::Store::readTemplate("attachtables");
98 }
99
100 return TWiki::Store::handleTmplP($template);
101 }
102
103 #=========================
104 =pod
105
106 rizwank 1.1 ---++ sub formatVersions ( $theWeb, $theTopic, $attachment, $attrs )
107
108 Generate a version history table for a single attachment
109 | =$web= | the web |
110 | =$topic= | the topic |
111 | =$attachment= | basename of attachment |
112 | =$attrs= | Hash of meta-data attributes |
113
114 =cut
115
116 sub formatVersions {
117 my( $web, $topic, $attachment, $attrs ) = @_;
118
119 my $latestRev = TWiki::Store::getRevisionNumber( $web, $topic, $attachment );
120 $latestRev =~ m/\.(.*)/o;
121 my $maxRevNum = $1;
122
123 my $header = _getTemplate("ATTACH:versions:header");
124 my $footer = _getTemplate("ATTACH:versions:footer");
125 my $row = _getTemplate("ATTACH:versions:row");
126
127 rizwank 1.1 my $rows ="";
128
129 for( my $version = $maxRevNum; $version >= 1; $version-- ) {
130 my $rev = "1.$version";
131
132 my( $date, $userName, $minorRev, $comment ) =
133 TWiki::Store::getRevisionInfo( $web, $topic, $rev, $attachment );
134 $rows .= _formatRow( $web, $topic,
135 $attachment,
136 $rev,
137 ( $rev eq $latestRev),
138 $date,
139 $userName,
140 $comment,
141 $attrs,
142 $row );
143 }
144
145 return "$header$rows$footer";
146 }
147
148 rizwank 1.1 #=========================
149 =pod
150
151 ---++ sub _formatRow ( $web, $topic, $file, $rev, $topRev, $date, $userName, $comment, $attrs, $tmpl )
152
153 Format a single row in an attachment table by expanding a template.
154 | =$web= | the web |
155 | =$topic= | the topic |
156 | =$file= | the attachment file name |
157 | =$rev= | the required revision; required to be a full (major.minor) revision number |
158 | =$topRev= | boolean indicating if this revision is the most recent revision |
159 | =$date= | date of _this revision_ of the attachment |
160 | =$userName= | user (not wikiname) who uploaded this revision |
161 | =$comment= | comment against this revision |
162 | =$attrs= | reference to a hash of other meta-data attributes for the attachment |
163
164 =cut
165
166 sub _formatRow {
167 my ( $web, $topic, $file, $rev, $topRev,
168 $date, $userName, $comment, $attrs, $tmpl ) = @_;
169 rizwank 1.1
170 my $row = $tmpl;
171
172 $row =~ s/%A_REV%/$rev/go;
173
174 if ( $row =~ /%A_ICON%/o ) {
175 my $fileIcon = filenameToIcon( $file );
176 $row =~ s/%A_ICON%/$fileIcon/go;
177 }
178
179 if ( $row =~ /%A_URL%/o ) {
180 my $url;
181
182 if ( $topRev ) {
183 # I18N: To support attachments via UTF-8 URLs to attachment
184 # directories/files that use non-UTF-8 character sets, go through viewfile.
185 # If using %PUBURL%, must URL-encode explicitly to site character set.
186 $url = TWiki::handleNativeUrlEncode( "%PUBURLPATH%/$web/$topic/$file" );
187 } else {
188 $url = "%SCRIPTURLPATH%/viewfile%SCRIPTSUFFIX%/".
189 "$web/$topic?rev=$rev&filename=$file";
190 rizwank 1.1 }
191 $row =~ s/%A_URL%/$url/go;
192 }
193
194 if ( $row =~ /%A_SIZE%/o && $attrs ) {
195 my $attrSize = $attrs->{size};
196 $attrSize = 100 if( $attrSize < 100 );
197 $attrSize = sprintf( "%1.1f K", $attrSize / 1024 );
198 $row =~ s/%A_SIZE%/$attrSize/go;
199 }
200
201 $comment =~ s/\|/|/g;
202 $comment = " " unless ( $comment );
203 $row =~ s/%A_COMMENT%/$comment/go;
204
205 if ( $row =~ /%A_ATTRS%/o && $attrs ) {
206 my $attrAttr = $attrs->{attr};
207 $attrAttr = $attrAttr || " ";
208 $row =~ s/%A_ATTRS%/$attrAttr/go;
209 }
210
211 rizwank 1.1 $row =~ s/%A_FILE%/$file/go;
212
213 $date = TWiki::formatTime( $date );
214 $row =~ s/%A_DATE%/$date/go;
215
216 my $wikiUserName = TWiki::userToWikiName( $userName );
217 $row =~ s/%A_USER%/$wikiUserName/go;
218
219 return $row;
220 }
221
222 # =========================
223 =pod
224
225 ---++ sub filenameToIcon ( $fileName )
226
227 Produce an image tailored to the type of the file, guessed from
228 it's extension.
229
230 used in TWiki::handleIcon
231
232 rizwank 1.1 =cut
233
234 sub filenameToIcon
235 {
236 my( $fileName ) = @_;
237
238 my @bits = ( split( /\./, $fileName ) );
239 my $fileExt = lc $bits[$#bits];
240
241 my $tmp = &TWiki::getPubDir();
242 my $iconDir = "$tmp/icn";
243 my $iconUrl = "$TWiki::pubUrlPath/icn";
244 my $iconList = &TWiki::Store::readFile( "$iconDir/_filetypes.txt" );
245 foreach( split( /\n/, $iconList ) ) {
246 @bits = ( split( / / ) );
247 if( $bits[0] eq $fileExt ) {
248 return "<img src=\"$iconUrl/$bits[1].gif\" width=\"16\" height=\"16\" align=\"top\" alt=\"\" border=\"0\" />";
249 }
250 }
251 return "<img src=\"$iconUrl/else.gif\" width=\"16\" height=\"16\" align=\"top\" alt=\"\" border=\"0\" />";
252 }
253 rizwank 1.1
254 # =========================
255 =pod
256
257 ---++ sub removeFile ()
258
259 Remove attachment macro for specified file from topic
260 return "", or error string
261
262 =cut
263
264 sub removeFile
265 {
266 my $theFile = $_[1];
267 my $error = "";
268
269 # %FILEATTACHMENT{[\s]*"$theFile"[^}]*}%
270 if( ! ( $_[0] =~ s/%FILEATTACHMENT{[\s]*"$theFile"[^}]*}%//) ) {
271 $error = "Failed to remove attachment $theFile";
272 }
273 return $error;
274 rizwank 1.1 }
275
276 # =========================
277 =pod
278
279 ---++ sub updateProperties ( $fileName, $hideFile, $fileComment, $meta )
280
281 Not yet documented.
282
283 =cut
284
285 sub updateProperties
286 {
287 my( $fileName, $hideFile, $fileComment, $meta ) = @_;
288
289 my %fileAttachment = $meta->findOne( "FILEATTACHMENT", $fileName );
290 $fileAttachment{"attr"} = ( $hideFile ) ? "h" : "";
291 $fileAttachment{"comment"} = $fileComment;
292 $meta->put( "FILEATTACHMENT", %fileAttachment );
293 # FIXME warning if no entry?
294 }
295 rizwank 1.1
296 # =========================
297 =pod
298
299 ---++ sub updateAttachment ( $fileVersion, $fileName, $filePath, $fileSize, $fileDate, $fileUser, $fileComment, $hideFile, $meta )
300
301 Add/update attachment for a topic
302 $text is full set of attachments, new attachments will be added to the end.
303
304 =cut
305
306 sub updateAttachment
307 {
308 my ( $fileVersion, $fileName, $filePath, $fileSize, $fileDate, $fileUser, $fileComment, $hideFile, $meta ) = @_;
309
310 my $tmpAttr = ( $hideFile ) ? "h" : "";
311
312 my( $theFile, $theVersion, $thePath, $theSize, $theDate, $theUser,
313 $theComment, $theAttr ) = @_;
314
315 my @attrs = (
316 rizwank 1.1 "name" => $fileName,
317 "version" => $fileVersion,
318 "path" => $filePath,
319 "size" => $fileSize,
320 "date" => $fileDate,
321 "user" => $fileUser,
322 "comment" => $fileComment,
323 "attr" => $tmpAttr
324 );
325
326 $meta->put( "FILEATTACHMENT", @attrs );
327 }
328
329 #=========================
330 =pod
331
332 ---++ sub migrateFormatForTopic ( $theWeb, $theTopic, $doLogToStdOut )
333
334 Not yet documented.
335 CODE_SMELL: Is this really necessary? migrateFormatForTopic?
336
337 rizwank 1.1 =cut
338
339 sub migrateFormatForTopic
340 {
341 my ( $theWeb, $theTopic, $doLogToStdOut ) = @_;
342
343 my $text = TWiki::Store::readWebTopic( $theWeb, $theTopic );
344 my ( $before, $atext, $after ) = split( /<!--TWikiAttachment-->/, $text );
345 if( ! $before ) { $before = ""; }
346 if( ! $atext ) { $atext = ""; }
347
348 if ( $atext =~ /<TwkNextItem>/ ) {
349 my $newtext = migrateToFileAttachmentMacro( $atext );
350
351 $text = "$before<!--TWikiAttachment-->$newtext<!--TWikiAttachment-->";
352
353 my ( $dontLogSave, $doUnlock, $dontNotify ) = ( "", "1", "1" );
354 my $error = TWiki::Store::save( $theWeb, $theTopic, $text, "", $dontLogSave, $doUnlock, $dontNotify, "upgraded attachment format" );
355 if ( $error ) {
356 print "Attach: error from save: $error\n";
357 }
358 rizwank 1.1 if ( $doLogToStdOut ) {
359 print "Changed attachment format for $theWeb.$theTopic\n";
360 }
361 }
362 }
363
364 # =========================
365 =pod
366
367 ---++ sub getOldAttachAttr ( $atext )
368
369 Get file attachment attributes for old html
370 format.
371 CODE_SMELL: Is this really necessary? getOldAttachAttr?
372
373 =cut
374
375 sub getOldAttachAttr
376 {
377 my( $atext ) = @_;
378 my $fileName="";
379 rizwank 1.1 my $filePath="";
380 my $fileSize="";
381 my $fileDate="";
382 my $fileUser="";
383 my $fileComment="";
384 my $before="";
385 my $item="";
386 my $after="";
387
388 ( $before, $fileName, $after ) = split( /<(?:\/)*TwkFileName>/, $atext );
389 if( ! $fileName ) { $fileName = ""; }
390 if( $fileName ) {
391 ( $before, $filePath, $after ) = split( /<(?:\/)*TwkFilePath>/, $atext );
392 if( ! $filePath ) { $filePath = ""; }
393 $filePath =~ s/<TwkData value="(.*)">//go;
394 if( $1 ) { $filePath = $1; } else { $filePath = ""; }
395 $filePath =~ s/\%NOP\%//goi; # delete placeholder that prevents WikiLinks
396 ( $before, $fileSize, $after ) = split( /<(?:\/)*TwkFileSize>/, $atext );
397 if( ! $fileSize ) { $fileSize = "0"; }
398 ( $before, $fileDate, $after ) = split( /<(?:\/)*TwkFileDate>/, $atext );
399 if( ! $fileDate ) {
400 rizwank 1.1 $fileDate = "";
401 } else {
402 $fileDate =~ s/ / /go;
403 $fileDate = &TWiki::revDate2EpSecs( $fileDate );
404 }
405 ( $before, $fileUser, $after ) = split( /<(?:\/)*TwkFileUser>/, $atext );
406 if( ! $fileUser ) {
407 $fileUser = "";
408 } else {
409 $fileUser = &TWiki::wikiToUserName( $fileUser );
410 }
411 $fileUser =~ s/ //go;
412 ( $before, $fileComment, $after ) = split( /<(?:\/)*TwkFileComment>/, $atext );
413 if( ! $fileComment ) { $fileComment = ""; }
414 }
415
416 return ( $fileName, $filePath, $fileSize, $fileDate, $fileUser, $fileComment );
417 }
418
419 # =========================
420 =pod
421 rizwank 1.1
422 ---++ sub migrateToFileAttachmentMacro ( $meta, $text )
423
424 Migrate old HTML format, to %FILEATTACHMENT ... format
425 for one piece of text
426 CODE_SMELL: Is this really necessary? migrateToFileAttachmentMacro?
427
428 =cut
429
430 sub migrateToFileAttachmentMacro
431 {
432 my ( $meta, $text ) = @_;
433
434
435 my ( $before, $atext, $after ) = split( /<!--TWikiAttachment-->/, $text );
436 $text = $before || "";
437 $text .= $after if( $after );
438 $atext = "" if( ! $atext );
439
440 if( $atext =~ /<TwkNextItem>/ ) {
441 my $line = "";
442 rizwank 1.1 foreach $line ( split( /<TwkNextItem>/, $atext ) ) {
443 my( $fileName, $filePath, $fileSize, $fileDate, $fileUser, $fileComment ) =
444 getOldAttachAttr( $line );
445
446 if( $fileName ) {
447 my @attrs = (
448 "name" => $fileName,
449 "version" => "",
450 "path" => $filePath,
451 "size" => $fileSize,
452 "date" => $fileDate,
453 "user" => $fileUser,
454 "comment" => $fileComment,
455 "attr" => ""
456 );
457 $meta->put( "FILEATTACHMENT", @attrs );
458 }
459 }
460 } else {
461 # Format of macro that came before META:ATTACHMENT
462 my $line = "";
463 rizwank 1.1 foreach $line ( split( /\n/, $atext ) ) {
464 if( $line =~ /%FILEATTACHMENT{\s"([^"]*)"([^}]*)}%/ ) {
465 my $name = $1;
466 my $rest = $2;
467 $rest =~ s/^\s*//;
468 my @values = TWiki::Store::keyValue2list( $rest );
469 unshift @values, $name;
470 unshift @values, "name";
471 $meta->put( "FILEATTACHMENT", @values );
472 }
473 }
474 }
475
476 return $text;
477 }
478
479
480 # =========================
481 =pod
482
483 ---++ sub upgradeFrom1v0beta ( $meta )
484 rizwank 1.1
485 CODE_SMELL: Is this really necessary? upgradeFrom1v0beta?
486
487 =cut
488
489 sub upgradeFrom1v0beta
490 {
491 my( $meta ) = @_;
492
493 my @attach = $meta->find( "FILEATTACHMENT" );
494 foreach my $att ( @attach ) {
495 my $date = $att->{"date"};
496 if( $date =~ /-/ ) {
497 $date =~ s/ / /go;
498 $date = TWiki::revDate2EpSecs( $date );
499 }
500 $att->{"date"} = $date;
501 $att->{"user"} = &TWiki::wikiToUserName( $att->{"user"} );
502 }
503 }
504
505 rizwank 1.1 1;
|
Return to
Attach.pm
CVS log
Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki