tools/winapi/util.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   4 # This library is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU Lesser General Public
   6 # License as published by the Free Software Foundation; either
   7 # version 2.1 of the License, or (at your option) any later version.
   8 #
   9 # This library is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # Lesser General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU Lesser General Public
  15 # License along with this library; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  17 #
  18
  19 package util;
  20
  21 use strict;
  22
  23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  24 require Exporter;
  25
  26 @ISA = qw(Exporter);
  27 @EXPORT = qw(
  28     append_file edit_file read_file replace_file
  29     normalize_set is_subset
  30 );
  31 @EXPORT_OK = qw();
  32 %EXPORT_TAGS = ();
  33
  34 ########################################################################
  35 # _compare_files
  36
  37 sub _compare_files($$) {
  38     my $file1 = shift;
  39     my $file2 = shift;
  40
  41     local $/ = undef;
  42
  43     return -1 if !open(IN, "< $file1");
  44     my $s1 = <IN>;
  45     close(IN);
  46
  47     return 1 if !open(IN, "< $file2");
  48     my $s2 = <IN>;
  49     close(IN);
  50
  51     return $s1 cmp $s2;
  52 }
  53
  54 ########################################################################
  55 # append_file
  56
  57 sub append_file($$@) {
  58     my $filename = shift;
  59     my $function = shift;
  60
  61     open(OUT, ">> $filename") || die "Can't open file '$filename'";
  62     my $result = &$function(\*OUT, @_);
  63     close(OUT);
  64
  65     return $result;
  66 }
  67
  68 ########################################################################
  69 # edit_file
  70
  71 sub edit_file($$@) {
  72     my $filename = shift;
  73     my $function = shift;
  74
  75     open(IN, "< $filename") || die "Can't open file '$filename'";
  76     open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
  77
  78     my $result = &$function(\*IN, \*OUT, @_);
  79
  80     close(IN);
  81     close(OUT);
  82
  83     if($result) {
  84         unlink("$filename");
  85         rename("$filename.tmp", "$filename");
  86     } else {
  87         unlink("$filename.tmp");
  88     }
  89
  90     return $result;
  91 }
  92
  93 ########################################################################
  94 # read_file
  95
  96 sub read_file($$@) {
  97     my $filename = shift;
  98     my $function = shift;
  99
 100     open(IN, "< $filename") || die "Can't open file '$filename'";
 101     my $result = &$function(\*IN, @_);
 102     close(IN);
 103
 104     return $result;
 105 }
 106
 107 ########################################################################
 108 # replace_file
 109
 110 sub replace_file($$@) {
 111     my $filename = shift;
 112     my $function = shift;
 113
 114     open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
 115
 116     my $result = &$function(\*OUT, @_);
 117
 118     close(OUT);
 119
 120     if($result && _compare_files($filename, "$filename.tmp")) {
 121         unlink("$filename");
 122         rename("$filename.tmp", $filename);
 123     } else {
 124         unlink("$filename.tmp");
 125     }
 126
 127     return $result;
 128 }
 129
 130 ########################################################################
 131 # normalize_set
 132
 133 sub normalize_set($) {
 134     local $_ = shift;
 135
 136     if(!defined($_)) {
 137         return undef;
 138     }
 139
 140     my %hash = ();
 141     foreach my $key (split(/\s*&\s*/)) {
 142         $hash{$key}++;
 143     }
 144
 145     return join(" & ", sort(keys(%hash)));
 146 }
 147
 148 ########################################################################
 149 # is_subset
 150
 151 sub is_subset($$) {
 152     my $subset = shift;
 153     my $set = shift;
 154
 155     foreach my $subitem (split(/ & /, $subset)) {
 156         my $match = 0;
 157         foreach my $item (split(/ & /, $set)) {
 158             if($subitem eq $item) {
 159                 $match = 1;
 160                 last;
 161             }
 162         }
 163         if(!$match) {
 164             return 0;
 165         }
 166     }
 167     return 1;
 168 }
 169
 170 1;