I have this code:
use CGI;
use File::Basename;
use Image::Magick;
use Time::HiRes qw(gettimeofday);
my $query = new CGI;
my $upload_dir = "../images"; #location on our server
my $filename=$query->param("img");
my $timestamp = int (gettimeofday * 1000);
my ( $name, $path, $extension ) = fileparse ( $filename, '\..*' );
$filename = $name ."_".$timestamp. $extension;
#upload the image
my $upload_filehandle =$query->param("img");
open ( UPLOADFILE, ">$upload_dir/$filename" ) or die "$!";
binmode UPLOADFILE;
while ( <$upload_filehandle> )
{
print UPLOADFILE;
}
close UPLOADFILE;
Then I do resize for the image. My problem is that the image is not uploaded. I have an empty file having the name of $filename. I omitted the part related to resize and I still have the code. So I'm sure that the file is not being uploaded correctly. Am I missing any library?
Any help?Plz..
You need to change
my $upload_filehandle =$query->param("img");
to
my $upload_filehandle =$query->upload("img");
according to this tutorial.
Hope it helps.
I figured out why: As pointed out in the CGI.pm docs, the form's encoding type must be multipart/form-data. When I added that, everything worked.
added this "ENCTYPE='multipart/form-data'" instead of encoding.
> <form action="/post.pl" method="post" ENCTYPE='multipart/form-data'>
and it worked
Related
I am getting a "csv file" from a vendor (using their API), but what they do is just spew the whole thing into their response. It wouldn't be a significant problem except that, of course, some of those pesky humans entered the data and put in "features" like line breaks. What I am doing now is creating a file for the raw data and then reopening it to read the data:
open RAW, ">", "$rawfile" or die "ERROR: Could not open $rawfile for write: $! \n";
print RAW $response->content;
close RAW;
my $csv = Text::CSV_XS->new({ binary=>1,always_quote=>1,eol=>$/ });
open my $fh, "<", "$rawfile" or die "ERROR: Could not open $rawfile for read: $! \n";
while ( $line = $csv->getline ($fh) ) { ...
Somehow this seems ... inelegant. It seems that I ought to be able to just read the data from the $response->content (multiline string) as if it were a file. But I'm drawing a total blank on how do this.
A pointer would be greatly appreciated.
Thanks,
Paul
You could use a string filehandle:
my $data = $response->content;
open my $fh, "<", \$data or croak "unable to open string filehandle : $!";
my $csv = Text::CSV_XS->new({ binary=>1,always_quote=>1,eol=>$/ });
while ( $line = $csv->getline ($fh) ) { ... }
Yes, you can use Text::CSV_XS on a string, via its functional interface
use warnings;
use strict;
use feature 'say';
use Text::CSV_XS qw(csv); # must use _XS version
my $csv = qq(a,line\nand,another);
my $aoa = csv(in => \$csv)
or die Text::CSV->error_diag;
say "#$_" for #aoa;
Note that this indeed needs Text::CSV_XS (normally Text::CSV works but not with this).
I don't know why this isn't available in the OO interface (or perhaps is but is not documented).
While the above parses the string directly as asked, one can also lessen the "inelegant" aspect in your example by writing content directly to a file as it's acquired, what most libraries support like with :content_file option in LWP::UserAgent::get method.
Let me also note that most of the time you want the library to decode content, so for LWP::UA to use decoded_content (see HTTP::Response).
I cooked up this example with Mojo::UserAgent. For the CSV input I used various data sets from the NYC Open Data. This is also going to appear in the next update for Mojo Web Clients.
I build the request without making the request right away, and that gives me the transaction object, $tx. I can then replace the read event so I can immediately send the lines into Text::CSV_XS:
#!perl
use v5.10;
use Mojo::UserAgent;
my $ua = Mojo::UserAgent->new;
my $url = ...;
my $tx = $ua->build_tx( GET => $url );
$tx->res->content->unsubscribe('read')->on(read => sub {
state $csv = do {
require Text::CSV_XS;
Text::CSV_XS->new;
};
state $buffer;
state $reader = do {
open my $r, '<:encoding(UTF-8)', \$buffer;
$r;
};
my ($content, $bytes) = #_;
$buffer .= $bytes;
while (my $row = $csv->getline($reader) ) {
say join ':', $row->#[2,4];
}
});
$tx = $ua->start($tx);
That's not as nice as I'd like it to be because all the data still show up in the buffer. This is slightly more appealing, but it's fragile in the ways I note in the comments. I'm too lazy at the moment to make it any better because that gets hairy very quickly as you figure out when you have enough data to process a record. My particular code isn't as important as the idea that you can do whatever you like as the transactor reads data and passes it into the content handler:
use v5.10;
use strict;
use warnings;
use feature qw(signatures);
no warnings qw(experimental::signatures);
use Mojo::UserAgent;
my $ua = Mojo::UserAgent->new;
my $url = ...;
my $tx = $ua->build_tx( GET => $url );
$tx->res->content
->unsubscribe('read')
->on( read => process_bytes_factory() );
$tx = $ua->start($tx);
sub process_bytes_factory {
return sub ( $content, $bytes ) {
state $csv = do {
require Text::CSV_XS;
Text::CSV_XS->new( { decode_utf8 => 1 } );
};
state $buffer = '';
state $line_no = 0;
$buffer .= $bytes;
# fragile if the entire content does not end in a
# newline (or whatever the line ending is)
my $last_line_incomplete = $buffer !~ /\n\z/;
# will not work if the format allows embedded newlines
my #lines = split /\n/, $buffer;
$buffer = pop #lines if $last_line_incomplete;
foreach my $line ( #lines ) {
my $status = $csv->parse($line);
my #row = $csv->fields;
say join ':', $line_no++, #row[2,4];
}
};
}
I am using HTML::TagTree as it seems to create the html file for table easily. I want to add html links to the text within some cells.
From the documentation provided here, I am not able to get a clear answer about how to add a new tag for the text inside a cell. Here's my code.
Main line to focus on: $new_row->td($1,'style=text-align:center','a:href="second_page.html"')
I don't think I clearly understand how to add more tags and attributes. Can someone please help?
#!/usr/bin/env perl
use strict;
use warnings;
use HTML::TagTree;
my $filename = 'list.txt';
my $html = HTML::TagTree->new('html'); # Define the top of the tree of objects.
my $head = $html->head(); # Put a 'head' branch on the tree.
my $body = $html->body(); # Put a 'body' branch on the tree
$head->title("Report");
$head->meta('', 'name=author CONTENT="xxx"');
$body->div->h1('Main page name'); # Example of method chaining to create
# a long branch.
my $table = $body->table('', 'width=100% border=1');
my $row1 = $table->tr();
$row1->td('Feature Code','style=background-color:khaki;text-align:center');
$row1->td('Feature Name','style=background-color:khaki;text-align:center');
$row1->td('% completed','style=background-color:khaki;text-align:center');
open(my $fh, '<', $filename)
or die "Could not open file '$filename' $!";
while (my $row = <$fh>){
if($row =~ m/([.\d]+): (.+)/){
my $new_row = $table->tr();
$new_row->td($1,'style=text-align:center','a:href="page_for_each_item.html"');
$new_row->td($2);
}
}
# Print to STDOUT the actual HTML representation of the tree
$html->print_html();
After some tries I think I found one way of doing it:
my $new_row = $table->tr();
my $text = $html->object();
$text->a($original_text,"href=second_page.html");
$new_row->td($text,'style=text-align:center');
To extract links from HTML pages use the code:
#!/usr/bin/perl
use warnings;
use strict;
use XML::LibXML;
open( SITE, "< index.html" );
my $html = <SITE>; # load the HTML file
my $content = 'XML::LibXML'->load_html(string => "index.html", recover => 1);
my #del = qw( Contact Tables );
my $condition = join ' or ', map "text()='$_'", #del;
for my $anch ($content->findnodes("//a[$condition]/..")) {
$anch->parentNode->removeChild($anch);
}
open (NOTEPAD, ">> index.html");
print NOTEPAD "$content";
close(NOTEPAD);
My problem is use the $file variable to read the contents of HTML page, it not work.
If I use the HTML tags inside the $file variable it works. But not is solution.
You can use WWW::Mechanize; to accomplish your task.
my $mech = WWW::Mechanize->new();
$mech->get( $url ); #url to extract links
my #links = $mech->links();
foreach my $link (#links) {
my $curr_url = $link->url_abs;
}
For complete documentation of this module refer WWW::Mechaniize
You can use Mojo::DOM (part of Mojolicious) which allows you to use CSS selectors, which I feel is a much better approach;
use Mojo::DOM;
use Mojo::File qw( path );
my $dom = Mojo::DOM->new( path('index.html')->slurp );
foreach ( $dom->find('a')->each ) {
# Do something with $_
}
my $html = $dom->to_string;
Your program opens file index.html, reads one line of it into $html, and then tries to parse the string index.html as if it were HTML data
Forget about opening and reading the file; you can get XML::LibXML to do all of that for you, with
my $content = XML::LibXML->load_html( location => 'index.html', recover => 1 );
I'm trying to automate hotmail login. How can I find what the appropriate fields are? When I print the forms I just get a bunch of hex information.
what's the correct method and how is it used?
use WWW::Mechanize;
use LWP::UserAgent;
my $mech = WWW::Mechanize->new();
my $url = "http://hotmail.com";
$mech->get($url);
print "Forms: $mech->forms";
if ($mech->success()){
print "Successful Connection\n";
} else {
print "Not a successful connection\n"; }
this may help you
use WWW::Mechanize;
use Data::Dumper;
my $mech = WWW::Mechanize->new();
my $url = "http://yoururl.com";
$mech->get($url);
my #forms = $mech->forms;
foreach my $form (#forms) {
my #inputfields = $form->param;
print Dumper \#inputfields;
}
Sometimes it is useful to look at what the web site is asking in advance of coding up a reader or interface to it.
I wrote this bookmarklet that you save in your browser bookmarks and when you click it while visiting any html web page will show in a pop-up all the forms actions and fields with values even hidden. Simply copy the text below and paste into a new bookmark location field, name it and save.
javascript:t=%22<TABLE%20BORDER='1'%20BGCOLOR='#B5D1E8'>%22;for(i=0;i<document.forms.length;i++){t+=%22<TR><TH%20colspan='4'%20align='left'%20BGCOLOR='#336699'>%22;t+=%22<FONT%20color='#FFFFFF'>%20Form%20Name:%20%22;t+=document.forms[i].name;t+=%22</FONT></TH></TR>%22;t+=%22<TR><TH%20colspan='4'%20align='left'%20BGCOLOR='#99BADD'>%22;t+=%22<FONT%20color='#FFFFFF'>%20Form%20Action:%20%22;t+=document.forms[i].action;t+=%22</FONT></TH></TR>%22;t+=%22<TR><TH%20colspan='4'%20align='left'%20BGCOLOR='#99BADD'>%22;t+=%22<FONT%20color='#FFFFFF'>%20Form%20onSubmit:%20%22;t+=document.forms[i].onSubmit;t+=%22</FONT></TH></TR>%22;t+=%22<TR><TH>ID:</TH><TH>Element%20Name:</TH><TH>Type:</TH><TH>Value:</TH></TR>%22;for(j=0;j<document.forms[i].elements.length;j++){t+=%22<TR%20BGCOLOR='#FFFFFF'><TD%20align='right'>%22;t+=document.forms[i].elements[j].id;t+=%22</TD><TD%20align='right'>%22;t+=document.forms[i].elements[j].name;t+=%22</TD><TD%20align='left'>%20%22;t+=document.forms[i].elements[j].type;t+=%22</TD><TD%20align='left'>%20%22;if((document.forms[i].elements[j].type==%22select-one%22)%20||%20(document.forms[i].elements[j].type==%22select-multiple%22)){t_b=%22%22;for(k=0;k<document.forms[i].elements[j].options.length;k++){if(document.forms[i].elements[j].options[k].selected){t_b+=document.forms[i].elements[j].options[k].value;t_b%20+=%20%22%20/%20%22;t_b+=document.forms[i].elements[j].options[k].text;t_b+=%22%20%22;}}t+=t_b;}else%20if%20(document.forms[i].elements[j].type==%22checkbox%22){if(document.forms[i].elements[j].checked==true){t+=%22True%22;}else{t+=%22False%22;}}else%20if(document.forms[i].elements[j].type%20==%20%22radio%22){if(document.forms[i].elements[j].checked%20==%20true){t+=document.forms[i].elements[j].value%20+%20%22%20-%20CHECKED%22;}else{t+=document.forms[i].elements[j].value;}}else{t+=document.forms[i].elements[j].value;}t+=%22</TD></TR>%22;}}t+=%22</TABLE>%22;mA='menubar=yes,scrollbars=yes,resizable=yes,height=800,width=600,alwaysRaised=yes';nW=window.open(%22/empty.html%22,%22Display_Vars%22,%20mA);nW.document.write(t);
I tried to mimc the post request that sends your login info, but the web site seems to be dynamically adding a bunch of id's ---long generated strings etc to the url and I couldn't figure out how to imitate them. So I wrote the hacky work-around below.
#!/usr/bin/perl
use strict;
use warnings;
use WWW::Curl::Easy;
use Data::Dumper;
my $curl = WWW::Curl::Easy->new;
#this is the name and complete path to the new html file we will create
my $new_html_file = 'XXXXXXXXX';
my $password = 'XXXXXXXX';
my $login = 'XXXXXXXXX';
#escape the .
$login =~ s/\./\\./g;
my $html_to_insert = qq(<script src="//ajax.googleapis.com/ajax/libs/jquery/2.0.0/jquery.min.js"></script><script type="text/javascript">setTimeout('testme()', 3400);function testme(){document.getElementById('res_box').innerHTML = '<h3 class="auto_click_login_np">Logging in...</h3>';document.f1.passwd.value = '$password';document.f1.login.value = '$login';\$("#idSIButton9").trigger("click");}var counter = 5;setInterval('countdown()', 1000);function countdown(){document.getElementById('res_box').innerHTML = '<h3 class="auto_click_login_np">You should be logged in within ' + counter + ' seconds</h3>';counter--;}</script><h2 style="background-color:#004c00; color: #fff; padding: 4px;" id="res_box" onclick="testme()" class="auto_click_login">If you are not logged in after a few seconds, click here.</h2>);
$curl->setopt(CURLOPT_HEADER,1);
my $url = 'https://login.live.com';
$curl->setopt(CURLOPT_URL, $url);
# A filehandle, reference to a scalar or reference to a typeglob can be used here.
my $response_body;
$curl->setopt(CURLOPT_WRITEDATA, \$response_body);
open( my $fresh_html_handle, '+>', 'fresh_html_from_login_page.html');
# Starts the actual request
my $curl_return_code = $curl->perform;
# Looking at the results...
if ($curl_return_code == 0) {
print("Transfer went ok\n");
my $response_code = $curl->getinfo(CURLINFO_HTTP_CODE);
# judge result and next action based on $response_code
print $fresh_html_handle $response_body;
} else {
# Error code, type of error, error message
print("An error happened: $curl_return_code ".$curl->strerror($curl_return_code)." ".$curl->errbuf."\n");
}
close($fresh_html_handle);
#erase whatever a pre-existing edited file if there is one
open my $erase_html_handle, ">", $new_html_file or die "Hork! $!\n";
print $erase_html_handle;
close $erase_html_handle;
#open the file with the login page html
open( FH, '<', 'fresh_html_from_login_page.html');
open( my $new_html_handle, '>>', $new_html_file);
my $tracker=0;
while( <FH> ){
if( $_ =~ /DOCTYPE/){
$tracker=1;
print $new_html_handle $_;
} elsif($_ =~ /<\/body><\/html>/){
#now add the javascript and html to automatically log the user in
print $new_html_handle "$html_to_insert\n$_";
}elsif( $tracker == 1){
print $new_html_handle $_;
}
}
close(FH);
close($new_html_handle);
my $sys_call_res = system("firefox file:///usr/bin/outlook_auto_login.html");
print "\n\nresult: $sys_call_res\n\n";
I am able to create my directory but I cannot seem to place the file in the directory.
#!/usr/bin/perl
use Cwd;
use CGI;
my $dir = getcwd();
print "Current Working Directory: $ dir\n";
my $photoDir = "$dir/MyPhotos";
mkdir $photoDir
or die "Cannot mkdir $photoDir: $!"
unless -d $photoDir;
my $query = new CGI;
my $filename = $query->param("Photo");
my $description = $query->param("description");
print "Current filename: $filename\n";
my ( $name, $path, $extension ) = fileparse ( $filename, '\..*' ); $filename = $name . $extension;
print $filename;
my $upload_filehandle = $query->upload("Photo");
open ( UPLOADFILE, ">$photoDir/$filename" )
or die "$!";
binmode UPLOADFILE;
while ( <$upload_filehandle> )
{ print UPLOADFILE; }
close UPLOADFILE;
The CGI stack trace shows no errors but the log shows there is no output
LOG: 5 5020-0:0:0:0:0:0:0:1%0-9: CGI output 0 bytes.
CGI.pm manual suggests this path to saving uploaded files. Try this additional check and write method and see if it helps.
$lightweight_fh = $q->upload('field_name');
# undef may be returned if it's not a valid file handle
if (defined $lightweight_fh) {
# Upgrade the handle to one compatible with IO::Handle:
my $io_handle = $lightweight_fh->handle;
open (OUTFILE,'>>','/usr/local/web/users/feedback');
while ($bytesread = $io_handle->read($buffer,1024)) {
print OUTFILE $buffer;
}
}
Also make sure you have your HTML form has required type like this: <form action=... method=post enctype="multipart/form-data">