Add tests for olefont size functions & conversions.
[wine] / 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  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;