"Fossies" - the Fresh Open Source Software Archive

Member "fsbackup-1.2pl2/contrib/dir_sync/restore_dir.pl" (19 Oct 2007, 1340 Bytes) of package /linux/privat/old/fsbackup-1.2pl2.tar.gz:

As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. 
    1 #!/usr/bin/perl
    2 # Скрипт создающий недастоющие директории и симлинки в пункте назначения по общему списку.
    3 # Список директорий подается во входной поток.
    4 # (c) Maxim Chirkov <mc@tyumen.ru>
    5 #
    6 # Формат использования: cat list.txt |./restore_dir.pl /корень_для_восстановления
    7 
    8 use strict;
    9 
   10 my %uid_hash=();
   11 my %gid_hash=();
   12 
   13 if (! defined $ARGV[0] || ! -d $ARGV[0]){
   14     die "Usage: restore_dir.pl <dir>";
   15 }
   16 my $root_path = $ARGV[0];
   17 
   18 while (<STDIN>){
   19     chomp;
   20     my ($s_type, $s_path, $s_mode, $s_uid, $s_gid, $s_mtime, $s_time, $s_link_dest) = split(/\t/);
   21     my $stat_mode = sprintf ("%04o", $s_mode & 07777);
   22     
   23     if ($s_path !~ /^\Q$root_path\E/){
   24     print "ERROR: Outside dir: $s_path\n";
   25     next;
   26     }
   27     if (-e $s_path){next;}
   28     
   29     if (! defined $uid_hash{$s_uid}){
   30         $uid_hash{$s_uid} = getpwnam($s_uid) || $s_uid;
   31     }
   32     if (! defined $gid_hash{$s_gid}){
   33         $gid_hash{$s_gid} = getgrnam($s_gid) || $s_gid;
   34     }
   35 
   36     if ($s_type eq "dir"){
   37 
   38     mkdir($s_path, 0777);
   39     chmod(oct($stat_mode), $s_path);
   40     chown ($uid_hash{$s_uid}, $gid_hash{$s_gid}, $s_path);
   41     utime ($s_mtime, $s_mtime, $s_path);
   42     print "Restoring dir: $s_path\n";
   43 
   44     } elsif ($s_type eq "symlink"){
   45 
   46     symlink($s_link_dest, $s_path);
   47     print "Restoring symlink: $s_path\n";
   48 
   49     } elsif ($s_type ne ""){
   50     print "ERROR: Bogus line: $_\n";
   51     }
   52 }