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;
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.