Add tilde filename expansion to rfits/wfits

We use the same tilde expansion that is used in PDL::AutoLoader, so there should be no (additional) portability issues. It would probably be better to put this into a new IO.pm module and then all the PDL::IO::* modules could use it.
PDLPorters · Sep 29, 2017 · ec19dba · ec19dba
1 parent ade05f6
commit ec19dba
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 3 deletions.
diff --git a/IO/FITS/FITS.pm b/IO/FITS/FITS.pm
@@ -117,6 +117,10 @@ Suffix magic:
   $pdl = rfits('file.fits.gz[3]'); # Read 3rd extension
   @pdls = rfits('file.fits');      # Read primary data and extensions
 
+Tilde expansion:
+  #guesses home directory (from getpwnam(getlogin||getpwuid($<)))
+  $pdl = rfits '~/filename.fits';
+
   $hdr = rfits('file.fits',{data=>0});  # Options hash changes behavior
 
 In list context, C<rfits> reads the primary image and all possible
@@ -342,7 +346,9 @@ sub PDL::rfits {
   # indicator which cancelled the check for empty primary data array at the end.
   my $explicit_extension = ($file =~ m/\[\d+\]$/ ? 1 : 0);
   $extnum = ( ($file =~ s/\[(\d+)\]$//) ? $1 : 0 );
-
+
+  $file =~ s/^~/((getpwnam(getlogin||getpwuid($<)))[7])/e; #tilde expansion
+
   $file = "gunzip -c $file |" if $file =~ /\.gz$/;    # Handle compression
   $file = "uncompress -c $file |" if $file =~ /\.Z$/;
 
@@ -1562,6 +1568,10 @@ Suffix magic:
   # Automatically compress through pipe to compress 
   wfits $pdl, 'filename.fits.Z';  
 
+Tilde expansion:
+  #guesses home directory (from getpwnam(getlogin||getpwuid($<)))
+  wfits $pdl, '~/filename.fits';
+
 =over 3
 
 =item * Ordinary (PDL) data handling: 
@@ -1865,6 +1875,8 @@ sub PDL::wfits {
 
   local $SIG{PIPE};
 
+  $file =~ s/^~/((getpwnam(getlogin||getpwuid($<)))[7])/e; #tilde expansion
+
   if ($file =~ /\.gz$/) {            # Handle suffix-style compression
     $SIG{PIPE}= sub {}; # Prevent crashing if gzip dies
     $file = "|gzip -9 > $file";

diff --git a/t/fits.t b/t/fits.t
@@ -12,7 +12,7 @@ use PDL::Config;
 
 kill 'INT',$$  if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
-use Test::More tests => 95;
+use Test::More tests => 97;
 
 BEGIN {
       use_ok( "PDL::IO::FITS" ); #1
@@ -316,6 +316,12 @@ SKIP:{
 	ok(all($b==$a),"The new image matches the old one (longlong)");
 	unlink $file;
 }
-
+
+###############################
+# Check that tilde expansion works
+eval { sequence(3,5,2)->wfits('~/tmp.fits'); };
+ok(!$@, "wfits tilde expansion didn't fail");
+eval { rfits('~/tmp.fits'); };
+ok(!$@, "rfits tilde expansion didn't fail");
 
 1;