I am writing a perl script that will zip up a group of files from a given parent folder and create a *.epub file. The process works ok, and I am able to open the epub in adobe digital editions, but I get an epubchecker error:
Required MTA-INF/container.xml resource is missing
When I zip up the files manually (I'm on a winxp machine) there are no problems, but the perl created file throws the error. Here is the relevant code:
#-------------------------------------------------------------------------------
# name : createEpub
# purpose : create an epub from a given parent folder
# args : [0] parent folder [1] name of new zip file [2] log object
# example : &createEpub( $zipLoc, 'newzip', $log);
# notes : it is assumed that mimetype, meta-inf and oebs are all child folders
# of the given parent folder
# author: : jw 2/4/13
#-------------------------------------------------------------------------------
sub createEpub(){
my ($parentFolder, $zipName, $log) = #_;
my $newZipLoc;
$parentFolder =~ s#\\#/#g;
my $newZip = Archive::Zip->new();
# add mimetype first with no compression
my $mimetype = "$parentFolder/mimetype";
my $mimetypeMember = $newZip->addFile( $mimetype, 'mimetype');
$mimetypeMember->desiredCompressionMethod( COMPRESSION_STORED );
## add web-inf
my $metaINF = $parentFolder . '/META-INF';
&addFilesToZip( $metaINF, $parentFolder, $newZip, $log);
## add OEBPS
my $oebps = $parentFolder . '/OEBPS';
&addFilesToZip( $oebps, $parentFolder, $newZip, $log );
# maybe break this out in its own func...ok for current epub script purposes
$newZipLoc = $1 if $parentFolder =~ m/(.*)\//;
$newZipLoc = $newZipLoc . '/' . $zipName;
if( $newZipLoc !~ m/\.zip/){
$newZipLoc = $newZipLoc . '.epub';
}
$log->info("writing new zip file to $newZipLoc");
$newZip->writeToFileNamed( $newZipLoc );
## not sure if this is the write thing to do...returning actual file name, not zip extract object
return $newZipLoc;
}
sub addFilesToZip(){
my ($file, $origParent, $zip, $log) = #_;
if( -d $file ){
my #children = grep{ $_ !~ m/mimetype/} glob("$file/*") or warn "can't add $file to zip! $!\n";
foreach my $child( #children ){
&addFilesToZip( $child, $origParent, $zip, $log);
}
} elsif (-f $file){
my $memPath = $file; $memPath =~ s/\Q$origParent\E//;
$log->info("adding member $memPath");
my $newMember = $zip->addFile( $file, $memPath );
}
}
when I open the resulting epub file in winzip, the container.xml is definitely there, I also made sure the mimetype is first with no compression. Here's an excerpt from the log:
-------------------------------------------------------------------------
creating zip file from recently unzipped files
-------------------------------------------------------------------------
[ok]: adding member /META-INF/container.xml
[ok]: adding member /META-INF/stylesheet.css.kindle
[ok]: adding member /META-INF/toc.ncx.kindle
[ok]: adding member /OEBPS/content.opf
[ok]: adding member /OEBPS/coverpage.html
In the googling I've seen there is a slight alteration people make in their linux shell commands, but I didn't see anything related to archive::zip or win.
thanks,
bp
From your logging it looks like you are creating entries in the zip file with absolute paths.
[ok]: adding member /META-INF/container.xml
I believe epub files need to be relative paths - try removing the leading "/" from the path that is going to be written to the zip file. Something like ths (untested)
} elsif (-f $file){
my $memPath = $file; $memPath =~ s/\Q$origParent\E//;
# remove leading "/"
$memPath =~ s#^/+##;
$log->info("adding member $memPath");
my $newMember = $zip->addFile( $file, $memPath );
}
Related
I am trying to copy zipped files which are stored in one directory to another folder by matching there names.
Below image are the folder names which is the input for my program.
From this list i am taking only "Sample_51" folder , inside this folder i have Zipped files like below,
Now i need to copy all "R1" name files to R1 folder and all "R2" named files to R2 folder.
Below i have tried to do so , help me out to do as explained above,
#! use/bin/perl
print "Enter Folder name \n";
print "File name: ";
chomp( my $Filename = <> );
system("mkdir R1");
system("mkdir R2");
opendir( DIR, "$Filename" ) or die "cannot open directory";
foreach my $name ( readdir(DIR) ) {
next if ( $name =~ /^\./ );
next if ( $name =~ /^\.\./ );
if ( $Filename =~ /\S+(R\d)/ ) {
system("cp -r $Filename R1");
}
else {
system("cp -r $Filename R2");
}
}
After copying this one more step is there, than i will update after fixing this issue,
thanks in advance
Use File::Copy to copy the files. As #sobrique said $Filename =~ /\S+(R\d) it matches any digit followed by R.But I guess you are intersted in R1 and R2 only. Try this:
#!/usr/bin/perl
use File::Copy;
use strict;
use warnings;
print"Enter Folder name \n";
print"File name: ";
chomp(my $Filename=<>);
mkdir "R1";
mkdir "R2";
opendir(DIR,"$Filename") or die "cannot open directory";
foreach my $name (readdir(DIR))
{
next if ($name =~ /^\./);
if($name =~ /R1/) { #compare $name not $Filename
copy("$Filename/$name", "R1"); # copy the file from folder to R1 directory
}
elsif($name =~ /R2/){
copy("$Filename/$name","R2"); ## copy the file from folder to R2 directory
}
}
I think your problem is this line:
if ( $Filename =~ /\S+(R\d)/ ) {
Because what it's matching is R followed by any digit. So will be true for files called R1, R2, R9 or indeed R99999
You need to capture the result of that regular expression match. (By the way - an unanchored \S+ isn't going to do much in this example either. That just means 'one or more non spaces' before the R.
How about:
if ( my ( $R_Num ) = ( $Filename =~ /_(R\d+)_/ ) {
print "R number is $R_Num\n";
}
Because then you can work based on what that's set to (and if the match fails, the if will test false).
im working on a simple script to rename & move files into a new directory. I can't seem to get it work properly, basically if the folder is already created it will moves the files into it only if the files are renamed, if the folder is already created but files need to be renamed it won't work it will just rename the files and give me an error because it won't be able to move the files. If the folder need to be created and files to be renamed it will create the folder and rename the files but it won't be able to move them. So i am a bit lost really..
http://i.stack.imgur.com/v8smp.jpg
I've been trying a lot of different way but it ends up not working or giving me the same result i think i am doing something wrong, heres my code :
use strict;
use warnings;
use File::Copy qw(mv);
my ($movie, $season, $cont) = #ARGV;
if (not defined $movie) {
die "need a name as first argument\n";
}
if (defined $movie and defined $season and defined $cont) {
print "\n\nProcessing $movie season $season with container .$cont :\n";
my $npath = "Saison "."$season";
my $exist = 0;
my $num = 1;
my $ind = 0;
my $flast = undef;
my $rpath = undef;
my #files = glob("*.$cont");
my #all = glob('*');
foreach my $f (#files) {
if ($f =~ m/e([0-1_-] ?)\Q$num/i or $f =~ m/episode([0-1_-] ?)\Q$num/i) {
$flast = "$movie.S$season"."E$num.$cont";
rename($f, $flast) or die "\nError while renaming $f !";
$num++;
}
}
if (-d "$npath") {
$exist = 1;
print "\n$npath";
}
else {
mkdir($npath) or die "\nError while making new directory";
$exist = 1;
}
sleep(1);
if ($exist == 1) {
foreach my $f (#files) {
$npath = "Saison "."$season/$f";
mv($f, $npath) or die "\nError while moving $f";
print "\n$f done !";
$ind++;
}
print "\n\n$ind files processed successfully !";
}
}
The problem is that you are renaming the files and then moving them, but after the rename the file no longer exists under its old name in the #files array
You can use mv to change the name of the file as well as putting it into a new directory. In other words, you can call
mv 'movie.title.s01.e08.(2008).[1080p].mkv', 'Saison 01/Movie TitleS01E08.mkv'
which simplifies your program considerably. You just need to create the new directory if it doesn't exist, and then call mv $f, "$npath/$flast" for each name in #files
I am trying to copy data from a folder (named Zip) to a set of newly created folders.
Zip folder content is:
SO_90_X_L001_R1.fastq.gz
SO_100_X_L001_R1.fastq.gz
SO_101_X_L001_R1.fastq.gz
and I have created the following empty folders:
SO_90
SO_100
SO_101
Without giving keyboard input, is it possible to copy those zipped files to matching folders using Perl?
i tryed below script, than also i am not getting proper output.
#!usr/bin/perl
use File::Copy "cp";
open(my $F, "a.txt") or die("cant open a.txt\n");
while(<$F>)
{
next unless /\S/;
mkdir $_ ;
}
close($F);
for my $file (<SO_/*.fastq.gz>){
print $_;
if( $file =~ m!SO_/(.*)_X_L001_R1.fastq.gz! ) {
mkdir($_); # comment this line if not necessary
cp($file, "$1/") or warn("Copy '$file, $1' failed\n");
} else {
warn("$file is not ending in '_X_L001_R1.fasta.gz'\n");
}
}
I am writing a new answer because we the question is in fact different.
We have several files like ZIP/SO_100_X_L001_R1.fastq.gz to copy to
SO_100/....
#!/usr/bin/perl
use File::Copy "cp";
for my $file (<ZIP/*.fastq.gz>){
print $_;
if( $file =~ m!ZIP/(.*)_X_L001_R1.fastq.gz! ) {
mkdir($1); # comment this line if not necessary
cp($file, "$1/") or warn("Copy '$file, $1' failed\n");
} else {
warn("$file is not ending in '_X_L001_R1.fasta.gz'\n");
}
}
Edit: I added some "warnings" in order to help with the debug
perl -nle 'mkdir $_ if /\S/' a.txt
-l to remove \n from folder names (otherwise folder name would be SO_100\n)
if /\S/ to skip possible empty-lines in the input file
(your question changed....) Update: If you need more complex processing, you may build a script where you can include someting like:
open(my $F, "a.txt") or die("cant open a.txt\n");
while(<$F>){
chomp;
next unless /\S/;
mkdir $_ ;
#... do other things related with this folder...
}
close $F;
I trying to write a script that will copy files from one folder to another based on the file name(similar). As I got Few thousands text files in a folder. But I try to find few hundreds of files out of thousands files. It's takes a lot of time to search it one by one.
Copy seem like a good idea to use in this and then use for to loop through the list of files that I try to find out of thousands. But Copy need a specified name. The problem is I only have part of the file name.
Example of list of files(Content of the text file):
ABCDEF-A01
ADEWSD-B03
ABDDER-C23
Example of filename:
GGI_1409506_ABCDEF-A01.txt,GGI_ADEWSD-B03.txt,DA_ABDDER-C23_12304.txt
I only got the ABCDEF-A01 instead of the full filename.
Expected result:
Able to search through the folder and copy the files to another location that matched according the list of files (one text files).
Anything that you can share? Info/ans/related posts? Thank you so much!
Try the below code in perl . When running the program pass the arguments for Source Directory path and Destination Directory path along with the list of filename that need to be searched. If destination directory doesn't exist it will create a folder automatically through the program as shown below :
Code:
use strict;
use warnings;
use File::Copy;
my $source = $ARGV[0];
my $destination = $ARGV[1];
my $listFiles = $ARGV[2];
if(-f $destination)
{
print "Already unknown extension of file exists with the same name of directory. So rename the file and run the program";
exit 0;
}
if(-d "$destination")
{
print "Directory where files need to be copied: $destination\n";
}
else
{
print "No Directory found and hence created the directory $destination\n";
mkdir("$destination");
}
opendir DIR, $source or die "cant open dir";
my #files = grep /(.*?)(\.txt)$/,(readdir DIR);
open my $fh, '<', "$listFiles" or die "Cannot open the file names to search $listFiles - $!";
open my $out,'>', "$ARGV[1]\\NoMatch.txt" or die "Cannot write to the file NoMatch.txt - $!";
my #listFileNames = <$fh>;
my #listFiles = ();
foreach my $InputFiles (#files)
{
chomp($InputFiles);
foreach my $list(#listFileNames)
{
chomp($list);
if($InputFiles =~ /$list/isg)
{
print "Files : $InputFiles copying\t";
copy("$InputFiles","$destination");
print "Files : $InputFiles copied\n";
push(#listFiles,$list);
}
}
}
my %seen = ();
my $count = 0;
foreach my $list (#listFiles)
{
$seen{lc($list)} = 1;
#print $list . "\n";
}
foreach my $listnames (#listFileNames)
{
if($seen{lc($listnames)})
{
}
else
{
if($count ==0)
{
print "\nFilenames that did not match the text files are present in the destination folder : NoMatch.txt file " . "\n";
}
print $out "$listnames\n";
$count++;
}
}
close($out);
close($fh);
closedir(DIR);
create a batch file and put it in the source folder, with your list of files you want to copy.
for /f %%f in (list.txt) do robocopy c:\source d:\dest %%f
Hope this helps
#!/usr/bin/perl -w
use strict;
use File::Copy;
my $sorce_direcrtory = qq{};
my $new_directory = "";
opendir(my $dh, $sorce_direcrtory) || die;
while(readdir $dh) {
if($_ =~ /[A..Z]+\-[A..Z]\d+/){
move("$sorce_direcrtory/$_", "$new_directory/$_");
}
}
closedir $dh;
following is my Perl code:
use strict;
use File::Find;
use MIME::Base64;
use File::Temp qw(tempfile);
sub loadFiles(); #udf
sub mySub(); #udf
my #files = ();
my $dir = shift || die "Argument missing: directory name\n";
my $finalLoc;
my $filePath;
my $fileContents;
my $base64EncFile;
my $domain = "WTX";
my $devFilePath;
my $deviceDir;
my $position;
my $user = "admin";
my $encPwd = "YzNKcGNtRnRZVEF4";
my $decPwd;
my $response;
my $temp;
my $tempFilename;
loadFiles(); #call
foreach (#files) {
#take the file path into a variable
$filePath = $_;
#replace the '/' with '\' in the file path
$filePath =~ s/\//\\/g;
#take the file path into a variable
$devFilePath = $_;
#replace the '\' with '/' in the file path
$devFilePath =~ s/\\/\//g;
#perform string operation to derive a target file path
$position = index( $devFilePath, "RPDM" );
$deviceDir = "local:///" . substr( $devFilePath, $position );
#open handle on file to read the contents
open( FILE, "< $filePath" );
#read the entire file into a variable, 'fileContents'
$fileContents = do { local $/; <FILE> };
#base64 encode the file contents
$base64EncFile = encode_base64($fileContents);
#replace the <CR><LF> characters in the file and flatten the base64 string
$base64EncFile =~ s/[\x0A\x0D]//g;
#printing file path
print "FilePath=$filePath\n";
#creating a temp file with 9 random characters at the end, example 'tempUKv1vqBTp'
$temp = File::Temp->new(
TEMPLATE => "tempXXXXXXXXX",
UNLINK => 0
) or die "Could not make tempfile: $!";
$tempFilename = $temp->filename;
#Printing temp file name
print "TempFileName=$tempFilename\n";
#open the temp file for writing
open(TEMP, ">$tempFilename");
select(TEMP);
while($base64EncFile){
#??? HOW TO PRINT THE VARIABLE $base64EncFile CONTENTS INTO THE TEMP FILE ???
}
#creating a final request for sending to the web service
my $dpString = "<env:Envelope xmlns:env='http://schemas.xmlsoap.org/soap/envelope/' xmlns:dp='http://www.datapower.com/schemas/management'><env:Body><dp:request domain='$domain'><dp:set-file name='$deviceDir'>". $base64EncFile."</dp:set-file></dp:request></env:Body></env:Envelope>";
#decode the encoded password
$decPwd = decode_base64($encPwd);
system('C:\\apps\\curl-7.15.0\\curl.exe', '-#', '-k', '-u', "admin:$decPwd", '--data-binary', "$dpString", 'https://host/service/fileSet');
print "-----------------------------------------------------------\n";
close(TEMP);
close(FILE);
}
sub loadFiles() {
find( \&mySub, "$dir" ); #custom subroutine find, parse $dir
}
# following gets called recursively for each file in $dir, check $_ to see if you want the file!
sub mySub() {
push #files, $File::Find::name
if (/(\.xml|\.xsl|\.xslt|\.ffd|\.dpa|\.wsdl|\.xsd)$/i)
; # modify the regex as per your needs or pass it as another arg
}
Task I am trying to accomplish is, given a folder argument to the above perl program will make recursive calls to a given web service end point. Problem is - using the System command in Perl is unable to send files over 32 Kb. While trying to use File::Temp module in perl, I am not sure how to set the contents of a variable into a temp file (my first week using Perl).
Any help to achieve this will be helpful. Thanks!
Are you asking how to write a string to an open file?
print $fh $string;
should do the trick.
In your example, that would translate to replacing L62-65 with something like:
print TEMP $base64EncFile;