code/UI_Tag/backup_file.coretag

   1 # Copyright 2002-2007 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: backup_file.coretag,v 1.5 2007-03-30 23:40:54 pajamian Exp $
   9
  10 UserTag backup-file Order     file
  11 UserTag backup-file AddAttr
  12 UserTag backup-file Version   $Revision: 1.5 $
  13 UserTag backup-file Routine   <<EOR
  14 require File::Copy;
  15 require File::Path;
  16 require File::Basename;
  17 sub {
  18         my ($file, $opt) = @_;
  19         my $bu_file = "backup/$file";
  20         $bu_file =~ s://+:/:g ;
  21         $bu_file =~ m:(.*)/: ;
  22         my $bu_dir = $1;
  23         eval {
  24                 die ::errmsg("Cannot figure out backup directory from %s", $bu_file)
  25                         if ! $bu_dir;
  26                 if (! -d $bu_dir) {
  27                         File::Path::mkpath($bu_dir)
  28                                 or die ::errmsg("Cannot make backup directory %s: %s", $bu_dir, $!);
  29                 }
  30                 if (-f $bu_file) {
  31                         my $fn = $bu_file;
  32                         $fn =~ s:.*/::;
  33                         UI::Primitive::rotate($fn, { Directory => $bu_dir } )
  34                                 or die ::errmsg("Cannot make backup of %s: %s", $bu_file, $!);
  35                 }
  36 #::logDebug("ready to copy $file to $bu_file");
  37                 File::Copy::copy($file, $bu_file)
  38                         or die ::errmsg("Copy %s to %s: %s", $file, $bu_file, $!);
  39         };
  40         if ($@) {
  41                 $::Scratch->{ui_error} = $@;
  42                 ::logError($::Scratch->{ui_error});
  43                 return undef;
  44         }
  45         return 1;
  46 }
  47 EOR