#!/usr/bin/perl -wI. # # TWiki WikiClone (see wiki.pm for $wikiversion and other info) # # Based on parts of Ward Cunninghams original Wiki and JosWiki. # Copyright (C) 1998 Markus Peter - SPiN GmbH (warpi@spin.de) # Some changes by Dave Harris (drh@bhresearch.co.uk) incorporated # Copyright (C) 1999 Peter Thoeny, peter@thoeny.com # Additional mess by Patrick Ohl - Biomax Bioinformatics AG # January 2003 # # 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. # # 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. See the # GNU General Public License for more details, published at # http://www.gnu.org/copyleft/gpl.html use CGI::Carp qw( fatalsToBrowser ); use CGI; use lib ( '.' ); use lib ( '../lib' ); use TWiki; use IO::File; use POSIX qw(tmpnam); use strict; my $tmpFile; # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! # Please define your paths here # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! # local path to your twiki data my $localWebDir = "/usr/local/apache2/twiki/"; # web URL of your twiki instalation my $webDirUrl = "https://ike.nzqa.solnet.co.nz/twiki/"; # specify path to htmldoc my $htmldocCmd = "/usr/local/bin/htmldoc"; &main(); sub main { my $query = new CGI; # # Create temporary file: # my $fh; do{ $tmpFile = tmpnam() } until $fh = IO::File->new("$tmpFile.html", O_RDWR|O_CREAT|O_EXCL); # # fill temporary file: # # run the view stuff if( $query->param( 'skin') eq 'pdf'){ $query->param( 'skin','plain'); } my ( $htmlData, $theTopic ) = doView( $query ); # # do some html processing # $htmlData = transformHTMLData($htmlData); # do special 'custom' processing? if( $query->param( 'special' ) ){ $htmlData = projectTransform($htmlData); } if( $query->param( 'shiftHeaders') ){ $htmlData = shiftHeaders($htmlData); } # htmldoc does not correctly support sgml comments # so we filter them here: $htmlData =~ s&&&gs; # htmldoc failes if there is no

header (anymore)... if( ! ($htmlData =~ m/<[Hh]1>/) ){ print STDERR "Warning: no level 1 header in html data.\n"; $htmlData =~ s&).)*)>&

$theTopic

&; } # write to file print $fh $htmlData; # # start htmldoc and output it's sdtout: # # assemble the program call/ process arguments: my $programCall = "$htmldocCmd --book --links --linkstyle plain"; my $format = $query->param( 'format' ) || "pdf14"; $programCall .= " -t $format"; my $orientation = $query->param( 'orientation' ) || "portrait"; $programCall .= " --$orientation"; if($query->param( 'toclevels' ) eq '0' ){ $programCall .= " --no-toc "; $programCall .= " --firstpage "; $programCall .= $query->param( 'firstpage' ) || "c1"; } else { $programCall .= " --toclevels "; $programCall .= $query->param( 'toclevels' ) || "4"; $programCall .= " --firstpage "; $programCall .= $query->param( 'firstpage' ) || "toc"; } if($query->param( 'titlepg')){ if($query->param( 'titlepg') eq 'off' ){ $programCall .= " --no-title "; } } $programCall .= " --size "; $programCall .= $query->param( 'size' ) || "a4"; if($query->param( 'bodycolor')){ $programCall .= " --bodycolor "; $programCall .= $query->param( 'bodycolor'); } if($query->param( 'browserwidth')){ $programCall .= " --browserwidth "; $programCall .= $query->param( 'browserwidth'); } if($query->param( 'footer' )){ $programCall .= " --footer "; $programCall .= $query->param( 'footer'); } if($query->param( 'header' )){ $programCall .= " --header "; $programCall .= $query->param( 'header' ); } if($query->param( 'tocfooter' )){ $programCall .= " --tocfooter "; $programCall .= $query->param( 'tocfooter'); } if($query->param( 'tocheader' )){ $programCall .= " --tocheader "; $programCall .= $query->param( 'tocheader' ); } $programCall .= " $tmpFile.html"; print STDERR "Execution htmldoc:\n$programCall\n"; my $pid = open(PDF,"$programCall |") or die "Failed to fork: $!\n"; # output header: my $mimeType = ($format eq 'html') ? "text/html" : "application/$format"; $mimeType =~ s/\d+//g; print CGI::header( -TYPE => $mimeType ); # output pdf document: while(){ print; } } END { # close temporary file: unlink("$tmpFile.html") or die "Failed to unlink $tmpFile.html : $!"; } # # Here you can add some transformation within the HTML document to be processed... # leave in the correction of the tags. Otherwise HTMLDOC will not be able to access # images if you are using authentification. # sub transformHTMLData{ my ($htmlData) = @_; # correct referenced images $htmlData =~ s///g; return $htmlData; } # # shifts all html header (e.g.

->

) # sub shiftHeaders{ my ( $htmlData , $sh ) = @_; if( $sh eq /^[+-]?\d+$/){ print STDERR "ERROR: Shift operant '$sh' is not a valid integer.\n"; return $htmlData; } my $newHead; # You may want to modify next line if you do not want to shift _all_ headers. # I leave for example all header that contain a digit folowed by a point. # Look like this: # $htmlData =~ s&((?:(?!(|\d\.)).)*)&'6?6:($1+$sh)<1?1:($1+$sh)).'>'.$2.''&gse; $htmlData =~ s&((?:(?!).)*)&'6?6:($1+$sh)<1?1:($1+$sh)).'>'.$2.''&gse; return $htmlData; } # # Other project specific transformations: # I wanted to shift several header to get a nicer output... # # I use this for custom modifications upon the output. # sub projectTransform{ my ($htmlData) = @_; #rename wrongly named Interface sections: $htmlData =~ s&

((?:(?!

).)*)Interface((?:(?!

).)*)

((?:(?!).)*GUI\w+(?:(?!).)*)&

$1GUI$2

$3&gs; # shift GUIDescriptions and remove back link: $htmlData =~ s&

((?:(?!

).)*)GUI Description((?:(?!

).)*)UC\w*((?:(?!

).)*)

&

$1GUI Description$2$3

&g; # shift GUIDescriptions sub sections: $htmlData =~ s&

((?:(?!

).)*)Image((?:(?!

).)*)

&

$1Image$2

&g; $htmlData =~ s&

((?:(?!

).)*)References((?:(?!

).)*)

&

$1References$2

&g; $htmlData =~ s&

((?:(?!

).)*)Behavior((?:(?!

).)*)

&

$1Behavior$2

&g; $htmlData =~ s&

((?:(?!

).)*)Comment((?:(?!

).)*)

&

$1Comment$2

&g; # and so on... return $htmlData; } # # Copied from 'view' with little changes (skin etc.) # sub doView { my( $query ) = @_; my $thePathInfo = $query->path_info(); my $theRemoteUser = $query->remote_user(); my $theTopic = $query->param( 'topic' ); my $theUrl = $query->url; my( $topic, $webName, $scriptUrlPath, $userName ) = &TWiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $query ); my $tmpl = ""; my $text = ""; my $meta = ""; my $rev = $query->param( "rev" ); my $maxrev = 1; my $extra = ""; my $wikiUserName = &TWiki::userToWikiName( $userName ); my $revdate = ""; my $revuser = ""; my $viewRaw = $query->param( "raw" ) || ""; my $unlock = $query->param( "unlock" ) || ""; my $skin = $query->param( "skin" ) || "plain"; my $viewMeta = $query->param( "meta" ) || ""; if ($viewMeta) { $viewRaw = "debug"; } # get view template, standard view or a view with a different skin $tmpl = &TWiki::Store::readTemplate( "view", $skin ); if( ! $tmpl ) { TWiki::writeHeader( $query ); print "\n" . "

TWiki Installation Error

\n" . "Template file view.tmpl not found or template directory \n" . "$TWiki::templateDir not found.

\n" . "Check the \$templateDir variable in TWiki.cfg.\n" . "\n"; exit; } if( ! &TWiki::Store::webExists( $webName ) ) { my $url = &TWiki::getOopsUrl( $webName, $topic, "oopsnoweb" ); TWiki::redirect( $query, $url ); exit; } if( $unlock eq "on" ) { # unlock topic, user cancelled out of edit &TWiki::Store::lockTopic( $topic, "on" ); } # Most recent topic read in even if earlier topic requested - makes code simpler and performance impact should be minimal my $topicExists = &TWiki::Store::topicExists( $webName, $topic ); if( $topicExists ) { $text = &TWiki::Store::readTopicRaw( $webName, $topic ); if( ! $viewRaw ) { ( $meta, $text ) = &TWiki::Store::_extractMetaData( $webName, $topic , $text ); # ( $meta, $text ) = &TWiki::Store::readTopic( $webName, $topic ); } ( $revdate, $revuser, $maxrev ) = &TWiki::Store::getRevisionInfoFromMeta( $webName, $topic, $meta, "isoFormat" ); if( $rev ) { $rev =~ s/r?1\.//go; # cut 'r' and major if( $rev < 1 ) { $rev = 1; } if( $rev > $maxrev ) { $rev = $maxrev; } } else { $rev = $maxrev; } if( $rev < $maxrev ) { if( $viewRaw ) { $text = &TWiki::Store::readTopicRaw( $webName, $topic, "1.$rev" ); } else { ( $meta, $text ) = &TWiki::Store::readTopicVersion( $webName, $topic, "1.$rev" ); } ( $revdate, $revuser ) = &TWiki::Store::getRevisionInfo( $webName, $topic, "1.$rev", 1 ); $extra .= "r1.$rev"; } } else { $rev = 1; if( ( &TWiki::isWikiName( $topic ) ) || ( $topic =~ /^[A-Z]{3,}$/ ) ) { ( $meta, $text ) = &TWiki::Store::readTemplateTopic( "WebTopicViewTemplate" ); } else { ( $meta, $text ) = &TWiki::Store::readTemplateTopic( "WebTopicNonWikiTemplate" ); } $extra .= " (not exist)"; } if( $viewRaw ) { my $vtext = "

"; if( $viewRaw !~ /debug/i ) { $text =~ s/%META[\:A-Z]*{[^\}]*}%[\n\r]*//gos; } } # check access permission # To Do: Need to protect also %INCLUDE% and search my $viewAccessOK = &TWiki::Access::checkAccessPermission( "view", $wikiUserName, $text, $topic, $webName ); if( ! $viewAccessOK ) { # user could not be authenticated, may be not logged in yet? my $viewauthFile = $ENV{'SCRIPT_FILENAME'}; $viewauthFile =~ s|/view|/viewauth|o; if( ( ! $theRemoteUser ) && (-e $viewauthFile ) ) { # try again with authenticated viewauth script # instead of non authenticated view script my $url = $ENV{"REQUEST_URI"}; if( $url ) { # $url i.e. is "twiki/bin/view.cgi/Web/Topic?cms1=val1&cmd2=val2" $url =~ s|/view|/viewauth|o; $url = "$TWiki::urlHost$url"; } else { $url = "$TWiki::urlHost$scriptUrlPath/$viewauthFile/$webName/$topic"; } TWiki::redirect( $query, $url ); exit; } } if( ! $viewAccessOK ) { my $url = &TWiki::getOopsUrl( $webName, $topic, "oopsaccessview" ); TWiki::redirect( $query, $url ); exit; } if( ! $viewRaw ) { $text = &TWiki::handleCommonTags( $text, $topic ); $text = &TWiki::getRenderedVersion( $text ); } if( $TWiki::doLogTopicView ) { # write log entry &TWiki::Store::writeLog( "view", "$webName.$topic", $extra ); } my( $mirrorSiteName, $mirrorViewURL, $mirrorLink, $mirrorNote ) = &TWiki::readOnlyMirrorWeb( $webName ); if( $mirrorSiteName ) { # disable edit and attach $tmpl =~ s/%EDITTOPIC%/$mirrorLink | Edit<\/strike>/o; $tmpl =~ s/]*?>Attach<\/a>/Attach<\/strike>/oi; if( $topicExists ) { # remove the NOINDEX meta tag $tmpl =~ s/]*>//goi; } else { $text = ""; } $tmpl =~ s/%REVTITLE%//go; } elsif( $rev < $maxrev ) { # disable edit of previous revisions - FIXME consider change to use two templates $tmpl =~ s/%EDITTOPIC%/Edit<\/strike>/o; $tmpl =~ s/]*?>Attach<\/a>/Attach<\/strike>/oi; $tmpl =~ s|]*?>Rename/move<\/a>|Rename/move<\/strike>|oi; $tmpl =~ s/%REVTITLE%/\(r1.$rev\)/go; $tmpl =~ s/%REVARG%/&rev=1.$rev/go; } else { if( $topicExists ) { my( $sec, $min, $hour, $day, $mon, $year ) = gmtime( time() ); my $timestring = sprintf("%.2u%.2u%.2u%.2u%.2u",$mon+1,$day,$hour,$min,$sec); $tmpl =~ s/%EDITTOPIC%/Edit<\/b><\/a>/go; # remove the NOINDEX meta tag $tmpl =~ s/]*>//goi; } else { $tmpl =~ s/%EDITTOPIC%/Create<\/b><\/a>/go; } $tmpl =~ s/%REVTITLE%//go; $tmpl =~ s/%REVARG%//go; } my $i = $maxrev; my $j = $maxrev; my $revisions = ""; my $breakRev = 0; if( ( $TWiki::numberOfRevisions > 0 ) && ( $TWiki::numberOfRevisions < $maxrev ) ) { $breakRev = $maxrev - $TWiki::numberOfRevisions + 1; } while( $i > 0 ) { if( $i == $rev) { $revisions = "$revisions | r1.$i"; } else { $revisions = "$revisions | r1.$i"; } if( $i != 1 ) { if( $i == $breakRev ) { # Now obsolete because of 'More' link # $revisions = "$revisions | >..."; $i = 1; } else { $j = $i - 1; $revisions = "$revisions | >"; } } $i = $i - 1; } $tmpl =~ s/%REVISIONS%/$revisions/go; if( $topicExists ) { $revuser = &TWiki::userToWikiName( $revuser ); my $temp = &TWiki::getRenderedVersion( "r1.$rev - $revdate GMT - $revuser" ); $tmpl =~ s/%REVINFO%/$temp$mirrorNote/go; } else { $tmpl =~ s/%REVINFO%/$mirrorNote/go; } $tmpl = &TWiki::handleCommonTags( $tmpl, $topic ); if( $viewRaw ) { $tmpl =~ s/%META{[^}]*}%//go; } else { $tmpl = &TWiki::handleMetaTags( $webName, $topic, $tmpl, $meta, ( $rev == $maxrev ) ); } $tmpl = &TWiki::getRenderedVersion( $tmpl, "", $meta ); ## better to use meta rendering? $tmpl =~ s/%TEXT%/$text/go; $tmpl =~ s/%MAXREV%/1.$maxrev/go; $tmpl =~ s/%CURRREV%/1.$rev/go; $tmpl =~ s|( ?) *\n?|$1|gois; # remove tags (PTh 06 Nov 2000) # return page content return ( $tmpl ,$topic); }