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 use warnings 'all';
  23
  24 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  25 require Exporter;
  26
  27 @ISA = qw(Exporter);
  28 @EXPORT = qw(
  29     append_file edit_file read_file replace_file
  30     normalize_set is_subset
  31 );
  32 @EXPORT_OK = qw();
  33 %EXPORT_TAGS = ();
  34
  35 ########################################################################
  36 # _compare_files
  37
  38 sub _compare_files($$) {
  39     my $file1 = shift;
  40     my $file2 = shift;
  41
  42     local $/ = undef;
  43
  44     return -1 if !open(IN, "< $file1");
  45     my $s1 = <IN>;
  46     close(IN);
  47
  48     return 1 if !open(IN, "< $file2");
  49     my $s2 = <IN>;
  50     close(IN);
  51
  52     return $s1 cmp $s2;
  53 }
  54
  55 ########################################################################
  56 # append_file
  57
  58 sub append_file($$@) {
  59     my $filename = shift;
  60     my $function = shift;
  61
  62     open(OUT, ">> $filename") || die "Can't open file '$filename'";
  63     my $result = &$function(\*OUT, @_);
  64     close(OUT);
  65
  66     return $result;
  67 }
  68
  69 ########################################################################
  70 # edit_file
  71
  72 sub edit_file($$@) {
  73     my $filename = shift;
  74     my $function = shift;
  75
  76     open(IN, "< $filename") || die "Can't open file '$filename'";
  77     open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
  78
  79     my $result = &$function(\*IN, \*OUT, @_);
  80
  81     close(IN);
  82     close(OUT);
  83
  84     if($result) {
  85         unlink("$filename");
  86         rename("$filename.tmp", "$filename");
  87     } else {
  88         unlink("$filename.tmp");
  89     }
  90
  91     return $result;
  92 }
  93
  94 ########################################################################
  95 # read_file
  96
  97 sub read_file($$@) {
  98     my $filename = shift;
  99     my $function = shift;
 100
 101     open(IN, "< $filename") || die "Can't open file '$filename'";
 102     my $result = &$function(\*IN, @_);
 103     close(IN);
 104
 105     return $result;
 106 }
 107
 108 ########################################################################
 109 # replace_file
 110
 111 sub replace_file($$@) {
 112     my $filename = shift;
 113     my $function = shift;
 114
 115     open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
 116
 117     my $result = &$function(\*OUT, @_);
 118
 119     close(OUT);
 120
 121     if($result && _compare_files($filename, "$filename.tmp")) {
 122         unlink("$filename");
 123         rename("$filename.tmp", $filename);
 124     } else {
 125         unlink("$filename.tmp");
 126     }
 127
 128     return $result;
 129 }
 130
 131 ########################################################################
 132 # normalize_set
 133
 134 sub normalize_set($) {
 135     local $_ = shift;
 136
 137     if(!defined($_)) {
 138         return undef;
 139     }
 140
 141     my %hash = ();
 142     foreach my $key (split(/\s*&\s*/)) {
 143         $hash{$key}++;
 144     }
 145
 146     return join(" & ", sort(keys(%hash)));
 147 }
 148
 149 ########################################################################
 150 # is_subset
 151
 152 sub is_subset($$) {
 153     my $subset = shift;
 154     my $set = shift;
 155
 156     foreach my $subitem (split(/ & /, $subset)) {
 157         my $match = 0;
 158         foreach my $item (split(/ & /, $set)) {
 159             if($subitem eq $item) {
 160                 $match = 1;
 161                 last;
 162             }
 163         }
 164         if(!$match) {
 165             return 0;
 166         }
 167     }
 168     return 1;
 169 }
 170
 171 1;