[TWiki-Dev] [SVN] PeterThoeny r20486 - in twiki/branches/TWikiRelease05x00/GetAWebAddOn: bin lib/TWiki/Contrib

[<de...@de...>]

Author: PeterThoeny
Date: 2011-02-23 23:06:06 -0600 (Wed, 23 Feb 2011)
New Revision: 20486
Trac url: http://develop.twiki.org/trac/changeset/20486

Modified:
   twiki/branches/TWikiRelease05x00/GetAWebAddOn/bin/get-a-web
   twiki/branches/TWikiRelease05x00/GetAWebAddOn/lib/TWiki/Contrib/GetAWebAddOn.pm
Log:
Item6638: Rewrite code to make it work on TWiki-5.0

Modified: twiki/branches/TWikiRelease05x00/GetAWebAddOn/bin/get-a-web
===================================================================
--- twiki/branches/TWikiRelease05x00/GetAWebAddOn/bin/get-a-web	2011-02-24 05:04:15 UTC (rev 20485)
+++ twiki/branches/TWikiRelease05x00/GetAWebAddOn/bin/get-a-web	2011-02-24 05:06:06 UTC (rev 20486)
@@ -1,107 +1,41 @@
 #!/usr/bin/perl -w
-# Copyright 2004 Will Norris.  All Rights Reserved.
-# License: GPL
+# Add-on for TWiki Enterprise Collaboration Platform, http://TWiki.org/
+#
+# Copyright (C) 2004-2005 Will Norris
+# Copyright (C) 2004-2011 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.
+
 use strict;
-my $VERSION = '0.99';
+my $VERSION = '1.0';
 
 BEGIN {
-    ++$|;
-    # Set default current working directory
-    if( $ENV{"SCRIPT_FILENAME"} && $ENV{"SCRIPT_FILENAME"} =~ /^(.+)\/[^\/]+$/ ) {
-        chdir $1;
+    if ( defined $ENV{GATEWAY_INTERFACE} or defined $ENV{MOD_PERL} ) {
+        $TWiki::cfg{Engine} = 'TWiki::Engine::CGI';
+        use CGI::Carp qw(fatalsToBrowser);
+        $SIG{__DIE__} = \&CGI::Carp::confess;
     }
-    # Set library paths in @INC at compile time
-    require './setlib.cfg';
+    else {
+        $TWiki::cfg{Engine} = 'TWiki::Engine::CLI';
+        require Carp;
+        $SIG{__DIE__} = \&Carp::confess;
+    }
+    $ENV{TWIKI_ACTION} = 'getaweb'; # defined in Config.spec
+    @INC = ('.', grep { $_ ne '.' } @INC);
+    require 'setlib.cfg';
 }
 
-use CGI;
-use CGI::Carp qw( fatalsToBrowser );;
 use TWiki;
-
-my $query = new CGI;
-
-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 );
-
-TWiki::UI::GetAWeb::getaweb( $webName, $topic, $userName, $query );
-
-################################################################################
-
-package TWiki::UI::GetAWeb;
-use Cwd qw( cwd );
-use Archive::Tar;
-use TWiki::Func;
-
-sub getaweb
-{
-    my ( $webName, $topic, $userName, $query ) = @_;
-    die unless $query;
-    my $error = '';
-
-    ($webName = $query->path_info()) =~ s|^/?(.*?)[\/\.](.*)\.(tar)$|$1|;
-    my $saveasweb = $query->param('saveasweb' ) || $webName;
-
-    my $dataDir;
-    my $pubDir;
-    my $templateDir;
-    if (defined(%TWiki::cfg)) {
-        $dataDir = $TWiki::cfg{DataDir};
-        $pubDir = $TWiki::cfg{PubDir};
-        $templateDir = $TWiki::cfg{TemplateDir};
-    }
-    #pre configure settings
-    $dataDir = $TWiki::dataDir if (!defined($dataDir) && defined($TWiki::dataDir));
-    $pubDir = $TWiki::pubDir if (!defined($pubDir) && defined($TWiki::pubDir));
-    $templateDir = $TWiki::templateDir if (!defined($templateDir) && defined($TWiki::templateDir));
-
-    $error .= qq{web "$webName" doesn't exist<br/>} unless TWiki::Func::webExists( $webName );
-    $error .= qq{data dir "$dataDir" doesn't exist<br/>} unless -d $dataDir;
-    $error .= qq{pub dir "$pubDir" doesn't exist<br/>} unless -d $pubDir;
-    $error .= qq{template dir "$templateDir" doesn't exist<br/>} unless -d $templateDir;
-
-    # TODO: use oops stuff
-    if ( $error ) 
-    {
-    	print "Content-type: text/html\n\n";
-	print $error;
-	return;
-    }
-	
-    # sets response header
-    print $query->header(-type=>'application/x-tar', -expire=>'now');
-
-    my $tar = Archive::Tar->new() or die $!;
-    foreach my $dirEntry ( 
-			   { dir => $dataDir, name => 'data' },
-			   { dir => $pubDir, name => 'pub' },
-			   { dir => $templateDir, name => 'templates' },
-			   )
-    {
-	next unless -d "$dirEntry->{dir}/$webName";
-	my $pushd = cwd();
-	chdir "$dirEntry->{dir}/$webName" or die $!;
-
-	# CODE SMELL: the archive will fail if no topics end up being exported
-	my @files = grep { !/(\.htpasswd|\.htaccess|.*\.lock|~$)/ } <* */*>;		# HACK: make true recursive thingee
-	foreach my $file ( @files )
-	{
-	    next if -d $file;
-	    local( $/, *FH ) ;
-	    open( FH, $file ) or die $!;
-	    my $contents = <FH>;
-	    
-	    $tar->add_data( "$dirEntry->{name}/$saveasweb/$file", $contents );	# or die ???
-	}
-	chdir $pushd;
-    }
-
-    my $io = IO::Handle->new() or die $!;
-    $io->fdopen(fileno(STDOUT), "w") or die $!;
-    $tar->write( $io ) or die $!;
-    $io->close() or die $!;
-}
+use TWiki::UI;
+$TWiki::engine->run();

Modified: twiki/branches/TWikiRelease05x00/GetAWebAddOn/lib/TWiki/Contrib/GetAWebAddOn.pm
===================================================================
--- twiki/branches/TWikiRelease05x00/GetAWebAddOn/lib/TWiki/Contrib/GetAWebAddOn.pm	2011-02-24 05:04:15 UTC (rev 20485)
+++ twiki/branches/TWikiRelease05x00/GetAWebAddOn/lib/TWiki/Contrib/GetAWebAddOn.pm	2011-02-24 05:06:06 UTC (rev 20486)
@@ -1,4 +1,105 @@
+# Add-on for TWiki Enterprise Collaboration Platform, http://TWiki.org/
+#
+# Copyright (C) 2004-2005 Will Norris
+# Copyright (C) 2004-2011 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.
+
 package TWiki::Contrib::GetAWebAddOn;
+
 use vars qw( $VERSION );
 $VERSION = '$Rev$';
+
+use Cwd qw( cwd );
+use Archive::Tar;
+use TWiki::Func;
+
+sub getaweb
+{
+    my $session = shift;
+
+    $TWiki::Plugins::SESSION = $session;
+
+    my $query = $session->{request};
+    my $webName  = $session->{webName};
+
+    die unless $query;
+    my $error = '';
+
+    ($webName = $query->path_info()) =~ s|^/?(.*?)[\/\.](.*)\.(tar)$|$1|;
+    my $saveasweb = $query->param('saveasweb' ) || $webName;
+
+    my $dataDir;
+    my $pubDir;
+    my $templateDir;
+    if (defined(%TWiki::cfg)) {
+        $dataDir = $TWiki::cfg{DataDir};
+        $pubDir = $TWiki::cfg{PubDir};
+        $templateDir = $TWiki::cfg{TemplateDir};
+    }
+    #pre configure settings
+    $dataDir = $TWiki::dataDir if (!defined($dataDir) && defined($TWiki::dataDir));
+    $pubDir = $TWiki::pubDir if (!defined($pubDir) && defined($TWiki::pubDir));
+    $templateDir = $TWiki::templateDir if (!defined($templateDir) && defined($TWiki::templateDir));
+
+    $error .= qq{web "$webName" doesn't exist<br/>} unless TWiki::Func::webExists( $webName );
+    $error .= qq{data dir "$dataDir" doesn't exist<br/>} unless -d $dataDir;
+    $error .= qq{pub dir "$pubDir" doesn't exist<br/>} unless -d $pubDir;
+    $error .= qq{template dir "$templateDir" doesn't exist<br/>} unless -d $templateDir;
+
+    # TODO: use oops stuff
+    if ( $error ) 
+    {
+    	print "Content-type: text/html\n\n";
+	print $error;
+	return;
+    }
+	
+    # sets response header
+    print CGI::header( -TYPE => 'application/x-tar',
+                       -Content_Disposition => "filename=TWiki-$webName-web.tar",
+                       -expire => 'now' );
+
+    my $tar = Archive::Tar->new() or die $!;
+    foreach my $dirEntry ( 
+			   { dir => $dataDir, name => 'data' },
+			   { dir => $pubDir, name => 'pub' },
+			   { dir => $templateDir, name => 'templates' },
+			   )
+    {
+	next unless -d "$dirEntry->{dir}/$webName";
+	my $pushd = cwd();
+	chdir "$dirEntry->{dir}/$webName" or die $!;
+
+	# CODE SMELL: the archive will fail if no topics end up being exported
+	my @files = grep { !/(\.htpasswd|\.htaccess|.*\.lock|~$)/ } <* */*>;		# HACK: make true recursive thingee
+	foreach my $file ( @files )
+	{
+	    next if( -d $file || $file =~ /\.lease$/ );
+	    local( $/, *FH ) ;
+	    open( FH, $file ) or die $!;
+	    my $contents = <FH>;
+	    
+	    $tar->add_data( "$dirEntry->{name}/$saveasweb/$file", $contents );	# or die ???
+	}
+	chdir $pushd;
+    }
+
+    my $io = IO::Handle->new() or die $!;
+    $io->fdopen(fileno(STDOUT), "w") or die $!;
+    $tar->write( $io ) or die $!;
+    $io->close() or die $!;
+}
+
 1;