view release on metacpan or  search on metacpan

Meta/Baseline/base_aegi_backup.pl  view on Meta::CPAN

#!/usr/bin/env perl

use strict qw(vars refs subs);
use Meta::Utils::System qw();
use Meta::Utils::Opts::Opts qw();
use Meta::Utils::Utils qw();
use Meta::Baseline::Aegis qw();
use Meta::Utils::Output qw();
use Meta::Archive::Tar qw();
use Meta::Template::Sub qw();
#use GnuPG qw();
use Net::SCP qw();
use Meta::Utils::File::Remove qw();
use Error qw(:try);

my($enum)=Meta::Baseline::Aegis::get_enum();

my($verb,$tarf,$dirf,$type,$author_file,$enc,$armor,$sign,$send,$remote_dir);

my($opts)=Meta::Utils::Opts::Opts->new();
$opts->set_standard();
$opts->def_bool("verbose","verbose or quiet ?",0,\$verb);
$opts->def_newf("tarfile","what file to backup to","[% project %]_[% change %]_[% time %].tar.gz",\$tarf);
$opts->def_stri("localdir","what directory to backup to ?","[% home_dir %]/backups",\$dirf);
$opts->def_enum("type","what type of backup ?",$enum->get_default(),\$type,$enum);
$opts->def_modu("author","author XML definition file","xmlx/author/author.xml",\$author_file);
$opts->def_bool("encrypt","encrypt the result ?",1,\$enc);
$opts->def_bool("armor","put ascii armor on encrypted files ?",0,\$armor);
$opts->def_bool("sign","sign the encrypted files ?",0,\$sign);
$opts->def_bool("send","send copy to internet ?",0,\$send);
$opts->def_stri("remote_dir","remote directory where backups are stored","backups",\$remote_dir);
$opts->set_free_allo(0);
$opts->analyze(\@ARGV);

$tarf=Meta::Template::Sub::interpolate($tarf);
$dirf=Meta::Template::Sub::interpolate($dirf);

my($list);
Meta::Utils::Output::verbose($verb,"started getting file list\n");
if($enum->is_selected($type,"change")) {
	$list=Meta::Baseline::Aegis::change_files_list(1,1,1,1,1,0);
}
if($enum->is_selected($type,"project")) {
	$list=Meta::Baseline::Aegis::project_files_list(1,1,0);
}
if($enum->is_selected($type,"source")) {
	$list=Meta::Baseline::Aegis::source_files_list(1,1,0,1,1,0);
}
Meta::Utils::Output::verbose($verb,"finished getting file list\n");
my($scod);
Meta::Utils::Output::verbose($verb,"started tarring\n");
my($tar)=Meta::Archive::Tar->new();
for(my($i)=0;$i<=$#$list;$i++) {
	my($curr)=$list->[$i];
	$tar->add_deve($curr,$curr);
}
Meta::Utils::Output::verbose($verb,"finished tarring\n");
$scod=$tar->write($dirf."/".$tarf);
if($enc) {
#	my($author)=Meta::Info::Author->new_modu($author_file);
#	my($enc_file)=$dirf."/".$tarf.".gpg";
#	my($gpg)=GnuPG->new();
#	Meta::Utils::Output::verbose($verb,"started encrypting\n");
#	$gpg->encrypt(
#		plaintext=>$dirf."/".$tarf,
#		output=>$enc_file,
#		recipient=>$author->get_default_email(),
#		armor=>$armor,
#		sign=>$sign,
#		passphrase=>$author->get_default_passphrase(),
#	);
#	Meta::Utils::Output::verbose($verb,"finished encrypting\n");
#	if($send) {
#		Meta::Utils::Output::verbose($verb,"started sending\n");
#		my($user)=$author->get_sourceforge_user();
#		my($host)=$author->get_sourceforge_ssh();
#		my($addr)=$user."@".$host.":".$remote_dir."/".$tarf.".gpg";
#		Meta::Utils::Output::verbose($verb,"addr is [".$addr."]\n");
#		my($scp)=Net::SCP->new($host,$user);
#		my($res)=$scp->scp($enc_file,$addr);
#		Meta::Utils::Output::verbose($verb,"res is [".$res."]\n");
#		if(!$res) {
#			throw Meta::Error::Simple("cannot put with error [".$scp->{errstr}."]");
#		}
#		Meta::Utils::Output::verbose($verb,"finished sending\n");
#	}
#	Meta::Utils::File::Remove::rm($enc_file);
}

Meta::Utils::System::exit($scod);

__END__

=head1 NAME

base_aegi_backup.pl - backup your change to a tar.gz file.

=head1 COPYRIGHT

Copyright (C) 2001, 2002 Mark Veltzer;
All rights reserved.

=head1 LICENSE

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.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.

=head1 DETAILS

	MANIFEST: base_aegi_backup.pl
	PROJECT: meta
	VERSION: 0.42

=head1 SYNOPSIS

	base_aegi_backup.pl

=head1 DESCRIPTION

This script backs up aegis related files to a .tar.gz or tar.bz2 file.
It uses the Archive::Tar perl module to create the archive.
This script works in one of several ways:
1. change: it backs up all the change files.
2. project: it backs up the baseline (with diregard to change).
3. source: it backs up the super position of change on project.
The script uses the Meta::Baseline::Aegis module to get the information