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> ).
Related
I have some .html files in a directory to which I want to add one line of css code. Using perl, I can locate the position with a regex and add the css code, this works very well.
However, my first .html file contain an accented letter: é but the resulting .html file has an encoding problem and prints: \xE9
In the perl file, I have been careful to specify UTF-8 encoding when opening and closing the files, has shown in the MWE below, but that does not solve the problem. How can I solve this encoding error?
MWE
use strict;
use warnings;
use File::Spec::Functions qw/ splitdir rel2abs /; # To get the current directory name
# Define variables
my ($inputfile, $outputfile, $dir);
# Initialize variables
$dir = '.';
# Open current directory
opendir(DIR, $dir);
# Scan all files in directory
while (my $inputfile = readdir(DIR)) {
#Name output file based on input file
$outputfile = $inputfile;
$outputfile =~ s/_not_centered//;
# Open output file
open(my $ofh, '>:encoding(UTF-8)', $outputfile);
# Open only files containning ending in _not_centered.html
next unless (-f "$dir/$inputfile");
next unless ($inputfile =~ m/\_not_centered.html$/);
# Open input file
open(my $ifh, '<:encoding(UTF-8)', $inputfile);
# Read input file
while(<$ifh>) {
# Catch and store the number of the chapter
if(/(<h2)(.*?)/) {
# $_ =~ s/<h2/<h2 style="text-align: center;"/;
print $ofh "$1 style=\"text-align: center;\"$2";
}else{
print $ofh "$_";
}
}
# Close input and output files
close $ifh;
close $ofh;
}
# Close output file and directory
closedir(DIR);
Problematic file named "Chapter_001_not_centered.html"
<html >
<head></head>
<body>
<h2 class="chapterHead"><span class="titlemark">Chapter 1</span><br /><a id="x1-10001"></a>Brocéliande</h2>
Brocéliande
</body></html>
Following demo script does required inject with utilization of glob function.
Note: the script creates a new file, uncomment rename to make replacement original file with a new one
use strict;
use warnings;
use open ":encoding(Latin1)";
my $dir = '.';
process($_) for glob("$dir/*_not_centered.html");
sub process {
my $fname_in = shift;
my $fname_new = $fname_in . '.new';
open my $in, '<', $fname_in
or die "Couldn't open $fname_in";
open my $out, '>', $fname_new
or die "Couldn't open $fname_new";
while( <$in> ) {
s/<h2/<h2 style="text-align: center;"/;
print $out $_;
}
close $in;
close $out;
# rename $fname_new, $fname_in
# or die "Couldn't rename $fname_new to $fname_in";
}
If you do not mind to run following script per individual file basis script.pl in_file > out_file
use strict;
use warnings;
print s/<h2/<h2 style="text-align: center;"/ ? $_ : $_ for <>;
In case if such task arises only occasionally then it can be solved with one liner
perl -pe "s/<h2/<h2 style='text-align: center;'/" in_file
This question found an answer in the commments of #Shawn and # sticky bit:
By changing the encoding to open and close the files to ISO 8859-1, it solves the problem. If one of you wants to post the answer, I will validate it.
Seems fairly simple but with the "$" in the name causes the name to split. I tried escaping the character out but when I try to open the file I get GLOB().
my $path = 'C:\dir\name$.txt';
open my $file, '<', $path || die
print "file = $file\n";
It should open the file so I can traverse the entries.
It has nothing to do with the "$". Just follow standard file handling procedure.
use strict;
use warnings;
my $path = 'C:\dir\name$.txt';
open my $file_handle, '<', $path or die "Can't open $path: $!";
# read and print the file line by line
while (my $line = <$file_handle>) {
# the <> in scalar context gets one line from the file
print $line;
}
# reset the handle
seek $file_handle, 0, 0;
# read the whole file at once, print it
{
# enclose in a block to localize the $/
# $/ is the line separator, so when it's set to undef,
# it reads the whole file
local $/ = undef;
my $file_content = <$file_handle>;
print $file_content;
}
Consider using the CPAN modules File::Slurper or Path::Tiny which will handle the exact details of using open and readline, checking for errors, and encoding if appropriate (most text files are encoded to UTF-8).
use strict;
use warnings;
use File::Slurper 'read_text';
my $file_content = read_text $path;
use Path::Tiny 'path';
my $file_content = path($path)->slurp_utf8;
If it's a data file, use read_binary or slurp_raw.
My hosting is not allowed to upload big files to server with PHP. So I need to upload with Perl.
I need to display uploaded file size. And here is my part of code:
open ( UPLOADFILE, ">$upload_dir/$filename" ) or die "$!";
binmode UPLOADFILE;
while ( <$upload_filehandle> )
{
print UPLOADFILE;
}
close UPLOADFILE;
$filename = ">$upload_dir/$filename";
use File::stat;
my $stat = stat($filename);
say $stat->size;
say stat($filename)->size;
But I got an error:
Can't call method "size" on an undefined value at upload.cgi line 56.
Update
After Borodin's answer I updated to this new code, which is now giving an Internal server error
#!/usr/bin/perl -wT
use strict;
use CGI;
use CGI::Carp qw ( fatalsToBrowser );
use File::Basename;
use diagnostics;
use File::stat;
use warnings;
use 5.010;
... #SOME CODES ##
my $upload_filehandle = $query->upload("photo");
open ( UPLOADFILE, ">$upload_dir/$filename" ) or die "$!";
binmode UPLOADFILE;
while ( <$upload_filehandle> )
{
print UPLOADFILE;
}
close UPLOADFILE;
my $full_name = "$upload_dir/$filename";
{
open my $up_fh, '>:raw', $full_name or die qq{Unable to open "$full_name" for output: $!};
print $up_fh, $_ while <$upload_filehandle>;
}
printf "%.2fMB uploaded\n", (-s $full_name) / (1024 * 1024);
print $query->header ( );
Your variable $filename is set to >$upload_dir/$filename which is wrong. The > is the mode for the open call and isn't part of the file name
You want
my $filename = "$upload_dir/$filename";
Also, rather than using File::stat etc. you can just use the -s file test operator
say -s $filename;
which is much more concise
I would code the whole thing like this
my $full_name = "$upload_dir/$filename";
{
open my $up_fh, '>:raw', $full_name or die qq{Unable to open "$full_name" for output: $!};
print $up_fh, $_ while <$upload_filehandle>;
}
printf "%.2fMB uploaded\n", (-s $full_name) / (1024 * 1024);
Update
You're misunderstanding what my code does. You're opening the upload file twice now -- mine replaces all of that. It should look like this below
The reason you're getting the error is that you're printing the file size before the HTTP header. I don't know what you want your response to look like, but you probably want to wrap it in HTML and print it after $query->header()
#!/usr/bin/perl -T
use strict;
use warnings;
use 5.010;
use CGI;
use CGI::Carp qw ( fatalsToBrowser );
use File::Basename;
#... SOME CODE
my $upload_filehandle = $query->upload('photo');
my $full_name = "$upload_dir/$filename";
{
open my $uploaded_fh, '>:raw', $full_name or die qq{Unable to open "$full_name" for output: $!};
print $uploaded_fh $_ while <$upload_filehandle>;
}
my $size = -s $full_name;
print $query->header('text/plain');
printf "\n%dB file uploaded\n", $size;
The files are not downloading, please help.
#!/usr/bin/perl -w
require HTTP::Response;
require LWP::UserAgent;
open (INPUT, "ndb_id_file.txt") or die "can't open ndb_id_file.txt";
#input = <INPUT>
foreach $line(#input) {
$ua = LWP::UserAgent->new;
$ua->env_proxy('http');
$ua->proxy(['http', 'ftp'],'http://144020019:*******#netmon.****.ac.in:80');
response =
$ua->get('www.ndbserver.rutgers.edu/files/ftp/NDB/coordinates/na-biol/$line');
if ($response->is_success) {
$content = $response->content();
open(OUT,">$line.pdb") or die "Output file $line cannot be produced... Error...";
print (OUT "$content");
}
}
There are a number of problems with your program. The major ones being in this line
response = $ua->get('www.ndbserver.rutgers.edu/files/ftp/NDB/coordinates/na-biol/$line');
You are trying to assign to response, which is not a variable name
the value of $line is not being inserted into the URL because you are using single quotes
The contents of $line end with a linefeed, which should be removed using chomp
The URL has no scheme — it should start with http://
Apart from those points, you should fix these issues
You must always use strict and use warnings at the top of every Perl program you write. Adding -w on the shebang line is far inferior
You should use rather than require LWP::UserAgent. And there is no need to also use HTTP::Response as it is loaded as part of LWP
You should always use the three-parameter form of open with lexical file handles. And if the open fails you should print a die string that includes the value of $! which gives the reason for the failure
You should use while to read data from a file one line at a time, unless you have a good reason to need all of it in memory at once
There is no need to create a new user agent $ua every time around the loop. Just make one and use it to fetch every URL
You should use decoded_content instead of content to fetch the content of an HTTP::Response message in case it is compressed
Here is a program that includes all of those fixes. I haven't been able to test it but it does compile
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
my $in_file = 'ndb_id_file.txt';
open my $fh, '<', $in_file or die qq{Unable to open "$in_file" for input: $!};
my $ua = LWP::UserAgent->new;
$ua->env_proxy('http');
$ua->proxy(['http', 'ftp'], 'http://144020019:*******#netmon.****.ac.in:80');
while ( my $line = <$fh> ) {
chomp $line;
my $url = "http://www.ndbserver.rutgers.edu/files/ftp/NDB/coordinates/na-biol/$line";
my $response = $ua->get($url);
unless ( $response->is_success ) {
warn $response->status_line;
next;
}
my $content = $response->decoded_content;
my $out_file = "$line.pdb";
open my $out_fh, '>', $out_file or die qq{Unable to open "$out_file" for output: $!};
print $out_fh $content;
close $out_fh or die qq{Unable to close "$out_file": $!};
}
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;