Suggestion for unpack tag

atark at thepipeline.net atark at thepipeline.net
Tue Jan 9 22:33:20 PST 2001


It's late and I need to get to bed but here is a quick shot at it.

$archive=bash-2.04
# obviously if you just enter bash-2.04 it will fail but we
# should find say bash-2.04.tar.bz2 if it exists
If $archive does not exist { 
	$base_archive = if they exist strip off trailing 
		archive/compression extension
	$archive = look for file in sources directory that 
		matches $base_archive except for extensions. || error	
}

The elseif statement could also hold cases for .tgz, .tbz, etc.

On another note something I just noticed for the /\.gz$/ case use zcat
and redirect the output instead of copy/gunzip/delete.  Hope you don't
mind the suggestion.

--Andy



Bryan Dumm wrote:
> 
> let me guess it was bzip2 that failed right?
> :)
> 
> > There could be other solutions, I'm all ears.  I'm also willing to code
> > this mod and submit/commit the changes.
> 
> More than happy to accept submissions..... :)
> 
> btw here is the current sub... what can we do differently???
> 
> sub tag_unpack
> {
>         my $elt = shift;
>         my $archive = $elt->att('archive');
>         my $destination = fix_text($elt->text);
> 
>         print "Unpacking   : $archive\n";
>         print "Destination : $destination\n";
> 
>         return if (! &to_continue);
> 
>         if (! chdir $destination) {
>                 return
>                 if error("Unable to change directory to $destination: $!\n", $elt);
>         }
> 
>         if (! -f $archive) {
>                 return if error("Archive $archive does not exist.\n", $elt);
>         }
> 
>         if ($archive =~ /\.tar\.gz$/) {
>                 system_return(system "tar xzf $archive");
> 
>         } elsif ($archive =~ /\.tar\.bz2$/) {
> 
>                 system_return(system "bzcat $archive | tar x");
> 
>         } elsif ($archive =~ /\.gz$/) {
>                 if (! copy ($archive, $destination)) {
>                         return
>                         if error("Unable to copy $archive to $destination.\n");
>                 }
> 
>                 my $basename = $archive;
>                 $basename =~ s/.*\///;
> 
>                 system_return(system "gunzip $destination/$basename");
> 
>                 unlink "$destination/$basename"
>                 || print "Unable to delete $destination/$basename: $!\n";
> 
>         } else {
>                 print "Not supported file type ($archive).\n";
>         }
> 
>         print "Done unpacking $archive.\n";
> }

-- 
<atark at thepipeline.net>
<andy at tarkinson dot com>





More information about the alfs-discuss mailing list