X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXUtil.pm;h=d7ca5ed218e2b6e8e1671091e9c2cb043a3bf4c8;hb=9e2fbafcfdab1ee45e581524311f1a97ac41f6ad;hp=7fae63170d015345b5372ab41c234d7d14a538fc;hpb=6ab5f0300e614249c24916600817ae221a6bdc8c;p=spider.git diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 7fae6317..d7ca5ed2 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -10,13 +10,14 @@ 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 readfilestr + parray parraypairs shellregex readfilestr writefilestr print_all_fields cltounix iscallsign ); @@ -204,22 +205,25 @@ sub readfilestr { my ($dir, $file, $suffix) = @_; my $fn; - + my $f; if ($suffix) { - $fn = "$dir/$file.$suffix"; + $f = uc $file; + $fn = "$dir/$f.$suffix"; unless (-e $fn) { - my $f = uc $file; + $f = lc $file; $fn = "$dir/$file.$suffix"; } } elsif ($file) { + $f = uc $file; $fn = "$dir/$file"; unless (-e $fn) { - my $f = uc $file; + $f = lc $file; $fn = "$dir/$file"; } } else { $fn = $dir; } + my $fh = new IO::File $fn; my $s = undef; if ($fh) { @@ -229,3 +233,46 @@ sub readfilestr } 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"; + 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; +}