Oh well... it is just beginning to do about what it is expected to do... frankly not sure. As it is, will decompress top directories in your directory. I wanted to publish something today... even if yet not finished... pretty much what I am doing.
#!/usr/bin/env perl =pod =item License Copyright (C) 2022 by Paul Dufresne <[email protected]> Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE =cut use strict; use warnings; use Getopt::Long; use File::Basename; use Archive::Zip qw ( :ERROR_CODES :MISC_CONSTANTS ); use Scalar::Util 'blessed'; sub getTopDirs; sub copyDir; sub copyFiles; sub makePath8_3; sub make8_3; my $zip_in = "/home/paul/Téléchargements/dj_gpp-unstable.zip"; my $zip = Archive::Zip->new($zip_in); my @members = $zip->memberNames(); my $firstname = $members[0]; my @topDirs; my $outzip = Archive::Zip->new(); # no parameter, indicate output # $outzip->fileAttributeFormat=Archive::Zip::Member::FA_MSDOS; #$outzip->fileparse_set_fstype("DOS"); # was expecting it would handle 8_3 paths # but it is unclear it does anything... maybe not called the right way? # had tried with that too: $zip->fileparse_set_fstype("DOS"); @topDirs = &getTopDirs(\@members); # in: members out my $firstTop=$topDirs[0]; my @splitDirs=split '/',$firstTop,2; my $topName = $splitDirs[0]; foreach $_ (@topDirs){ copyDir $_, $zip, $outzip; } $outzip->writeToFileNamed("pkgout.zip"); exit 0; sub getTopDirs{ my $filenames = $_[0]; my @out; my @splited; foreach $_(@$filenames){ @splited=split("/",$_,4); push @out, $_ if (substr($_,-1) eq "/") and ((scalar @splited) == 3); } return @out; } sub copyDir{ my $theDir = shift; my $fromZip = shift; my $toZip = shift; my @theFiles=$fromZip->membersMatching($theDir); print "the dir $theDir contains " . scalar @theFiles . " files.\n"; copyFiles($fromZip, $toZip, \@theFiles); } sub copyFiles{ my $fromZip = shift; my $toZip = shift; my @theFiles = @{$_[0]}; my $longName; my $dosName; my $tmp; foreach $_ (@theFiles){ $longName = $_->fileName; $dosName=makePath8_3 $longName; $dosName=substr($dosName,index($dosName,"/")+1); # try to remove top path (branch name) print "$longName type:" . blessed($_) . "\n"; if (blessed($_) eq "Archive::Zip::ZipFileMember"){ $fromZip->extractMember($_,$dosName); $toZip->addFile($dosName); } } } sub makePath8_3{ my $input = shift; my @splited=split "/",$input; my $output=""; for (@splited){ my $shorten=make8_3 $_; $output = $output . $shorten . "/"; } $output = substr($output,0,length($output) - 1) if substr($input,-1) ne "/"; return uc $output; } exit 0; sub make8_3{ my $input = shift; my $lastDotIndex = rindex $input, '.'; my $basename = ""; my $ext = ""; return $input if $input eq ".."; return $input if $input eq "."; if ($lastDotIndex != -1){ $basename = substr $input, 0, $lastDotIndex; $ext = "." . substr $input, $lastDotIndex + 1, 3; } else{ $basename = $input; $ext = ""; } $basename = substr $basename, 0, 8; return $basename . $ext; } _______________________________________________ Freedos-devel mailing list [email protected] https://lists.sourceforge.net/lists/listinfo/freedos-devel
