git.oblomov.eu Git - wine/blob - tools/winapi/util.pm

   1 package util;
   2
   3 use strict;
   4
   5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
   6 require Exporter;
   7
   8 @ISA = qw(Exporter);
   9 @EXPORT = qw(append_file edit_file read_file replace_file);
  10 @EXPORT_OK = qw();
  11 %EXPORT_TAGS = ();
  12
  13 ########################################################################
  14 # append_file
  15
  16 sub append_file {
  17     my $filename = shift;
  18     my $function = shift;
  19
  20     open(OUT, ">> $filename") || die "Can't open file '$filename'";
  21     my $result = &$function(\*OUT, @_);
  22     close(OUT);
  23
  24     return $result;
  25 }
  26
  27 ########################################################################
  28 # edit_file
  29
  30 sub edit_file {
  31     my $filename = shift;
  32     my $function = shift;
  33
  34     open(IN, "< $filename") || die "Can't open file '$filename'";
  35     open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
  36
  37     my $result = &$function(\*IN, \*OUT, @_);
  38
  39     close(IN);
  40     close(OUT);
  41
  42     if($result) {
  43         unlink("$filename");
  44         rename("$filename.tmp", "$filename");
  45     } else {
  46         unlink("$filename.tmp");
  47     }
  48
  49     return $result;
  50 }
  51
  52 ########################################################################
  53 # read_file
  54
  55 sub read_file {
  56     my $filename = shift;
  57     my $function = shift;
  58
  59     open(IN, "< $filename") || die "Can't open file '$filename'";
  60     my $result = &$function(\*IN, @_);
  61     close(IN);
  62
  63     return $result;
  64 }
  65
  66 ########################################################################
  67 # replace_file
  68
  69 sub replace_file {
  70     my $filename = shift;
  71     my $function = shift;
  72
  73     open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
  74
  75     my $result = &$function(\*OUT, @_);
  76
  77     close(OUT);
  78
  79     if($result) {
  80         unlink("$filename");
  81         rename("$filename.tmp", "$filename");
  82     } else {
  83         unlink("$filename.tmp");
  84     }
  85
  86     return $result;
  87 }
  88
  89 1;