Currently I am using the following code to allow a user to upload an image via a html form. It creates a copy of the image which I then read in to ImageMagick. But of course it would be way better to simply read the data from the form straight into the ImageMagick object. But I have not been able to achieve that.
use Image::Magick;
use MIME::Base64;
$arg = new CGI;
$fetch_photo = param('fileuploadphoto');
($data, $base64) = split /,/, $fetch_photo;
($type) = $data =~ m!data:image/(\w+);base64!;
$decoded = MIME::Base64::decode_base64($base64);
$filename = 'test.jpg';
open(my $file, '>', "$filename") or die "Error cannot open file: $file";
binmode $file;
print $file $decoded;
close($file);
$image = Image::Magick->new;
$image->Read($filename);
Thanks to Håkon Hægland for the answer. This works perfectly.
use Image::Magick;
use MIME::Base64;
$fetch_photo = param('fileuploadphoto');
($data, $base64) = split /,/, $fetch_photo;
$decoded = MIME::Base64::decode_base64($base64);
$image = Image::Magick->new;
$image->Read(blob => $decoded);
Related
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;
Im using LWP to download an executable file type and with the response in memory, i am able to hash the file. However how can i save this file on my system? I think i'm on the wrong track with what i'm trying below. The download is successful as i am able to generate the hash correctly (I've double checked it by downloading the actual file and comparing the hashes).
use strict;
use warnings;
use LWP::Useragent;
use Digest::MD5 qw( md5_hex );
use Digest::MD5::File qw( file_md5_hex );
use File::Fetch;
my $url = 'http://www.karenware.com/progs/pthasher-setup.exe';
my $filename = $url;
$filename =~ m/.*\/(.*)$/;
$filename = $1;
my $dir ='/download/two';
print "$filename\n";
my $ua = LWP::UserAgent->new();
my $response = $ua->get($url);
die $response->status_line if !$response->is_success;
my $file = $response->decoded_content( charset => 'none' );
my $md5_hex = md5_hex($file);
print "$md5_hex\n";
my $save = "Downloaded/$filename";
unless(open SAVE, '>>'.$save) {
die "\nCannot create save file '$save'\n";
}
print SAVE $file;
close SAVE;
If you are wondering why do i not instead download everything then parse the folder for each file and hash, its because im downloading all these files in a loop. And during each loop, i upload the relevant source URL (where this file was found) , along with the file name and hash into a database at one go.
Try getstore() from LWP::Simple
use strict;
use warnings;
use LWP::Simple qw(getstore);
use LWP::UserAgent;
use Digest::MD5 qw( md5_hex );
use Digest::MD5::File qw( file_md5_hex );
use File::Fetch;
my $url = 'http://www.karenware.com/progs/pthasher-setup.exe';
my $filename = $url;
$filename =~ m/.*\/(.*)$/;
$filename = $1;
my $dir ='/download/two';
print "$filename\n";
my $ua = LWP::UserAgent->new();
my $response = $ua->get($url);
die $response->status_line if !$response->is_success;
my $file = $response->decoded_content( charset => 'none' );
my $md5_hex = md5_hex($file);
print "$md5_hex\n";
my $save = "Downloaded/$filename";
getstore($url,$save);
getstore is an excellent solution, however for anyone else reading this response in a slightly different setup, it may not solve the issue.
First of all, you could quite possibly just be suffering from a binary/text issue.
I'd change
my $save = "Downloaded/$filename";
unless(open SAVE, '>>'.$save) {
die "\nCannot create save file '$save'\n";
}
print SAVE $file;
close SAVE;
to
my $save = "Downloaded/$filename";
open my $fh, '>>', $save or die "\nCannot create save file '$save' because $!\n";
# on platforms where this matters
# (like Windows) this is needed for
# 'binary' files:
binmode $fh;
print $fh $file;
close $fh;
The reason I like this better is that if you have set or acquired some settings on your browser object ($ua), they are ignored in LWP::Simple's getstore, as it uses its own browser.
Also, it uses the three parameter version of open which should be safer.
Another solution would be to use the callback method and store the file while you are downloading it, if for example you are dealing with a large file. The hashing algorithm would have to be changed so it is probably not relevant here but here's a sample:
my $req = HTTP::Request->new(GET => $uri);
open(my $fh, '>', $filename) or die "Could not write to '$filename': $!";
binmode $fh;
$res = $ua->request($req, sub {
my ($data, $response, $protocol) = #_;
print $fh $data;
});
close $fh;
And if the size is unimportant (and the hashing is done some other way) you could just ask your browser to store it directly:
my $req = HTTP::Request->new(GET => $uri);
$res = $ua->request($req, $filename);
Well.. I'm stuck again. I've read up quite a few topic with similar problems but not finding a solution for mine. I have a ; delimited csv file and the strings at the 8th column ($elements[7]) is as following: "aaaa;bb;cccc;ddddd;eeee;fffff;gg;". What i'm trying is to split the string based on ; and capture the outputs to variables. Then use those variables in the main csv file in their own column.
So now the file is like:
3d;2f;7j;8k;4s;2b;5g;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";4g;1a;5g;2g;7h;3d;2f;7j
3c;9k;5l;4g;1a;5g;3d;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";4g;1a;5g;2g;7h;3d;2f;7j
4g;1a;5g;2g;7h;3d;8k;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";3d;2f;7j;8k;4s;2b;4g;1a
And i want it like:
3d;2f;7j;8k;4s;2b;5g;4g;1a;5g;2g;7h;3d;2f;7j;aaaa;bb;cccc;ddddd;eeee;fffff;gg
3c;9k;5l;4g;1a;5g;3d;4g;1a;5g;2g;7h;3d;2f;7j;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
4g;1a;5g;2g;7h;3d;8k;3d;2f;7j;8k;4s;2b;4g;1a;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
This is my code i've been trying it with. I know.. it's terrible! But i'm hoping someone can help me?
use strict;
use warnings;
my $inputfile = shift || die "Give files\n";
my $outputfile = shift || die "Give output\n";
open my $INFILE, '<', $inputfile or die "In use / Not found :$!\n";
open my $OUTFILE, '>', $outputfile or die "In use :$!\n";
while (<$INFILE>) {
s/"//g;
my #elements = split /;/, $_;
my ($varA, $varB, $varC, $varD, $varE, $varF, $varG, $varH) split (';', $elements[10]);
$elements[16] = $varA;
$elements[17] = $varB;
$elements[18] = $varC;
$elements[19] = $varD;
$elements[20] = $varE;
$elements[21] = $varF;
$elements[22] = $varG;
$elements[23] = $varH;
my $output_line = join(";", #elements);
print $OUTFILE $output_line;
}
close $INFILE;
close $OUTFILE;
exit 0;
I'm confused about the my statement as well, it shouldn't be possible right? I mean the $vars are in a closed part so it shouldn't be possible to write them to $elements?
EDIT
This is how i adjusted the code with TLP's suggestions:
use strict;
use warnings;
use Text::CSV;
my $inputfile = shift || die "Give files\n";
my $outputfile = shift || die "Give output\n";
open my $INFILE, '<', $inputfile or die "In use / Not found :$!\n";
open my $OUTFILE, '>', $outputfile or die "In use :$!\n";
my $csv = Text::CSV->new({ # create a csv object
sep_char => ";", # delimiter
eol => "\n", # adds newline to print
});
while (my $row = $csv->getline($INFILE)) { # $row is an array ref
my $line = splice(#$row, 10, 1); # remove 8th line
$csv->parse($line); # parse the line
push #$row, $csv->fields(); # push newly parsed fields onto main array
$csv->print($OUTFILE, $row);
}
close $INFILE;
close $OUTFILE;
exit 0;
You should use a CSV module, e.g. Text::CSV to parse your data. Here's a brief example on how it can be done. You can replace the file handles I used below with your own.
use strict;
use warnings;
use Text::CSV;
my $csv = Text::CSV->new({ # create a csv object
sep_char => ";", # delimiter
eol => "\n", # adds newline to print
});
while (my $row = $csv->getline(*DATA)) { # $row is an array ref
my $line = splice(#$row, 7, 1); # remove 8th line
$csv->parse($line); # parse the line
push #$row, $csv->fields(); # push newly parsed fields onto main array
$csv->print(*STDOUT, $row);
}
__DATA__
3d;2f;7j;8k;4s;2b;5g;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";4g;1a;5g;2g;7h;3d;2f;7j
3c;9k;5l;4g;1a;5g;3d;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";4g;1a;5g;2g;7h;3d;2f;7j
4g;1a;5g;2g;7h;3d;8k;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";3d;2f;7j;8k;4s;2b;4g;1a
Output:
3d;2f;7j;8k;4s;2b;5g;4g;1a;5g;2g;7h;3d;2f;7j;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
3c;9k;5l;4g;1a;5g;3d;4g;1a;5g;2g;7h;3d;2f;7j;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
4g;1a;5g;2g;7h;3d;8k;3d;2f;7j;8k;4s;2b;4g;1a;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
How can I add/overwrite the title and author metadata of a PDF using CAM::PDF?
I'm the author of CAM::PDF. The library doesn't support this sort of edit, but you can do it by digging into the internals like this:
#!perl -w
use strict;
use CAM::PDF;
my $infile = shift || die 'syntax...';
my $outfile = shift || die 'syntax...';
my $pdf = CAM::PDF->new($infile) || die;
my $info = $pdf->getValue($pdf->{trailer}->{Info});
if ($info) {
#use Data::Dumper; print Dumper($info);
my $title = $info->{Title};
if ($title) {
$title->{value} = 'Foo';
# for a proper implementation, we should mark the holder of $info as dirty...
# But cleanoutput ignores dirty flags anyway and writes the whole doc
$pdf->cleanoutput($outfile);
}
}
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> ).