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.
Related
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;
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;
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)
#!/usr/bin/perl
#Author Leo
use Email::Address;
#use strict;
my $file = "/var/log/maillog";
my $string="msgif";
open(MAIL, $file);
my #buffer =<MAIL>;
close(MAIL);
my $lines=grep(/$string/, #buffer);
#print "#lines";
my #addresses = Email::Address->parse($lines);
print $addresses[0]->address;
This is my code. I am new to perl I want to know how I can use Email::Address to parse lines in a file and then get the email address.
Untested:
#!/usr/bin/perl
use warnings;
use strict;
use Email::Address;
open(my $fh, '<', '/var/log/maillog')
or die "Cannot open /var/log/maillog: $!";
while (<$fh>) {
next unless /msgif/;
my #addrs = Email::Address->parse($_);
foreach my $addr (#addrs) {
print "$addr\n";
}
}
close($fh);
Another idea using File::Slurp and Email::Find. You can define your search and implement it into this.
use strict;
use warnings;
use Email::Find;
use File::Slurp;
my #addresses;
my $wanted = Email::Find->new(
sub {
my ($email, $old) = #_;
push #addresses, $email->format;
});
my $data = read_file('/var/log/maillog');
$wanted->find(\$data);
print join("\n", #addresses);
Or you can use Regular expression to parse the email ..
I have one folder that contains more number of xml files and extract some specific information form xml files. I used libxml to extract wanted information one xml and I succeded but now how can I extract from folder and each xml file using perl script. I tried like this for one xml file:
use warnings;
use strict;
use XML::LibXML::Reader;
my $file;
open( $file, 'formal.xml');
my $reader = XML::LibXML::Reader->new( IO => $file )
or die ("unable to open file");
my %hash;
while ($reader->nextElement( 'nuber' ) ) {
my $Number = $reader->readInnerXml();
$reader->nextElement( 'data' );
my $information = $reader->readOuterXml();
$nums{$Number}= $information;
print( " NUMBER:$Number\n" );
print( " Information:$information\n" );
}
print my $num=keys%hash;
close($file);
Above code working properly and extracted what I want. Now I need script that will search all files in the folder and extract the same information from all files.
use File::Find.
Your code cannot be working properly as it is. Here is an untested script that might do what you want.
use warnings; use strict;
use Carp;
use File::Find;
use File::Spec::Functions qw( canonpath );
use XML::LibXML::Reader;
die "Need directories\n" unless #ARGV;
my %hash;
find(
sub {
my $file = $_;
my $path = canonpath $File::Find::name;
return unless -f $path;
return unless $file =~ /[.]xml\z/i;
extract_information($path, \%hash);
return;
},
#ARGV
);
use Data::Dumper;
print Dumper \%hash;
sub extract_information {
my ($path, $hash) = #_;
my $ret = open my $xmlin, '<', $path;
unless ($ret) {
carp "Cannot open '$path': $!";
return;
}
my $reader = XML::LibXML::Reader->new(IO => $xmlin);
unless ($reader) {
carp "Cannot create reader using '$path'";
return;
}
while ($reader->nextElement('number')) {
my $Number = $reader->readInnerXml();
$reader->nextElement( 'data' );
my $information = $reader->readOuterXml();
$hash->{$path}{$Number} = $information;
}
close $xmlin
or carp "Cannot close '$path': $!";
return;
}