App-SimpleBackuper
view release on metacpan or search on metacpan
lib/App/SimpleBackuper/Backup.pm view on Meta::CPAN
if(time - $last_db_save > $SAVE_DB_PERIOD) {
App::SimpleBackuper::BackupDB($options, $state);
$last_db_save = time;
}
}
while(my($full_path, $dir2upd) = each %dirs2upd) {
print "Updating dir $full_path..." if $options->{verbose};
my $file = $files->find_by_parent_id_name($dir2upd->{parent_id}, $dir2upd->{filename});
my @stat = lstat($full_path);
if(@stat and $file->{versions}->[-1]->{backup_id_max} != $state->{last_backup_id}) {
my($uid, $gid) =_proc_uid_gid($stat[4], $stat[5], $state->{db}->{uids_gids});
if($file->{versions}->[-1]->{backup_id_max} == $state->{last_backup_id} - 1) {
$file->{versions}->[-1] = {
%{ $file->{versions}->[-1] },
backup_id_max => $state->{last_backup_id},
uid => $uid,
gid => $gid,
size => $stat[7],
mode => $stat[2],
lib/App/SimpleBackuper/Backup.pm view on Meta::CPAN
}
if(! $priority) { # Excluded by user
print " -> skip\n" if $options->{verbose};
return;
}
$state->{profile}->{fs} -= time;
$state->{profile}->{fs_lstat} -= time;
$file_time_spent -= time;
my @stat = lstat($task->[0]);
$file_time_spent += time;
$state->{profile}->{fs} += time;
$state->{profile}->{fs_lstat} += time;
if(! @stat) {
print ". Not exists\n" if $options->{verbose};
return;
}
else {
printf ", stat: %s:%s %o %s modified at %s", scalar getpwuid($stat[4]), scalar getgrgid($stat[5]), $stat[2], fmt_weight($stat[7]), fmt_datetime($stat[9]) if $options->{verbose};
}
lib/App/SimpleBackuper/Restore.pm view on Meta::CPAN
print "$backup_path -> $fs_path\n" if $options->{verbose};
my($version) = grep {$_->{backup_id_min} <= $state->{backup_id} and $_->{backup_id_max} >= $state->{backup_id}}
@{ $file->{versions} };
if(! $version) {
print "\tnot exists in this backup.\n" if $options->{verbose};
return;
}
my @stat = lstat($fs_path);
my($fs_user, $fs_group);
if(@stat) {
$fs_user = getpwuid($stat[4]);
$fs_group = getpwuid($stat[5]);
}
if(S_ISDIR $version->{mode}) {
my $need2mkdir;
if(@stat) {
if(! S_ISDIR $stat[2]) {
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my $check = delete $opts{check};
$check = 1 unless defined $check;
%opts and _croak_bad_options(keys %opts);
if (defined $cwd) {
if ($check) {
$cwd = $sftp->realpath($cwd);
return undef unless defined $cwd;
_untaint($cwd);
my $a = $sftp->stat($cwd)
or return undef;
unless (_is_dir($a->perm)) {
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
"Remote object '$cwd' is not a directory");
return undef;
}
}
else {
$cwd = $sftp->_rel2abs($cwd);
}
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my ($sftp, $rfh, $pos, $whence) = @_;
$sftp->flush($rfh) or return undef;
if (!$whence) {
$rfh->_pos($pos)
}
elsif ($whence == 1) {
$rfh->_inc_pos($pos)
}
elsif ($whence == 2) {
my $a = $sftp->stat($rfh) or return undef;
$rfh->_pos($pos + $a->size);
}
else {
croak "invalid value for whence argument ('$whence')";
}
1;
}
sub tell {
@_ == 2 or croak 'Usage: $sftp->tell($fh)';
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
${$rfh->_bin} = '';
}
if ($dir ne 'in') { # flush out!
my $bout = $rfh->_bout;
my $len = length $$bout;
if ($len) {
my $start;
my $append = $rfh->_flag('append');
if ($append) {
my $attr = $sftp->stat($rfh)
or return undef;
$start = $attr->size;
}
else {
$start = $rfh->_pos;
${$rfh->_bin} = '';
}
my $off = 0;
my $written = $sftp->_write($rfh, $start,
sub {
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
$rfh->_inc_pos(1);
return substr $$bin, 0, 1, '';
}
return undef;
}
## SSH2_FXP_LSTAT (7), SSH2_FXP_FSTAT (8), SSH2_FXP_STAT (17)
# these all return a Net::SFTP::Foreign::Attributes object on success, undef on failure
sub lstat {
@_ <= 2 or croak 'Usage: $sftp->lstat($path)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $path) = @_;
$path = '.' unless defined $path;
$path = $sftp->_rel2abs($path);
my $id = $sftp->_queue_str_request(SSH2_FXP_LSTAT, $sftp->_fs_encode($path));
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_ATTRS, $id,
SFTP_ERR_REMOTE_LSTAT_FAILED, "Couldn't stat remote link")) {
return $msg->get_attributes;
}
return undef;
}
sub stat {
@_ <= 2 or croak 'Usage: $sftp->stat($path_or_fh)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $pofh) = @_;
$pofh = '.' unless defined $pofh;
my $id = $sftp->_queue_new_msg( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle'))
? ( SSH2_FXP_FSTAT, str => $sftp->_rid($pofh))
: ( SSH2_FXP_STAT, str => $sftp->_fs_encode($sftp->_rel2abs($pofh))) );
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_ATTRS, $id,
SFTP_ERR_REMOTE_STAT_FAILED, "Couldn't stat remote file")) {
return $msg->get_attributes;
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
"mkdir '$target' failed", $!);
return;
}
}
}
$debug and $debug & 32768 and _debug "_mkpath_local succeeded";
return 1;
}
sub setstat {
@_ == 3 or croak 'Usage: $sftp->setstat($path_or_fh, $attrs)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $pofh, $attrs) = @_;
my $id = $sftp->_queue_new_msg( ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle') )
? ( SSH2_FXP_FSETSTAT, str => $sftp->_rid($pofh) )
: ( SSH2_FXP_SETSTAT, str => $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) ),
attr => $attrs );
return $sftp->_check_status_ok($id,
SFTP_ERR_REMOTE_SETSTAT_FAILED,
"Couldn't setstat remote file");
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
}
$overwrite = 1 unless (defined $overwrite or $local_is_fh or $numbered or $append);
$copy_perm = 1 unless (defined $perm or defined $copy_perm or $local_is_fh);
$copy_time = 1 unless (defined $copy_time or $local_is_fh);
$mkpath = 1 unless defined $mkpath;
$cleanup = ($atomic || $numbered) unless defined $cleanup;
my $a = do {
local $sftp->{_autodie};
$sftp->stat($remote);
};
my ($rperm, $size, $atime, $mtime) = ($a ? ($a->perm, $a->size, $a->atime, $a->mtime) : ());
$size = -1 unless defined $size;
if ($copy_time and not defined $atime) {
if ($best_effort) {
undef $copy_time;
}
else {
$sftp->_ok_or_autodie and $sftp->_set_error(SFTP_ERR_REMOTE_STAT_FAILED,
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my $rfh;
my $writeoff = 0;
my $converter = _gen_converter $conversion;
my $converted_input = '';
my $rattrs;
if ($resume or $append) {
$rattrs = do {
local $sftp->{_autodie};
$sftp->stat($remote);
};
if ($rattrs) {
if ($resume and $resume eq 'auto' and $rattrs->mtime <= $lmtime) {
$debug and $debug & 16384 and
_debug "not resuming because local file is newer, r: ".$rattrs->mtime." l: $lmtime";
undef $resume;
}
else {
$writeoff = $rattrs->size;
$debug and $debug & 16384 and _debug "resuming from $writeoff";
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my $ln = $sftp->_fs_decode($msg->get_str);
# my $a = $msg->get_attributes;
my $a = Net::SFTP::Foreign::Attributes->new_from_buffer($msg);
my $entry = { filename => $fn,
longname => $ln,
a => $a };
if ($follow_links and _is_lnk($a->perm)) {
if ($a = $sftp->stat($sftp->join($dir, $fn))) {
$entry->{a} = $a;
}
else {
$sftp->_clear_error_and_status;
}
}
if ($realpath) {
my $rp = $sftp->realpath($sftp->join($dir, $fn));
if (defined $rp) {
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my ($sftp, $remote, $local, %opts) = @_;
my $overwrite = delete $opts{overwrite};
my $numbered = delete $opts{numbered};
croak "'overwrite' and 'numbered' can not be used together"
if ($overwrite and $numbered);
%opts and _croak_bad_options(keys %opts);
$overwrite = 1 unless (defined $overwrite or $numbered);
my $a = $sftp->lstat($remote) or return undef;
unless (_is_lnk($a->perm)) {
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
"Remote object '$remote' is not a symlink");
return undef;
}
my $link = $sftp->readlink($remote) or return undef;
# TODO: this is too weak, may contain race conditions.
if ($numbered) {
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
if ($sftp->put_symlink($fn, $rpath,
%put_symlink_opts)) {
$count++;
return undef;
}
$lfs->_copy_error($sftp);
}
elsif (_is_reg($e->{a}->perm)) {
my $ra;
if ( $newer_only and
$ra = $sftp->stat($rpath) and
$ra->mtime >= $e->{a}->mtime) {
$lfs->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS,
"Newer remote file '$rpath' already exists");
}
else {
if ($sftp->put($fn, $rpath,
( defined($perm) ? (perm => $perm)
: $copy_perm ? (perm => $e->{a}->perm & $mask)
: (copy_perm => 0, umask => $umask) ),
copy_time => $copy_time,
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
returns the next entry from the remote directory C<$handle> (or all
the remaining entries when called in list context).
The return values are a hash with three keys: C<filename>, C<longname> and
C<a>. The C<a> value contains a L<Net::SFTP::Foreign::Attributes>
object describing the entry.
Returns undef on error or when no more entries exist on the directory.
=item $sftp-E<gt>stat($path_or_fh)
performs a C<stat> on the remote file and returns a
L<Net::SFTP::Foreign::Attributes> object with the result values. Both
paths and open remote file handles can be passed to this method.
Returns undef on failure.
=item $sftp-E<gt>fstat($handle)
this method is deprecated.
=item $sftp-E<gt>lstat($path)
this method is similar to C<stat> method but stats a symbolic link
instead of the file the symbolic links points to.
=item $sftp-E<gt>setstat($path_or_fh, $attrs)
sets file attributes on the remote file. Accepts both paths and open
remote file handles.
Returns true on success and undef on failure.
=item $sftp-E<gt>fsetstat($handle, $attrs)
this method is deprecated.
=item $sftp-E<gt>truncate($path_or_fh, $size)
=item $sftp-E<gt>chown($path_or_fh, $uid, $gid)
=item $sftp-E<gt>chmod($path_or_fh, $perm)
=item $sftp-E<gt>utime($path_or_fh, $atime, $mtime)
local/lib/perl5/Net/SFTP/Foreign/Attributes.pm view on Meta::CPAN
Net::SFTP::Foreign::Attributes - File/directory attribute container
=head1 SYNOPSIS
use Net::SFTP::Foreign;
my $a1 = Net::SFTP::Foreign::Attributes->new();
$a1->set_size($size);
$a1->set_ugid($uid, $gid);
my $a2 = $sftp->stat($file)
or die "remote stat command failed: ".$sftp->status;
my $size = $a2->size;
my $mtime = $a2->mtime;
=head1 DESCRIPTION
I<Net::SFTP::Foreign::Attributes> encapsulates file/directory
attributes for I<Net::SFTP::Foreign>. It also provides serialization
and deserialization methods to encode/decode attributes into
local/lib/perl5/Net/SFTP/Foreign/Common.pm view on Meta::CPAN
my $follow = ($follow_links and _is_lnk($entry->{a}->perm));
if ($follow or $realpath) {
unless (defined $entry->{realpath}) {
my $rp = $entry->{realpath} = $self->realpath($fn);
next unless (defined $rp and not $rpdone{$rp}++);
}
}
if ($follow) {
my $a = $self->stat($fn);
if (defined $a) {
$entry->{a} = $a;
# we queue it for reprocessing as it could be a directory
unshift @queue, $entry;
}
next;
}
if (!$wanted or $wanted->($self, $entry)) {
if ($wantarray) {
local/lib/perl5/Net/SFTP/Foreign/Common.pm view on Meta::CPAN
$self->_call_on_error($on_error, $entry)
}
};
my $try;
while (@queue) {
no warnings 'uninitialized';
$try = shift @queue;
my $fn = $try->{filename};
my $a = $try->{a} ||= $self->lstat($fn)
or next;
next if (_is_dir($a->perm) and $done{$fn}++);
$task->($try);
if (_is_dir($a->perm)) {
if (!$descend or $descend->($self, $try)) {
if ($ordered or $atomic_readdir) {
my $ls = $self->ls( $fn,
local/lib/perl5/Net/SFTP/Foreign/Common.pm view on Meta::CPAN
my $pfn = $parent->{filename};
if ($has_wildcards) {
$sftp->ls( $pfn,
ordered => $ordered,
_wanted => sub {
my $e = $_[1];
if ($e->{filename} =~ $re) {
my $fn = $e->{filename} = $sftp->join($pfn, $e->{filename});
if ( (@parts or $follow_links)
and _is_lnk($e->{a}->perm) ) {
if (my $a = $sftp->stat($fn)) {
$e->{a} = $a;
}
else {
$on_error and $sftp->_call_on_error($on_error, $e);
return undef;
}
}
if (@parts) {
push @res, $e if _is_dir($e->{a}->perm)
}
local/lib/perl5/Net/SFTP/Foreign/Common.pm view on Meta::CPAN
}
}
}
return wantarray ? @res : $res;
}
sub test_d {
my ($sftp, $name) = @_;
{
local $sftp->{_autodie};
my $a = $sftp->stat($name);
return _is_dir($a->perm) if $a;
}
if ($sftp->{_status} == SSH2_FX_NO_SUCH_FILE) {
$sftp->_clear_error_and_status;
return undef;
}
$sftp->_ok_or_autodie;
}
sub test_e {
my ($sftp, $name) = @_;
{
local $sftp->{_autodie};
$sftp->stat($name) and return 1;
}
if ($sftp->{_status} == SSH2_FX_NO_SUCH_FILE) {
$sftp->_clear_error_and_status;
return undef;
}
$sftp->_ok_or_autodie;
}
1;
local/lib/perl5/Net/SFTP/Foreign/Compat.pm view on Meta::CPAN
if (my $a = $sftp->$method(@_)) {
return _rebless_attrs($a);
}
else {
$sftp->_warn_error;
return undef;
}
}
}
*do_lstat = _gen_do_stat('lstat');
*do_fstat = _gen_do_stat('fstat');
*do_stat = _gen_do_stat('stat');
1;
__END__
=head1 NAME
Net::SFTP::Foreign::Compat - Adapter for Net::SFTP compatibility
local/lib/perl5/Net/SFTP/Foreign/Local.pm view on Meta::CPAN
bless $self, $class;
}
sub realpath {
$! = 0;
File::Spec->rel2abs($_[1])
}
sub stat {
$! = 0;
my $a = Net::SFTP::Foreign::Attributes->new_from_stat(CORE::stat($_[1]));
unless ($a) {
$_[0]->_set_error(SFTP_ERR_LOCAL_STAT_FAILED, "Couldn't stat local file '$_[1]'", $!);
}
$a
}
sub lstat {
$! = 0;
my $a = Net::SFTP::Foreign::Attributes->new_from_stat(CORE::lstat($_[1]));
unless ($a) {
$_[0]->_set_error(SFTP_ERR_LOCAL_STAT_FAILED, "Couldn't stat local file '$_[1]'", $!);
}
$a
}
sub readlink {
$! = 0;
my $target = readlink $_[1];
unless (defined $target) {
local/lib/perl5/Net/SFTP/Foreign/Local.pm view on Meta::CPAN
%opts and croak "invalid option(s) '".CORE::join("', '", keys %opts)."'";
$! = 0;
opendir(my $ldh, $dir)
or return undef;
my @dir;
while (defined(my $part = readdir $ldh)) {
my $fn = File::Spec->join($dir, $part);
my $a = $self->lstat($fn);
if ($a and $follow_links and S_ISLNK($a->perm)) {
if (my $fa = $self->stat($fn)) {
$a = $fa;
}
else {
$! = 0;
}
}
my $entry = { filename => $part,
a => $a };
if ($atomic_readdir or !$wanted or $wanted->($self, $entry)) {
push @dir, $entry;
t/Actions.t view on Meta::CPAN
is_deeply App::SimpleBackuper::Info(\%options, \%state)->{subfiles},
[ { name => 'tmp', oldest_backup => 'test', newest_backup => 'test'} ];
is_deeply App::SimpleBackuper::Info({%options, path => '/'}, \%state)->{subfiles},
[ { name => 'tmp', oldest_backup => 'test', newest_backup => 'test'} ];
is_deeply App::SimpleBackuper::Info({%options, path => '/not-existent'}, \%state), {error => 'NOT_FOUND'};
my $result = App::SimpleBackuper::Info({%options, path => '/tmp/simple-backuper-test/src'}, \%state);
is_deeply $result->{subfiles}, [ { name => 'a.file', oldest_backup => 'test', newest_backup => 'test'} ];
my @lstat = lstat('/tmp/simple-backuper-test/src');
is $result->{versions}->[0]->{user}, scalar getpwuid($lstat[4]);
is $result->{versions}->[0]->{group}, scalar getgrgid($lstat[5]);
is_deeply $result->{versions}->[0]->{backups}, ['test'];
ok ! App::SimpleBackuper::Restore({
db => '/tmp/simple-backuper-test/db',
'backup-name' => 'test',
path => '/tmp/simple-backuper-test/src',
destination => '/tmp/simple-backuper-test/dst',
( run in 0.976 second using v1.01-cache-2.11-cpan-49f99fa48dc )