Changeset 20 for trunk

Timestamp:

09/27/05 18:24:00 (19 years ago)

Author:

thauvin

Message:

• set internal error

Location:

trunk/soft/ObsData/ObsData/Archive

Files:

• Compressed.pm (modified) (3 diffs, 1 prop)
• Tar.pm (modified) (4 diffs, 1 prop)

trunk/soft/ObsData/ObsData/Archive/Compressed.pm

@@ -42 +42 @@
     if ($dest) {
         $fname = $dest;
-        open($fh, '>', $dest) or return undef;
+        open($fh, '>', $dest) or do {
+            seterror("Can't uncompress archive: $!");
+            return undef;
+        };
     } else {
         ($fh, $fname) = tempfile(
             DIR => $self->_tempdir,
             UNLINK => 1,
-        ) or return undef;
+        ) or do {
+            seterror("Can't create temp file: $!");
+            return undef;
+        };
     }
 
@@ -53 +59 @@
     
     if(!copy($sourcefh, $fh)) {
+        seterror("Can't copy file to destination: $!");
         unlink($fname);
         return undef;
@@ -62 +69 @@
 }
 
+1;

trunk/soft/ObsData/ObsData/Archive/Tar.pm

@@ -30 +30 @@
 sub ls {
     my ($self) = @_;
-    open(my $htar, '-|', "$self->{uncomp} '$self->{archive}' | tar tf -") or
+    open(my $htar, '-|', "$self->{uncomp} '$self->{archive}' | tar tf -") or do {
+        seterror("Can't read tar file: $!");
         return undef;
+    };
     my @list;
     while(<$htar>) {
@@ -49 +51 @@
     my $abs_dest = Cwd::abs_path($dest);
     
-    chdir($tempdir);
+    if(!chdir($tempdir)) {
+        seterror("Can't chdir: $!");
+        return undef;
+    }
 
     system("$self->{uncomp} '$abs_path' | tar xf - '$file'") and do {
+        seterror("Can't extract file from tar: $!");
         chdir($here);
         return undef;
@@ -59 +65 @@
         open(my $fh, '>', $abs_dest) or return undef;
         if(!copy("$tempdir/$file", $fh)) {
+            seterror("Can't copy file to destination: $!");
             unlink($abs_dest);
             chdir($here);
@@ -73 +80 @@
 }
 
+1;