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;