http://qs1969.pair.com?node_id=80044

This code reads a db file with files/dir, tars it and puts it on a remote SMB host.
#!/usr/bin/perl use strict; use Archive::Tar; use File::Find; use Filesys::SmbClientParser; #Samba here I come my $samba_user = ""; my $samba_password = ""; my $samba_remote_host = ""; my $samba_share = ""; my $samba_current_host = ""; #Samba Remote share subdir #Empty means root share #Could be combined with $ENV{HOSTNAME} my $smb = new Filesys::SmbClientParser; $smb->Debug(0); #Dont dump SmbClient output on tty $smb->User($samba_user); $smb->Password($samba_password); $smb->Host($samba_remote_host); $smb->Share($samba_share); $smb->cd($samba_current_host); my $errorstring = <<EOS; Oops, Please define a backup method ! --daily : daily backup (incremental & rotating) -d : daily backup (incremental & rotating) --weekly : weekly backup (full & rotating) -w : weekly backup (full & rotating) --monthly : monthly backup (full & non rotating) -m : monthly backup (full & non rotating) EOS my $mode = undef; if (!@ARGV) { die $errorstring; } if ($ARGV[0] =~ /^\-*d/) { $mode = "d"; } if ($ARGV[0] =~ /^\-*w/) { $mode = "w"; } if ($ARGV[0] =~ /^\-*m/) { $mode = "m"; } if (!$mode) { die $errorstring; } #Shoot me because I didn't use Getopt my %patterns = ('*'=>'.*','?'=>'.'); my %methods = ('d'=>'daily','w'=>'weekly','m'=>'monthly'); my $tar = Archive::Tar->new(); open(LIST,"<backuplist.db") || die $!; #file with directories to backup while(my $line = <LIST>) { my @files = (); chomp $line; if (!$line) { next; } my $pattern = undef; my $path = undef; my $file = undef; my $option = undef; ($line,$option) = split(/ /,$line); if ($line !~ /[?*]/) { if (-l $line || -S $line || -p $line || -c $line || -b $line || -t + $line) { next; } #No symlinks, sockets, pipes, character files, block files or ttys if (-d $line) { $pattern = "*"; $path = $line; } } else { ($path,$pattern) = $line =~ /([^?*]*)\/(.*)/; } if (!-e $path) { next; } if ($pattern && $option =~ /r/i) { $pattern =~ s{(.)}{$patterns{$1} || "\Q$1" }ge; find(sub { if (/$pattern$/) { push(@files,$File::Find::dir."/".$_) +; } }, $path); } if ($pattern && $option !~ /r/i) { if ($path !~ /\/$/) { $path .= "/"; } @files = glob($path.$pattern); @files = grep { !-l $_ && !-S $_ && !-p $_ && !-c $_ && !-b $_ && + !-t $_ && !-d $_ } @files; } print "Adding $path to $methods{$mode} backup\n"; if ($mode eq "d") { @files = grep { $_ if -M $_ <= 1 } @files; } $tar->add_files(@files); } close(LIST); my $day = ("maandag","dinsdag","woensdag","donderdag","vrijdag","zater +dag","zondag")[(localtime)[6]-1]; my $week = "week-".int ((localtime)[3] / 7); my $month = ("januari","februari","maart","april","mei","juni","juli", +"augustus","september","oktober","november","december")[(localtime)[4 +]]."-".((localtime)[5]+1900); my $filename = $mode eq "d" ? $day : ($mode eq "w" ? $week : $month); if (-e $filename.".tar.gz") { unlink $filename.".tar.gz"; } $tar->write("$filename.tar.gz"); if ($tar->error) { die $tar->error; } my $counter = 0; my $error = undef; while ($counter != 2) { $error = $smb->put($filename.".tar.gz",$filename.".tar.gz"); if ($error != 2) { $counter++; } else { last; } } if ($counter == 2) { die $error; } else { unlink $filename.".tar.gz"; +}

Param style is constructed for cron usage...
$day and $month strings are in dutch :|
Sample format of backuplist.db:
/home/beatnik/code -R
/home/apache -R
/downloads/*.tar.gz

Greetz
Beatnik
... Quidquid perl dictum sit, altum viditur.