I retrieve from a system a text file which has as been (in order):
gzipped
encoded with base64
So I would like in Perl to decode it, unzip it and read it without passing by intermediate file.
I tried the following:
use Compress::Zlib;
use MIME::Base64;
my $workingDir = "./log/";
my $inputFile = $workingDir . "log_result_base64.txt";
my $readtmp ='';
open (INPFIC, $inputFile) or die "ERROR: Impossible to open file ($inputFile)\n";
while (my $buf = <INPFIC> ) {
$readtmp .= decode_base64($buf);
}
close(INPFIC);
my $output = uncompress($readtmp);
print $output;
But it does not work, the $output variable is still undef.
[Edit]
I gave up to do it by passing only by Variable.
I changed my script by creating a new file at each stage:
#!/usr/bin/perl
use strict ;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
use MIME::Base64;
my $inputFile = $workingDir . "log_inbase64.txt";
my $inputFilegz = $workingDir . "log.txt.gz";
my $inputFileuncomp = $workingDir . "log.txt";
my #out;
my #readtmp;
my $readtmp;
# Reading the file encoded in base64
open (INPFIC, $inputFile) or die "ERROR: Impossible to open file ($inputFile)\n";
my #readtmp = <INPFIC>;
close(INPFIC);
$readtmp = join('',#readtmp);
# Decode in base64 to retreive a Gzip file
my $out = decode_base64($readtmp);
open my $fh, '>', $inputFilegz or die $!;
binmode $fh;
print $fh $out;
close $fh;
# Decompress the early created gzip file
gunzip $inputFilegz => $inputFileuncomp
or die "gunzip failed: $GunzipError\n";
# Reading the Text file
open (INPFIC, $inputFileuncomp) or die "ERROR: Impossible to open file ($inputFileuncomp )\n";
my #out = <INPFIC>;
close(INPFIC);
The uncompress method does not work for gzipped data.
IO::Uncompress::Gunzip can use scalar references instead of file names if you want to keep everything in memory.
Sample code:
use IO::Uncompress::Gunzip qw( gunzip $GunzipError );
use MIME::Base64 qw( decode_base64 );
my $tmp = decode_base64 do {
local $/;
<DATA>
};
gunzip \$tmp => \my $data or die "Could not gunzip: $GunzipError";
print $data;
__DATA__
H4sIAHWHLlUAAwvJyCxWAKLi/NxUhZLU4hKFlMSSRC4AsSDaaxcAAAA=
Should produce:
This is some test data
I'd put the whole file in a string before decode:
local $/ = undef;
my $str = <INPFIC>
my $dec = decode_base64 $str;
my $uncom = uncompress($dec)
According to Compress::Zlib doc, try to open and read in same time:
my $workingDir = "./log/";
my $inputFile = $workingDir . "log_result_base64.txt";
my $buffer;
my $output;
my $gz = gzopen($inputFile,"rb")
or die "Cannot open $inputFile: $gzerrno\n" ;
while ( $gz->gzread($buffer) > 0 ){
$output .= decode_base64 $buffer;
}
die "Error reading from $inputFile: $gzerrno" . ($gzerrno+0) . "\n"
if $gzerrno != Z_STREAM_END ;
$gz->gzclose();
print $output;
Related
I'm writing a perl script to extract a specifically named file from a zip file and write to that extracted file (there's more than that to the script but this is the part that I'm getting stuck on). The code below is a portion of the perl script.
I cannot figure out why it's not writing to the file!
my $zipName = "f:\\data\\archive.zip";
my $destPath = "f:\\data\\dataFile.DAT";
my $tempZip = Archive::Zip->new();
my $dataNum = " 0 0";
unless ($tempZip->read($zipName) == AZ_OK )
{
die 'read error';
}
my #dataFileMatches = $tempZip->membersMatching( 'dataFile.*\.DAT' );
my $dataFile;
if($#dataFileMatches> -1)
{
$dataFile = $dataFileMatches[0];
my $fileContents = $tempZip->contents($dataFile);
my $newContents = substr $fileContents, 0, 10;
$newContents = $newContents.$dataNum;
my $dataFilename = $dataFile ->fileName();
open(my $fh, '>', $dataFilename) or die "Could not open file '$dataFilename' $!";
$tempZip->contents($dataFile, $newContents);
$fileContents = $tempZip->contents($dataFile);
print "New FileContents - $fileContents\n";
#print $fh $newContents;
#copy($fh, $destPath);
close $fh;
}
Here is the code that is not being executed:
use strict;
use warnings;
use File::Copy qw(copy);
use Archive::Zip qw/ :ERROR_CODES :CONSTANTS /;
my $filename = 'dataFile.DAT';
open(my $fh, '>', $filename) or die "Could not open file";
print $fh "test\n";
close $fh;
But if I create a dummy TEXT file in the exact same directory that this extracted DAT file is in, it works.
You have to use the extractMemberWithoutPaths() method of Archive::Zip.
Here is how to extract a file:
#!perl
use strict;
use warnings;
use Data::Dumper qw/Dumper/;
use FindBin qw/$Bin/;
use File::Spec;
use Archive::Zip qw/AZ_OK/;
my $zipName = File::Spec->catfile($Bin, '/archive.zip');
my $destPath = File::Spec->catfile($Bin, 'dataFile.DAT');
my $tempZip = Archive::Zip->new();
my $dataNum = " 0 0";
unlink $destPath if -e $destPath;
unless ($tempZip->read($zipName) == AZ_OK ) {
die 'read error';
}
my #dataFileMatches = $tempZip->membersMatching( {regex => 'dataFile.*\.DAT'} );
$tempZip->extractMemberWithoutPaths($dataFileMatches[0]); # extract $fileContents to current working directory
if ( -e $destPath ) {
print "file was extracted\n";
}else{
print "File was not extracted :(\n";
}
I need to modify a Perl script x937.pl to run on all files with extension .x937 within a specific directory. Currently, I use a separate script test.pl that calls my main script, and runs it for each file of that type. However, I need to combine both into one script.
Ideally, I would be able to specify a directory path in the script, and loop through all *.x937 files in that directory.
test.pl
#!/usr/bin/perl -w
use strict;
use Encode;
my #files = <*.x937>;
foreach my $file (#files) {
system('x937.pl', $file);
}
x937.pl
#!/usr/bin/perl -w
use strict;
use Encode;
use warnings;
my $tiff_flag = 0;
my $count = 0;
my $file = "output_$ARGV[0].txt";
unless ( open OPUT, '>' . $file ) {
die "Unable to create $file";
}
open FILE, '<:raw', $ARGV[0] or die "Error opening '$ARGV[0]' $!";
binmode( FILE ) or die 'Error setting binary mode on input file';
while ( read( FILE, $_, 4 ) ) {
my $rec_len = unpack( "N", $_ );
die "Bad record length: $rec_len" unless ( $rec_len > 0 );
read( FILE, $_, $rec_len );
if ( substr( $_, 0, 2 ) eq "\xF5\xF2" ) {
if ( $tiff_flag ) {
$count++;
open( TIFF, '>', 'output_' . $ARGV[0] . '_img' . sprintf( "%04d", $count ) . '.tiff' )
or die "Can't create image file $!";
binmode( TIFF ) or die 'Error setting binary mode on image file';
print TIFF substr( $_, 117 );
close TIFF;
}
$_ = substr( $_, 0, 117 );
}
print OPUT decode( 'cp1047', $_ ) . "\n";
}
close FILE;
close OPUT;
I think I managed to generate this correctly (on iPad, sat on the sofa) ... There could be some typos ; )
Usage: perl test_x397.pl <path>
test_x397.pl
#!/usr/bin/perl -w
use strict; use warnings;
use Encode;
my ($path) = #ARGV;
$path // die "No path specified";
(-e $path) or die "Path not found: $path";
(-d $path) or die "Not a directory: $path";
my #files = <$path/*.x937>;
foreach my $file (#files) {
process($file);
}
sub process {
my ($fname) = #_;
my ($dir, $file) = $fname =~ m{^(.*)/(.+)$};
my $tiff_flag = 0;
my $count = 0;
my $outfile = sprintf("%s/output_%s.txt", $dir, $file);
open (my $outfh, '>', $outfile) or die "Unable to create $outfile. $!";
open (my $infh, '<:raw', $file) or die "Error opening '$file'. $!";
my $buffer = undef;
while (read ($infh,$buffer,4)) {
my $rec_len = unpack("N", $buffer);
die "Bad record length: $rec_len" unless ($rec_len > 0);
read ($infh, $buffer, $rec_len);
if (substr($buffer, 0, 2) eq "\xF5\xF2") {
if ($tiff_flag) {
$count++;
my $tiff_filename = sprintf('%s/output_%s_img%04d.tiff', $dir, $file, $count);
open (my $tiffh, '>', $tiff_filename) or die "Can't create image file $!";
binmode($tiffh) or die 'Error setting binary mode on image file';
print $tiffh substr($buffer, 117);
close $tiffh;
}
$buffer = substr($buffer, 0, 117);
}
print $outfh decode ('cp1047', $buffer) . "\n";
}
close $infh;
close $outfh;
}
A few things to note:
Always use the three argument version of open
Using a scalar filehandle makes it easier to pass it around (not necessary in this example but good practice)
Don't modify $_. It can lead to nasty surprises in larger programs
You already used sprintf to make part of your tiff filename, so why not use it for the whole thing.
I've got the following code:
#!/usr/bin/perl
use strict;
use warnings;
my $usage = "Usage: $0 <infile.txt> <outfile.txt>\n";
my $infile = shift or die $usage;
my $outfile = shift or die $usage;
open (my $data, "<", $infile) or die "There was a problem opening: $!";
my #primers = <$data>;
close $data;
chomp #primers;
use Algorithm::Combinatorics qw(combinations);
my $strings = \#primers;
my $iter = combinations($strings, 2);
open(my $fh, '>', $outfile);
while (my $c = $iter->next) {
print $fh join('',#$c) ."\n";
}
Which works just fine however I would prefer if the user did not have to specify the output directory and filename. Is there an easy way to get Perl to print the output to the same directory as infile but also giving the output file a specific name such as 'output.txt'?
Any pointers would be greatly appreciated!
Thanks.
SOLVED:
#!/usr/bin/perl
use strict;
use warnings;
my $usage = "Usage: $0 <infile.txt>\n";
my $infile = shift or die $usage;
use File::Basename;
my $DIR = dirname($infile);
my $outfile = $DIR . "/results.txt" or die $usage;
open (my $data, "<", $infile) or die "There was a problem opening: $!";
my #primers = <$data>;
close $data;
chomp #primers;
use Algorithm::Combinatorics qw(combinations);
my $strings = \#primers;
my $iter = combinations($strings, 2);
open(my $fh, '>', $outfile);
while (my $c = $iter->next) {
print $fh join('',#$c) ."\n";
}
print ("Finished. The results are located at $outfile\n\n");
If I understand you correctly, you are trying to write the output to the same directory as input file. If so, you can use File::Basename module to get the directory of the input file.
How about
my $outfile=$infile . ".combinations"
Or, better yet, use stdin and stdout.
(also, check that your outfile was opened succesfully)
I am trying to send contents (raw contents) of a file to browser.
But the file is delivered as attachment, even there is no attachment in headers.
Can anyone please suggest how I can display raw data on browser using perl ?
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use File::Copy qw( copy );
use File::Spec::Functions qw( catfile );
use POSIX qw(strftime);
use Time::Local;
use HTTP::Status qw(:constants :is status_message);
use Digest::MD5 qw(md5 md5_hex md5_base64);
use File::Basename;
use URI;
my $extfile = '/home/suresh/clientrequest.txt';
open(FH, ">>$extfile") or die "Cannot open file";
my $query = CGI->new;
my $stcode = status_message(206);
my $uri =$ENV{'REQUEST_URI'};
my $rdate =strftime("%a, %d %b %Y %H:%M:%S %Z", localtime());
print FH "Client request: ", $ENV{'REQUEST_URI'}, "\n";
my $dir = '/srv/samba/Assets';
#my $dir = '/home/suresh/Assets';
my $nffFile = fileparse ("$uri", qr/\.[^.]*/);
my $fullFname = $nffFile . ".nff";
my $path = catfile($dir, $fullFname);
my $filesize = -s $path;
print FH "Size of the file: ", $filesize, "\n";
#Search requested asset files
opendir(DIR, $dir);
my #files = readdir(DIR);
if (grep($_=~/$fullFname/,#files)){
print FH "Found the requested NFF file: ", $fullFname, "\n";
open my $fh, '<:raw', $path;
print "$ENV{SERVER_PROTOCOL} 206 $stcode";
print $query->header(
-'Accept-Range'=>'bytes',
-'Date'=> $rdate,
-'Content-Range'=>'0-188/$filesize',
-'Content-Length'=>$filesize,
-'Content-Type'=>'application/octet-stream',
-'Connection'=>'Keep-Alive',
-'Media-Type'=>'application/octet-stream',
);
binmode STDOUT, ':raw';
copy $fh => \*STDOUT;
close $fh
or die "Cannot close '$path': $!";
}else {
print $query->header('text/plain', '404 File not Found!');
print FH "Requested NFF file: ", $fullFname, " not found!!\n\n";
}
closedir(DIR);
Solved .. It was a simple change I need to change content type as text/html to archive this.
I tried to use this very simple script for uploading a file to my server. For some reason it is not working. I get the following message in my apache error log:
Use of uninitialized value in <HANDLE> at /opt/www/demo1/upload/image_upload_2.pl line 15.
readline() on unopened filehandle at /opt/www/demo1/upload/image_upload_2.pl line 15.
#!/usr/bin/perl -w
use CGI;
$upload_dir = "/opt/www/demo1/upload/data";
$query = new CGI;
$filename = $query->param("photo");
$filename =~ s/.*[\/\\](.*)/$1/;
$upload_filehandle = $query->upload("photo");
open UPLOADFILE, ">$upload_dir/$filename";
binmode UPLOADFILE;
while ( <$upload_filehandle> )
{
print UPLOADFILE;
}
close UPLOADFILE;
1
Any ideas what is wrong there?
Thanks
mx
File upload forms need to specify enctype="multipart/form-data". See W3C documentation.
In addition, note the following:
#!/usr/bin/perl
use strict; use warnings;
use CGI;
my $upload_dir = "/opt/www/demo1/upload/data";
my $query = CGI->new; # avoid indirect object notation
my $filename = $query->param("photo");
$filename =~ s/.*[\/\\](.*)/$1/; # this validation looks suspect
my $target = "$upload_dir/$filename";
# since you are reading binary data, use read to
# read chunks of a specific size
my $upload_filehandle = $query->upload("photo");
if ( defined $upload_filehandle ) {
my $io_handle = $upload_filehandle->handle;
# use lexical filehandles, 3-arg form of open
# check for errors after open
open my $uploadfile, '>', $target
or die "Cannot open '$target': $!";
binmode $uploadfile;
my $buffer;
while (my $bytesread = $io_handle->read($buffer,1024)) {
print $uploadfile $buffer
or die "Error writing to '$target': $!";
}
close $uploadfile
or die "Error closing '$target': $!";
}
See CGI documentation.
If you are uploading a text file then below should be set in <head> of html file:
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
Otherwise the $file_name = $query->param("file_name") is defined in scalar context (print $file_name) and undef in file context ( <$file_name> ).