Erst mal zum Laufen gebracht

diff --git a/locale/de/LC_MESSAGES/sicher.mo b/locale/de/LC_MESSAGES/sicher.mo
index b505aae8913a9e4f3c06b48aae3501038a885ae9..c5285dd739c1a251e56b633e04b8fb71f3093e21 100644 (file)
Binary files a/locale/de/LC_MESSAGES/sicher.mo and b/locale/de/LC_MESSAGES/sicher.mo differ

diff --git a/po/sicher.de.po b/po/sicher.de.po
index 92d4d84bbfebbef4c396e00684d0783b3f7762b6..2b5fdc872b1c2360c0086980217750c7085f4eaf 100644 (file)
--- a/po/sicher.de.po
+++ b/po/sicher.de.po
@@ -48,4 +48,53 @@ msgstr "deutsch"
 msgid "english"
 msgstr "englisch"
 
+msgid "Locale object: "
+msgstr "Locale-Objekt: "
+
+#, perl-format
+msgid "Locale directory: '%s'"
+msgstr "Locale-Verzeichnis: '%s'"
+
+msgid "No files given, using '.' instead."
+msgstr "Keine Dateien gegeben, verwende statt dessen '.'."
+
+#, perl-format
+msgid "File '%s' doesn't exists."
+msgstr "Die Datei '%s' existiert nicht."
+
+#, perl-format
+msgid "Backup of directory '%s' ..."
+msgstr "Sichere Verzeichnis '%s' ..."
+
+#, perl-format
+msgid "Using Old-Dir '%s'."
+msgstr "Verwende Sicherungsverzeichnis '%s'."
+
+#, perl-format
+msgid "Backup of file '%s' ..."
+msgstr "Sichere Datei '%s' ..."
+
+#, perl-format
+msgid "Creating directory '%s' ...\n"
+msgstr "Erstelle Verzeichnis '%s' ...\n"
+
+#, perl-format
+msgid "Could not create directory '%s': "
+msgstr "Konnte Verzeichnis '%s' nicht erstellen: "
+
+#, perl-format
+msgid "Changing ownership of '%s' to '%s:%s' ...\n"
+msgstr "Setze Eigentümerschaft von '%s' auf '%s:%s' ...\n"
+
+#, perl-format
+msgid "Could not change owner of '%s' to '%s:%s': "
+msgstr "Konnte Eigentümerschaft von '%s' nicht auf '%s:%s' setzen: "
+
+#, perl-format
+msgid "Changing timestamp of '%s' ..."
+msgstr "Setze Zeitstempel von '%s' ..."
+
+#, perl-format
+msgid "Could not change timestamps of '%s': "
+msgstr "Konnte Zeitstempel von '%s' nicht setzen: "
 

diff --git a/sicher.pl b/sicher.pl
index 6268fef4dae70dcb0587245b5b856db3cb4b7376..2e9d630841b90faed4ba7fe088bc39fd47a50648 100755 (executable)
--- a/sicher.pl
+++ b/sicher.pl
@@ -91,6 +91,7 @@ Wenn nicht angegeben, wird C<.old> verwendet.
 use strict;
 use 5.8.0;
 use warnings;
+use locale;
 
 use Data::Dumper;
 use Getopt::Long;
@@ -98,10 +99,13 @@ use Pod::Usage;
 # use Time::HiRes qw( gettimeofday tv_interval );
 use File::Basename;
 use File::Spec::Functions;
+use File::stat;
+use File::Copy;
 use Locale::gettext;
 use POSIX qw(setlocale LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES LC_MONETARY LC_NUMERIC LC_TIME);
 
 $| = 1;
+#$ENV{'TZ'} = 'MET';
 
 Getopt::Long::Configure('bundling');
 $Data::Dumper::Indent   = 1;
@@ -161,9 +165,27 @@ $l->codeset('utf-8');
 
 my $locale_dir = catdir( dirname($0), "locale" );
 $l->dir($locale_dir);
-_debug( 5, "Locale-Objekt: ", $l );
-_debug( 2, "Locale-Verzeichnis: ", $locale_dir );
+_debug( 5, $l->get("Locale object: "), $l );
+_debug( 2, sprintf( $l->get("Locale directory: '%s'"), $locale_dir ) );
+
+#-----------------
+# Ermittlung der zu sichernden Dateien und Verzeichnisse aus der Kommandozeile ...
+my @FilesGiven = @ARGV;
+if ( scalar(@FilesGiven) < 1 ) {
+    _debug( 1, $l->get("No files given, using '.' instead.") );
+    @FilesGiven = ( '.' );
+}
 
+my $res = 0;
+for my $f ( @FilesGiven ) {
+    unless ( -f $f or -d $f ) {
+        _error( undef, sprintf( $l->get("File '%s' doesn't exists."), $f ) );
+        $res = 1;
+    }
+}
+exit 1 if $res;
+
+die unless perform_nodes( \@FilesGiven );
 
 exit 0;
 
@@ -176,6 +198,159 @@ die halt mal so begraucht werden...
 
 #---------------------------------------------------------------------------
 
+=head2 perform_nodes( \@NodeList )
+
+Verarbeitet rekursiv die uebergebene Datei- und Verzeichnisliste.
+
+=cut
+
+sub perform_nodes {
+
+    my $node_list = shift;
+
+    my $dir_list  = [];
+    my $file_list = [];
+
+    for ( sort @$node_list ) {
+        next if ( -l $_ );
+        if ( -f $_ ) {
+            push @$file_list, $_;
+        } elsif ( -d $_ ) {
+            push @$dir_list, $_;
+        }
+    }
+
+    return 0 unless perform_dirs($dir_list);
+    return 0 unless perform_files($file_list);
+
+    return 1;
+
+}
+
+#---------------------------------------------------------------------------
+
+=head2 perform_dirs( \@DirList )
+
+=cut
+
+sub perform_dirs {
+
+    my $dir_list = shift;
+
+    my ( $sublist, $newlist, $basename );
+
+    for my $d ( @$dir_list ) {
+        _debug( 1, sprintf( $l->get("Backup of directory '%s' ..."), $d ) );
+        @$sublist = ( glob( catfile( $d, ".*" ) ), glob( catfile( $d, "*" ) ) );
+        $newlist = [];
+        for ( @$sublist ) {
+            $basename = basename($_);
+            push @$newlist, $_ unless $basename eq '.' or $basename eq '..' or $basename eq $olddir;
+        }
+        $sublist = undef;
+        return 0 unless perform_nodes($newlist);
+    }
+
+    return 1,
+
+}
+
+#---------------------------------------------------------------------------
+
+=head2 perform_files( \@FileList )
+
+=cut
+
+sub perform_files {
+
+    my $file_list = shift;
+
+    for my $f ( @$file_list ) {
+        _debug( 1, sprintf( $l->get("Backup of file '%s' ..."), $f ) );
+        return 0 unless backup_file($f);
+    }
+
+    return 1,
+
+}
+
+#---------------------------------------------------------------------------
+
+=head2 backup_file( $file )
+
+=cut
+
+sub backup_file {
+
+    my $file = shift;
+
+    my $fstat   = stat($file) or return 0;
+    my $mtime   = [localtime($fstat->mtime)];
+    my $datepat = sprintf( ".%4d-%02d-%02d_%02d-%02d-%02d", $mtime->[5] + 1900, $mtime->[4] + 1, $mtime->[3], $mtime->[2], $mtime->[1], $mtime->[0] );
+
+    my $pdir = dirname($file);
+    my $odir = catdir( $pdir, $olddir );
+    _debug( 1, sprintf( $l->get("Using Old-Dir '%s'."), $odir ) );
+    return undef unless create_dir($odir);
+    my $bakfile = catfile( $odir, basename($file) . $datepat );
+    print " - " . $file . " -> " . $bakfile . "\n";
+
+    unless ( copy( $file, $bakfile ) ) {
+        _error( 'error', sprintf( $l->get("Could not backup '%s' to '%s': "), $file, $bakfile ) . $! );
+        return 0;
+    }
+
+    _debug( 2, sprintf( $l->get("Changing timestamp of '%s' ..."), $bakfile ) );
+    unless ( utime $fstat->atime, $fstat->mtime, $bakfile ) {
+        _error( undef, sprintf( $l->get("Could not change timestamps of '%s': "), $bakfile ) . $! );
+    }
+
+    # wenn root, dann Besitzerschaft der gesicherten Datei uebernehmen
+    unless ( $> ) {
+        _debug( 2, sprintf( $l->get("Changing ownership of '%s' to '%s:%s' ...\n"), $bakfile, $fstat->uid, $fstat->gid ) );
+        unless ( chown $fstat->uid, $fstat->gid, $bakfile ) {
+            _error( undef, sprintf( $l->get("Could not change owner of '%s' to '%s:%s': "), $bakfile, $fstat->uid, $fstat->gid ) . $! );
+        }
+    }
+
+    return 1;
+
+}
+
+#---------------------------------------------------------------------------
+
+=head2 create_dir( $dir )
+
+=cut
+
+sub create_dir {
+
+    my $dir = shift;
+
+    return 1 if -d $dir;
+
+    printf $l->get("Creating directory '%s' ...\n"), $dir;
+    unless ( mkdir $dir, 0755 ) {
+        _error( 'error', sprintf( $l->get("Could not create directory '%s': "), $dir ) . $! );
+        return 0;
+    }
+
+    # wenn root, dann Besitzerschaft des uebergeordneten Verzeichnisses uebernehmen
+    unless ( $> ) {
+        my $pdir = dirname($dir);
+        my $st   = stat($pdir);
+        printf $l->get("Changing ownership of '%s' to '%s:%s' ...\n"), $dir, $st->uid, $st->gid;
+        unless ( chown $st->uid, $st->gid, $dir ) {
+            _error( undef, sprintf( $l->get("Could not change owner of '%s' to '%s:%s': "), $dir, $st->uid, $st->gid ) . $! );
+        }
+    }
+
+    return 1;
+
+}
+
+#---------------------------------------------------------------------------
+
 =head2 _debug( $debug_level, @messages )
 
 Logroutine fuer Debug-Logging ...