I am unable to download the file in cgi perl. Instead I get the contents printed on the web page itself.This is what I had tried.
Code:
use CGI qw /:standard /;
use CGI;
print "Content-type:text/html\n\n";
my $files_location;
my $ID;
my #fileholder;
$directorypath = "/var/www/cgi-bin/";
$files_location = $directorypath;
$ID = 'file.txt';
#$ID = param('ID');
if ($ID eq '') {
print "You must specify a file to download.";
} else {
open(DLFILE, "<$files_location/$ID") || Error('open', 'file');
#fileholder = <DLFILE>;
close (DLFILE) || Error ('close', 'file');
#these are the html codes that forces the browser to open for download
print "Content-Type:application/x-download\n";
print "Content-Disposition:attachment;filename=$ID\n\n";
print #fileholder;
}
I am getting this:
Content-Type:application/x-download Content-Disposition:attachment;filename=file.txt ih how are u iam hre
file.txt
ih how are u iam hre
On line 4 you've got:
print "Content-type:text/html\n\n";
That double \n signals end-of-headers, content will follow. Get rid of that and try again?
try commenting
print "Content-type:text/html\n\n";
You must move the below line from top to inside if loop:
print "Content-type:text/html\n\n";
To
if ($ID eq '') {
print "Content-type:text/html\n\n";
print "You must specify a file to download.";
}
Related
how can i cache errors in perl? Is there try/cache like in JS? I would like if any error occurs to go to the start of the script.
And if anyone has an idea of improvement for the script below let me know because this is my first one in perl. The script just has to loop forever and never stop. :)
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use JSON;
use HTTP::Request::Common qw(POST GET);
use Encode qw(encode);
use DBI;
use Time::Piece;
# Beware: we disable the SSL certificate check for this script.
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}=0;
# Debugging: off=0, medium=3, extensive=5
my $debuglevel=0;
my ($host,$username,$password)=('192.168.xxx.xxx','xxxx','xxxx');
# Define cms api key and nodeid.
my ($cmsapi,$cmsnode)=('xxxxxxxxx','1');
# Define all parameters to be logged each script's iteration.
# #parameterlist[x][$parameterid,$parameterlongtext,$parametershorttext,$data]
# which corresponds for FHEM's DbLog with:
# #parameterlist[x][$parameterid,$parameterlongtext,READING ,VALUE]
# $parameterlist[x][3] will be populated by the script, thus here undefined in each line (the last value is missing).
my #parameterlist=(
[3922,"Status TC","statusHeatPump"],
[3931,"Zunanja temperatura","outsideTemperature"],
[3924,"Status zalogovnika","statusBuffer"],
[3925,"Status bojlerja","statusBoiler"],
[3940,"Temperatura bojlerja","boilerTemperature"],
[3943,"Temperatura zalogovnika","bufferTemperature"],
[4331,"Temperatura nadstropja","floorTemperature"],
[3811,"Temperatura pritličja","groundTemperature"],
);
# We substitute the text for the burner's status with an integer, so plots are easier.
# Define which parameter holds the burner's status.
my $parameterstatusHeatPump=3922;
my #statusHeatPumpmatrix=(
["Off",0],
["Heating mode",50],
);
sub trim() {
my $str = $_[0];
$str =~ s/^\s+|\s+$//g;
return $str;
};
print "DEBUG: *** Script starting ***\n" if($debuglevel>0);
while (1) {
sleep 1;
my $ua=LWP::UserAgent->new;
my $request=HTTP::Request->new(GET=>'https://'.$host.'/api/auth/login.json?user='.$username.'&pwd='.$password);
my $response=$ua->request($request);
my $decoded=decode_json($response->decoded_content( charset => 'none'));
my $success=$decoded->{'Result'}{'Success'};
my $sessionid=$decoded->{'SessionId'};
print "DEBUG: ".$response->content."\n" if($debuglevel>4);
print "DEBUG: ".$success."\n" if($debuglevel>4);
my $i=0;
my $j=0;
my $parameterid;
my $dataValue;
my $rightnow;
my $data = "empty";
while (defined($parameterlist[$i][0])) {
$parameterid=$parameterlist[$i][0];
$request=HTTP::Request->new(GET=>'https://'.$host.'/api/menutree/read_datapoint.json?SessionId='.$sessionid.'&Id='.$parameterid);
$response=$ua->request($request);
$decoded=JSON->new->utf8->decode($response->decoded_content( charset => 'none'));
$success=$decoded->{'Result'}{'Success'};
$dataValue=encode('UTF-8', $decoded->{'Data'}{'Value'});
$parameterlist[$i][3]=&trim($dataValue);
if ($parameterlist[$i][0]==$parameterstatusHeatPump) {
$j=0;
while (defined($statusHeatPumpmatrix[$j][0])) {
if ($statusHeatPumpmatrix[$j][0] eq $parameterlist[$i][3]) {
$parameterlist[$i][3]=$statusHeatPumpmatrix[$j][1];
print "DEBUG: Substituting text of HeatPump\n" if($debuglevel>0);
};
$j++;
}
}
print "DEBUG: ".$response->content."\n" if($debuglevel>4);
print "DEBUG: ".$success."\n" if($debuglevel>4);
print "DEBUG: ".$parameterlist[$i][1]."=".$dataValue."\n" if($debuglevel>0);
$rightnow=localtime->strftime('%Y-%m-%d %H:%M:%S');
if ($data eq "empty"){
$data = $parameterlist[$i][2].':'.$parameterlist[$i][3];
}
else{
$data = $parameterlist[$i][2].':'.$parameterlist[$i][3].','.$data;
}
$i++;
}
print "JSON data = ".$data."\n" if($debuglevel>0);;
#Post data
my $req=HTTP::Request->new(POST=>'http://cms.org/input/post.json?apikey='.$cmsapi.'&node='.$cmsnode.'&json={'.$data.'}');
my $resp = $ua->request($req);
if ($resp->is_success) {
my $message = $resp->decoded_content;
print "Received reply: $message\n" if($debuglevel>0);
}
else {
print "HTTP POST error code: ", $resp->code, "\n" if($debuglevel>0);
print "HTTP POST error message: ", $resp->message, "\n" if($debuglevel>0);
}
}
print "DEBUG: *** Script ended ***\n\n" if($debuglevel>0);
I am answering the specific:
Is there try/cache like in JS?
Yes there is. Instead of
try {
possible evil code;
} catch (e) {
...
}
in perl you write
eval {
possible evil code;
};
if ($#) {
...
}
where $# is the message with which youre code died. BTW - don't vorget the ';' after the eval code.
HTH
Georg
In Perl you can use eval,
For Perl Script:
eval {
your code statement;
}
if($#){
print qq{Error: $#};
}
For CGI file use like below if you want to print the error:
eval {
your code statement || die "Error: $!";
}
if($#){
print qq{Error: $#};
}
After encountering the else condition(invalid url) loop is terminated and not processing further urls. 2. even if the node fails in xpath it is not printed in screen or file.I want to print that in both file and screen (node exception)
use LWP::Simple;
use File::Compare;
use HTML::TreeBuilder::XPath;
use LWP::UserAgent;
use Win32::Console::ANSI;
use Term::ANSIColor;
sub crawl_content{
{
open(FILE, "C:/Users/jeyakuma/Desktop/input/input.txt");
{
while(<FILE>){
chomp;
$url=$_;
foreach ($url){
$domain) = $url =~ m|www.([A-Z a-z 0-9]+.{3}).|x;
}
do 'C:/Users/jeyakuma/Desktop/perl/mainsub.pl';
&domain_check();
my $ua = LWP::UserAgent->new( agent => "Mozilla/5.0" );
my $req = HTTP::Request->new( GET => "$url" );
my $res = $ua->request($req);
if ( $res->is_success ){
print "working on $domain\n";
binmode ":utf8";
my $xp = HTML::TreeBuilder::XPath->new_from_url($url);
my #node = $xp->findnodes_as_string("$xpath") or print "couldn't find the node\n" ;
open HTML, '>:encoding(cp1252)',"C:/Users/jeyakuma/Desktop/ project/data_$date/$site.html";
foreach(<#node>){
print HTML #node;
close HTML ;
}
}
else{
print color("green"), "$domain Invalid url\n", color("reset") and open FILE,">C:/Users/jeyakuma/Desktop/log.txt"; print FILE " $domain Invalid URL";
}
}
}
}
}
do 'C:/Users/jeyakuma/Desktop/perl/comparefinal.pl';
compare_result();
}
The else condition reopens FILE for writing to another file. Thus, at the next iteration of the while (<FILE>) loop, Perl will attempt to read from FILE and fail (because it's now only available for writing, not reading), and the loop will end. You need to use a name other than FILE in the else condition.
I want to make a tool to classify each line in input file to several files
but it seems have some problem in naming a filehandler so I can't go ahead , how do I solve?
here is my program
ARGV[0] is the input file
ARGV[1] is the number of classes
#!/usr/bin/perl
use POSIX;
use warnings;
# open input file
open(Raw,"<","./$ARGV[0]") or die "Can't open $ARGV[0] \n";
# create a directory class to store class files
system("mkdir","Class");
# create files for store class informations
for($i=1;$i<=$ARGV[1];$i++)
{
# it seems something wrong in here
open("Class$i",">","./Class/$i.class") or die "Can't create $i.class \n";
}
# read each line and random decide which class to store
while( eof(Raw) != 1)
{
$Line = readline(*Raw);
$Random_num = ceil(rand $ARGV[1]);
for($k=1;$k<=$ARGV[1];$k++)
{
if($Random_num == $k)
{
# Store to the file
print "Class$k" $Line;
last;
}
}
}
for($h=1;$h<=$ARGV[1];$h++)
{
close "Class$h";
}
close Raw;
thanks
Later I use the advice provided by Bill Ruppert
I put the name of filehandler into array , but it seems appear a syntax bug , but I can't correct it
I label the syntax bug with ######## A syntax error but it looks quite OK ########
here is my code
#!/usr/bin/perl
use POSIX;
use warnings;
use Data::Dumper;
# open input file
open(Raw,"<","./$ARGV[0]") or die "Can't open $ARGV[0] \n";
# create a directory class to store class files
system("mkdir","Class");
# put the name of hilehandler into array
for($i=0;$i<$ARGV[1];$i++)
{
push(#Name,("Class".$i));
}
# create files of classes
for($i=0;$i<=$#Name;$i++)
{
$I = ($i+1);
open($Name[$i],">","./Class/$I.class") or die "Can't create $I.class \n";
}
# read each line and random decide which class to store
while( eof(Raw) != 1)
{
$Line = readline(*Raw);
$Random_num = ceil(rand $ARGV[1]);
for($k=0;$k<=$#Name;$k++)
{
if($Random_num == ($k+1))
{
print $Name[$k] $Line; ######## A syntax error but it looks quite OK ########
last;
}
}
}
for($h=0;$h<=$#Name;$h++)
{
close $Name[$h];
}
close Raw;
thanks
To quote the Perl documentation on the print function:
If you're storing handles in an array or hash, or in general whenever you're using any expression more complex than a bareword handle or a plain, unsubscripted scalar variable to retrieve it, you will have to use a block returning the filehandle value instead, in which case the LIST may not be omitted:
print { $files[$i] } "stuff\n";
print { $OK ? STDOUT : STDERR } "stuff\n";
Thus, print $Name[$k] $Line; needs to be changed to print { $Name[$k] } $Line;.
How about this one:
#! /usr/bin/perl -w
use strict;
use POSIX;
my $input_file = shift;
my $file_count = shift;
my %hash;
open(INPUT, "<$input_file") || die "Can't open file $input_file";
while(my $line = <INPUT>) {
my $num = ceil(rand($file_count));
$hash{$num} .= $line
}
foreach my $i (1..$file_count) {
open(OUTPUT, ">$i.txt") || die "Can't open file $i.txt";
print OUTPUT $hash{$i};
close OUTPUT;
}
close INPUT;
Hi I'm trying to upload a file using CGI and although the CGI script runs, the file that is created is empty.
I have a html file which gets the file name and passes it to a cgi script:
<html>
<body>
<form enctype="multipart/form-data" action="cgi-bin/upload.pl" method="POST">
<input type="FILE" name="file">
<input type="submit">
</form>
</body>
</html>
The cgi script is as follows:
#!/usr/bin/perl -w
use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI;
print "Content-type: text/html\n\n";
my $cgi = new CGI;
my $dir = 'sub';
my $name = $cgi->param('file');
print "name: $name <br />\n";
open(LOCAL, ">$dir/$name") or die "error: failed to open $dir/$name\n";
my $file_handle = $cgi->upload('file');
die "file_handle not defined\n" unless(defined($file_handle));
while(<$file_handle>) {
print $_;
print LOCAL $_;
}
close($file_handle);
close(LOCAL);
print "done\n";
The cgi script runs OK, produces no warnings, manages to create a local file and correctly gets the remote file name. However, the script appears not to read any data from the file or write any data into the local file which is empty.
I'm definitely uploading a file that contains multiple lines of data but the output of the cgi script is as follows:
name: tmp.txt
done
Any help greatly appreciated...
You might want to try using the binmode command on the FH.
Here's a Perl script that I use as a starting point for a CGI form that uploads files (displays the form and does the upload):
#!/usr/bin/perl
use strict;
use warnings;
use POSIX;
use CGI::Pretty qw(:standard -any -no_xhtml -oldstyle_urls *center);
use CGI::Carp qw(fatalsToBrowser set_message);
use Upload;
# Constants
my $FILE_DIR_INTERNAL = 'Z:\webroot\tmp';
# Variables
my $ACTION = param('action') || "";
if (! $ACTION) { UploadForm() }
elsif ($ACTION eq "UploadFile") {
my $file = UploadFile($FILE_DIR_INTERNAL, 1);
print "File uploaded to $file\n<pre>";
open(F, "$file");
while(<F>) { print }
close(F);
}
And here's the Perl module used by that script:
package Upload;
use strict;
use warnings;
use POSIX;
use File::Copy;
use CGI::Pretty qw(:standard -any -no_xhtml -oldstyle_urls *center);
use CGI::Carp qw(fatalsToBrowser); # supposed to echo STDERR to browser, too
use Exporter;
our $VERSION = do{ q$Revision: 1.5 $ =~ /(\d+)\.(\d*)([^ ]*)/; sprintf "%d.%02d%s", $1, $2, $3; };
our #ISA = qw(Exporter);
our #EXPORT = qw(UploadForm UploadFile);
my $FILE_UPLOAD_PARAM = "fileUploaded";
# *************************************************************************
# FUNCTION: UploadForm
# ARGUMENTS:
# RETURNS:
# NOTES: This subroutine displays the upload form.
# *************************************************************************
sub UploadForm {
print start_center;
print p("Upload a file from your computer:");
# Normally, I use the "get" method for forms (params show up in URL),
# but "post" is required for uploading files!
# Using "post" also requires that we pass parameters thru the hidden()
# commands down below, instead of in the URL.
print start_multipart_form({-method=>"post", -action=>script_name});
print filefield($FILE_UPLOAD_PARAM,"",50) . "\n";
# Hidden parameters are "sticky", so modify the existing "action" param,
# before trying to insert a new hidden "action" param.
# If you don't, CGI.pm will re-use the current "action" param.
param("action", "UploadFile");
print hidden("action") . "\n";
print p(submit("", "Upload File"));
print end_form;
print end_center;
}
# *************************************************************************
# FUNCTION: UploadFile
# ARGUMENTS:
# RETURNS:
# NOTES: This subroutine handles data "posted" thru the form
# created in UploadForm().
# *************************************************************************
sub UploadFile {
my $dir = shift || die "ERROR! No arg passed to UploadFile().\n";
my $overwrite = shift || 0;
my $TEMP_FH;
# The upload() function returns the filename and a file handle. See CGI.pm.
$_= $TEMP_FH = upload($FILE_UPLOAD_PARAM);
# What do all the regexes do? I wrote them, but I forgot. I think they
# strip off any path information (common in IE!) to get just the filename.
s/\w://;
s/([^\/\\]+)$//;
$_ = $1;
s/\.\.+//g;
s/\s+//g;
my $filename = $_;
my $serverFullFilename = "$dir/$filename";
if (! $filename) {
DisplayErrorPage("Illegal filename: '$filename'");
}
if ((! $overwrite) && (-e $serverFullFilename)) {
die "Unable to upload file. File '$filename' already exists.";
}
open(SERVER_FH,">$serverFullFilename") || die "Error opening $filename for writing.";
binmode SERVER_FH;
# Copy the file from the temp dir to the final location.
while (<$TEMP_FH>) {
print SERVER_FH;
}
close(SERVER_FH);
close($TEMP_FH);
if ((stat $serverFullFilename)[7] <= 0) {
unlink $serverFullFilename;
die "Unable to upload file '$filename'. This is usually due to the user specifying an invalid or unreadable file on the user's computer.";
}
return $serverFullFilename;
}
return 1;
Forgive any inconsistencies, as I had to cut out some site-specific stuff, but if I trimmed it all correctly, that should work "out of the box"
I am trying to find a RSS parser that can be used with a Perl CGI script. I found simplepie and that's really easy parser to use in PHP scripting. Unfortunately that doesn't work with a Perl CGI script. Please let me know if there is anything that's easy to use like simplepie.
I came across this one RssDisplay but I am not sure about the usage and also how good it is.
From CPAN: XML::RSS::Parser.
XML::RSS::Parser is a lightweight liberal parser of RSS feeds. This parser is "liberal" in that it does not demand compliance of a specific RSS version and will attempt to gracefully handle tags it does not expect or understand. The parser's only requirements is that the file is well-formed XML and remotely resembles RSS.
#!/usr/bin/perl
use strict; use warnings;
use XML::RSS::Parser;
use FileHandle;
my $parser = XML::RSS::Parser->new;
unless ( -e 'uploads.rdf' ) {
require LWP::Simple;
LWP::Simple::getstore(
'http://search.cpan.org/uploads.rdf',
'uploads.rdf',
);
}
my $fh = FileHandle->new('uploads.rdf');
my $feed = $parser->parse_file($fh);
print $feed->query('/channel/title')->text_content, "\n";
my $count = $feed->item_count;
print "# of Items: $count\n";
foreach my $i ( $feed->query('//item') ) {
print $i->query('title')->text_content, "\n";
}
Available Perl Modules
XML::RSS::Tools
XML::RSS::Parser:
#!/usr/bin/perl -w
use strict;
use XML::RSS::Parser;
use FileHandle;
my $p = XML::RSS::Parser->new;
my $fh = FileHandle->new('/path/to/some/rss/file');
my $feed = $p->parse_file($fh);
# output some values
my $feed_title = $feed->query('/channel/title');
print $feed_title->text_content;
my $count = $feed->item_count;
print " ($count)\n";
foreach my $i ( $feed->query('//item') ) {
my $node = $i->query('title');
print ' '.$node->text_content;
print "\n";
}
XML::RSS::Parser::Lite (Pure Perl):
use XML::RSS::Parser::Lite;
use LWP::Simple;
my $xml = get("http://url.to.rss");
my $rp = new XML::RSS::Parser::Lite;
$rp->parse($xml);
print join(' ', $rp->get('title'), $rp->get('url'), $rp->get('description')), "\n";
for (my $i = 0; $i < $rp->count(); $i++) {
my $it = $rp->get($i);
print join(' ', $it->get('title'), $it->get('url'), $it->get('description')), "\n";
}
dirtyRSS:
use dirtyRSS;
$tree = parse($in);
die("$tree\n") unless (ref $tree);
disptree($tree, 0);