X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=ac2b63e42a282212f79a8627e04468dca957f115;hb=fe78618f23392a6ae58542b78cc4c8dbc84e71c5;hp=86dc91998fb6408bd6f2e4e3b293019a86ef51ec;hpb=82de56e409a19a05761794c9588713160b51144e;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 86dc9199..ac2b63e4 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -9,12 +9,15 @@ package DXUtil; use Date::Parse; +use IO::File; +use Data::Dumper; + use Carp; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf - parray parraypairs shellregex + parray parraypairs shellregex readfilestr writefilestr print_all_fields cltounix iscallsign ); @@ -193,3 +196,85 @@ sub iscallsign return 1 if $call =~ /^\d+\w+/; return undef; } + +# read in a file into a string and return it. +# the filename can be split into a dir and file and the +# file can be in upper or lower case. +# there can also be a suffix +sub readfilestr +{ + my ($dir, $file, $suffix) = @_; + my $fn; + my $f; + if ($suffix) { + $f = uc $file; + $fn = "$dir/$f.$suffix"; + unless (-e $fn) { + $f = lc $file; + $fn = "$dir/$file.$suffix"; + } + } elsif ($file) { + $f = uc $file; + $fn = "$dir/$file"; + unless (-e $fn) { + $f = lc $file; + $fn = "$dir/$file"; + } + } else { + $fn = $dir; + } + + my $fh = new IO::File $fn; + my $s = undef; + if ($fh) { + local $/ = undef; + $s = <$fh>; + $fh->close; + } + return $s; +} + +# write out a file in the format required for reading +# in via readfilestr, it expects the same arguments +# and a reference to an object +sub writefilestr +{ + my $dir = shift; + my $file = shift; + my $suffix = shift; + my $obj = shift; + my $fn; + my $f; + + confess('no object to write in writefilestr') unless $obj; + confess('object not a reference in writefilestr') unless ref $obj; + + if ($suffix) { + $f = uc $file; + $fn = "$dir/$f.$suffix"; + unless (-e $fn) { + $f = lc $file; + $fn = "$dir/$file.$suffix"; + } + } elsif ($file) { + $f = uc $file; + $fn = "$dir/$file"; + unless (-e $fn) { + $f = lc $file; + $fn = "$dir/$file"; + } + } else { + $fn = $dir; + } + + my $fh = new IO::File ">$fn"; + if ($fh) { + my $dd = new Data::Dumper([ $obj ]); + $dd->Indent(1); + $dd->Terse(1); + $dd->Quotekeys(0); + # $fh->print(@_) if @_ > 0; # any header comments, lines etc + $fh->print($dd->Dumpxs); + $fh->close; + } +}