#!perl

use strict;
use warnings;

use File::Util;
use Archive::Tar;
use Data::Dumper;
use CGI;
use Template;
use CGI::Carp qw(fatalsToBrowser);

use TCE::Config;


our $msg_ok = $TCE::Config::MSG_SYMBOLS{'ok'};
our $msg_fail = $TCE::Config::MSG_SYMBOLS{'fail'};
our $msg_warn = $TCE::Config::MSG_SYMBOLS{'warn'};

our @messages = ();
our $go = 1;

# create the CGI object
my $cgi = CGI->new();

# create the File::Utils object
my $fu = File::Util->new();

# create the tar object
my $tar = Archive::Tar->new();

# get the directory name (use cgi)
my $directory = $cgi->param('itemid') || undef;
my $name_tgz = $cgi->param('filename') || $directory;

if ((-d $TCE::Config::ARCHIVE_DIR) && (-d $TCE::Config::ARCHIVE_BACKUP))
{
  if ($directory)
  {
  
    unless (-e $TCE::Config::ARCHIVE_DIR.$name_tgz.'.tgz')
    {
     	# expand path
     	$directory = $TCE::Config::ITEMS.$directory;
  
  	# read the directory
  	my @filelist = $fu->list_dir($directory, qw/--files-only --with-paths/); 
     	
     	# create tar file
     	$tar->add_files(@filelist);
          $tar->write($TCE::Config::ARCHIVE_DIR.$name_tgz.'.tgz',COMPRESS_GZIP);
  
     	
     	# delete item directory
          foreach my $file (@filelist) 
          {
      		unlink $file || error("$msg_warn Die Datei $file kann nicht gelöscht werden: $!");
          }
          rmdir $directory || error("$msg_warn Das Vorgangsverzeichnis konnte nicht gelöscht werden: $!");
          
          message("$msg_ok Der Vorgang wurde archiviert unter $TCE::Config::ARCHIVE_DIR$name_tgz.tgz") if ($go);
    }
    else
    {
          error("$msg_fail Es existiert bereits ein archivierter Vorgang mit dem Namen $name_tgz");
    }
  }
}
else
{
  error("$msg_fail Auf das Archiv kann nicht zugegriffen werden (mglw. ein Konfigurationsfehler).");
}

# output to browser
my $template = Template->new({'INCLUDE_PATH' => $TCE::Config::TEMPLATES_DIR});
print $cgi->header( -type=>"text/html" );
$template->process('tce_archive.tmpl',{'messages' => \@messages}) || die $template->error();	


exit(1);


sub message
{
	my $text = shift;
	push @messages, $text;
	return 1;
}

sub error
{
	my $text = shift;
	push @messages, $text;
	$go = 0;
	return undef; 

}