133 lines
2.5 KiB
Perl
133 lines
2.5 KiB
Perl
package util;
|
|
|
|
use strict;
|
|
|
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
|
|
require Exporter;
|
|
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw(
|
|
&append_file &edit_file &read_file &replace_file
|
|
&normalize_set &is_subset
|
|
);
|
|
@EXPORT_OK = qw();
|
|
%EXPORT_TAGS = ();
|
|
|
|
########################################################################
|
|
# append_file
|
|
|
|
sub append_file {
|
|
my $filename = shift;
|
|
my $function = shift;
|
|
|
|
open(OUT, ">> $filename") || die "Can't open file '$filename'";
|
|
my $result = &$function(\*OUT, @_);
|
|
close(OUT);
|
|
|
|
return $result;
|
|
}
|
|
|
|
########################################################################
|
|
# edit_file
|
|
|
|
sub edit_file {
|
|
my $filename = shift;
|
|
my $function = shift;
|
|
|
|
open(IN, "< $filename") || die "Can't open file '$filename'";
|
|
open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
|
|
|
|
my $result = &$function(\*IN, \*OUT, @_);
|
|
|
|
close(IN);
|
|
close(OUT);
|
|
|
|
if($result) {
|
|
unlink("$filename");
|
|
rename("$filename.tmp", "$filename");
|
|
} else {
|
|
unlink("$filename.tmp");
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
########################################################################
|
|
# read_file
|
|
|
|
sub read_file {
|
|
my $filename = shift;
|
|
my $function = shift;
|
|
|
|
open(IN, "< $filename") || die "Can't open file '$filename'";
|
|
my $result = &$function(\*IN, @_);
|
|
close(IN);
|
|
|
|
return $result;
|
|
}
|
|
|
|
########################################################################
|
|
# replace_file
|
|
|
|
sub replace_file {
|
|
my $filename = shift;
|
|
my $function = shift;
|
|
|
|
open(OUT, "> $filename.tmp") || die "Can't open file '$filename.tmp'";
|
|
|
|
my $result = &$function(\*OUT, @_);
|
|
|
|
close(OUT);
|
|
|
|
if($result) {
|
|
unlink("$filename");
|
|
rename("$filename.tmp", "$filename");
|
|
} else {
|
|
unlink("$filename.tmp");
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
########################################################################
|
|
# normalize_set
|
|
|
|
sub normalize_set {
|
|
local $_ = shift;
|
|
|
|
if(!defined($_)) {
|
|
return undef;
|
|
}
|
|
|
|
my %hash = ();
|
|
foreach my $key (split(/\s*&\s*/)) {
|
|
$hash{$key}++;
|
|
}
|
|
|
|
return join(" & ", sort(keys(%hash)));
|
|
}
|
|
|
|
########################################################################
|
|
# is_subset
|
|
|
|
sub is_subset {
|
|
my $subset = shift;
|
|
my $set = shift;
|
|
|
|
foreach my $subitem (split(/ & /, $subset)) {
|
|
my $match = 0;
|
|
foreach my $item (split(/ & /, $set)) {
|
|
if($subitem eq $item) {
|
|
$match = 1;
|
|
last;
|
|
}
|
|
}
|
|
if(!$match) {
|
|
return 0;
|
|
}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
1;
|