I couldn't think of better keywords to Google this issue, so I apologize if this is a duplicate.
Here is my logout.pl script that basically erases cookie:
#!/usr/bin/perl -w
use strict;
use warnings;
use CGI;
my $q = new CGI;
print $q->header('text/html');
my $cookie = $q->cookie(
-name => 'CGISESSID',
-value => '',
-expires => '-1d'
);
print $q->header(-cookie=>$cookie);
print $q->redirect('welcome.pl');
exit;
When I run this script in a browser, it prints the following:
Set-Cookie: CGISESSID=; path=/; expires=Mon, 17-Feb-2014 09:05:42 GMT Date: Tue, 18 Feb 2014 09:05:42 GMT Content-Type: text/html; charset=ISO-8859-1 Status: 302 Found Location: welcome.pl
What I want, however, is for the browser to delete the cookie and redirect to welcome.pl.
When you print $q->header, that prints all the headers, including the blank line which signals the end of headers, making anything after it content. You need to only print $q->header once, no more.
There is actually one more problem you might not figure out on your own. The “clear” cookie you’re trying to send to expire the session must be sent with the redirect. The -w switch is not usually what you want, just the use warnings you have too. Also, redirect URLs RFC:MUST be absolute. "welcome.pl" will in most likelihood work but it’s not a good practice and I had relative URIs bite very badly in a modperl app once. So, amended–
#!/usr/bin/env perl
use strict;
use warnings;
use CGI;
use URI;
my $q = CGI->new;
my $cookie = $q->cookie(
-name => 'CGISESSID',
-value => '',
-expires => '-1d'
);
my $welcome = URI->new_abs("welcome.pl", $q->url);
print $q->redirect( -uri => $welcome,
-cookie => $cookie,
-status => 302 );
exit;
You should use $q->header only once in your script and that should be before using anything printable on page
Related
I am using the following script, which takes as input a HTML page obtained from this url :
http://omim.org/entry/600185
use HTML::TableExtract;
my $doc = 'OMIM_2.htm';
my $headers = [ 'Phenotype', 'Inheritance' ];
my $table_extract = HTML::TableExtract->new(headers => $headers);
$table_extract->parse_file($doc);
my ($table) = $table_extract->tables;
for my $row ($table->rows) {
foreach $info (#$row) {
if ($info =~ m/(\S+)/) {
$info =~ s/^\s+(.+)\s+$/$1/;
print $info."\t";
}
}
print "\n";
}
It does what I want, thus extracting the "Phenotype" and "Inheritance" fields from the table.
Nevertheless, I would like to obtain this information directly from the URL, and I tried to modify the script :
use HTML::TableExtract;
my $doc = 'http://omim.org/entry/600185';
my $headers = [ 'Phenotype', 'Inheritance' ];
my $table_extract = HTML::TableExtract->new(headers => $headers);
$table_extract->parse($doc);
my ($table) = $table_extract->tables;
for my $row ($table->rows) {
foreach $info (#$row) {
if ($info =~ m/(\S+)/) {
$info =~ s/^\s+(.+)\s+$/$1/;
print $info."\t";
}
}
print "\n";
}
I certainly do a mistake because I obtained the following error :
Can't call method "rows" on an undefined value at Test_OMIM.perl line 11.
More intriguing, I also obtained this error if the file was called "OMIM_2.html" and no "OMIM_2.htm". Logical ?
Thanks by advance for your help.
You are giving HTML::TableExtract a URL when it wants to be given HTML. In order to download the HTML you would do this
use strict;
use warnings qw/ all FATAL /;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $response = $ua->get('http://omim.org/entry/600185');
my $html = $response->content;
print $html;
output
Your client was identified as a crawler.
Please note:
- The robots.txt files disallows the crawling of the site except to Google, Bing
and Yahoo crawlers.
- The raw data is available via FTP on the http://omim.org/downloads link on the site.
- We have an API you can learn about at http://omim.org/api and http://omim.org/help/api,
this provides access to the data in XML, JSON, Python and Ruby formats.
- You should feel free to contact us at http://omim.org/contact to figure the best
approach to getting the data you need.
Please note that you might have difficulties doing this, as omim.org does not want you to download the HTML automatically, but wants you to use the raw-data or API. This is their robots.txt document, which all automated software is supposed to read and comply with voluntarily
Here is my code. I get an internal server error with this. The subroutine is a clone from a book. So it is good to go. I just cannot get these tables to be on the screen by the time I look at the site. Is there anything that you guys see I am doing wrong?
#!/usr/bin/perl -T
use 5.010;
use DBI; #this is for database connections.
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser);
#my $driver = "mysql";
my $database = "myown";
my $hostname = "whereitis";
my $dsn = "longblabla";
my $userid = "memyselfandI";
my $password = "onlymetoknow";
my $page1 = "Tables in the database: " . $database;
my $dbh = DBI->connect( $dsn, $userid, $password ) or die $DBI::errstr;
print
header,
start_html(
-title => $page1,
-meta => {
'viewport' => 'width=device-width, initial-scale=1',
'copyright' => 'copyright 2015 Noel Villaman'
},
-style => [
{ -src => 'bootstrap.min.css' },
{ -src => 'cgicssjs/style1.css' }
]
),
h1( $page1 ),
div( table_names( $dbh->table_info() ) ),
hr,
"\n";
# Disconnect from the database.
$dbh->disconnect();
print end_html;
sub table_names {
my $names = $_[0];
### Create a new statement handle to fetch table information
my $tabsth = $names; #$dbh->table_info();
### Print the header
print "<h1>Table Name</h1>";
print "<h3>===============</h3>";
### Iterate through all the tables...
while ( my ( $qual, $owner, $name, $type, $remarks ) = $tabsth->fetchrow_array() ) {
### Tidy up NULL fields
foreach ( $qual, $owner, $name, $type, $remarks ) {
$_ = "N/A" unless defined $_;
}
### Print out the table metadata...
print "<h3>$name</h3>";
}
exit;
}
In a comment, you say that you don't think that you can see the web server error log. It is ridiculous to try to develop a CGI program without access to the server error log. You should try to get that fixed as a matter of urgency.
But in the mean time, you can work round this restriction by adding the following near the top of your code.
use CGI::Carp 'fatalsToBrowser';
That will copy the error log messages to your browser so you can see them. But remember to remove or comment out that line before the code goes into production (not that this code will ever go into production in any meaningful way - I realise it's homework).
While you're editing that part of your code, also add:
use strict;
use warnings;
You should add these lines to every Perl program you write and fix all the errors and warnings that they give you.
So what's the problem with this code? I suspect that running it from the browser, you'll get an error about there being no CGI header line. That's because you exit() the program from the end of your table_names() subroutine. So the program never gets back from calling the table_names() subroutine and your main print() statement never gets executed - and that includes the header().
Also, in your main print() statement, you print the value returned from table_names(). But table_names() doesn't return anything. You need to change the logic in table_names() so that it returns the HTML it creates rather than printing it directly. Printing it directly will put it in the wrong place in the output stream.
One other point that I don't expect you're in any position to do anything about... CGI is pretty much a dead technology. This course is teaching you stuff that would have been useful fifteen years ago. Perhaps you could point your teacher at CGI::Alternatives and ask if he or she would consider teaching something that is more relevant to how web development is done today.
Update: The simplest fix is probably to split up your print statement so that things happen in the right order.
# Print all the start page stuff
print
header,
start_html(
-title => $page1,
-meta => {
'viewport' => 'width=device-width, initial-scale=1',
'copyright' => 'copyright 2015 Noel Villaman'
},
-style => [
{ -src => 'bootstrap.min.css' },
{ -src => 'cgicssjs/style1.css' }
]
),
h1( $page1 );
# No need to call print here as table_names
# does its own printing
table_names( $dbh->table_info() );
# Print all the end of page stuff.
print
hr,
"\n";
You'll still need to remove the exit() from the end of table_names, otherwise the program will never return from that subroutine.
Also, by doing this you lose a <div> around the output from table_names. Fixing that is left as an exercise for the reader.
I am having an issue with Json RPC and mod_perl. I am trying to return a value from a cgi script which is running in Apache through mod_perl. But in the return value, following apache headers are automatically added and therefore I am not able to access the return value from my client script.
Status: 200
Content-Type: application/json; charset=UTF-8
In my Apache configuration file I have following directives.
LoadModule perl_module modules/mod_perl.so
PerlSwitches -w
PerlSwitches -T
Alias /perl /var/www/html/perl
<Directory /var/www/html/perl>
SetHandler perl-script
PerlResponseHandler ModPerl::Registry
Options +ExecCGI
</Directory>
My cgi script is pasted below.
#!/usr/bin/perl
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use JSON::RPC::Server::CGI;
use strict;
use Data::Dumper;
my $server = JSON::RPC::Server::CGI->new;
$server->dispatch('Myapp')->handle();
The Myapp.pm is
#!/usr/bin/perl
package Myapp;
use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than
use strict;
use Data::Dumper;
sub test : Public(u1:str){
my ($s, $obj) = #_;
my $u1 = $obj->{u1};
return $u1;
}
1;
My client side script is
#!/usr/bin/perl
use JSON::RPC::Client;
use Data::Dumper;
my $client = new JSON::RPC::Client;
my $uri = 'http://IP/perl/test.cgi';
$client->prepare($uri, ['test']);
$str= $client->test('testing');
print "$str\n\n";
In normal case the output should be testing . But in my case I am getting the below error.
malformed JSON string, neither array, object, number, string or atom, at character offset 0 (before "Status: 200\r\nConte...") at /usr/local/share/perl5/JSON/RPC/Client.pm line 186
The issue is because some http headers are automatically get added to the return value. Is there any way to suppress these headers?
Note: Kindly don't recommend normal cgi scripts or running perl script as daemon because it is already working and tested from my end. We are using mod_perl for high performance.
I have a Perl script that reads in data from a database and prints out the result in HTML forms/tables. The form of each book also contains a submit button.
I want Perl to create a text file (or read into one already created) and print the title of the book that was inside the form submitted. But I can't seem to get param() to catch the submit action!
#!/usr/bin/perl -w
use warnings; # Allow for warnings to be sent if error's occur
use CGI; # Include CGI.pm module
use DBI;
use DBD::mysql; # Database data will come from mysql
my $dbh = DBI->connect('DBI:mysql:name?book_store', 'name', 'password')
or die("Could not make connection to database: $DBI::errstr"); # connect to the database with address and pass or return error
my $q = new CGI; # CGI object for basic stuff
my $ip = $q->remote_host(); # Get the user's ip
my $term = $q->param('searchterm'); # Set the search char to $term
$term =~ tr/A-Z/a-z/; # set all characters to lowercase for convenience of search
my $sql = '
SELECT *
FROM Books
WHERE Title LIKE ?
OR Description LIKE ?
OR Author LIKE ?
'; # Set the query string to search the database
my $sth = $dbh->prepare($sql); # Prepare to connect to the database
$sth->execute("%$term%", "%$term%", "%$term%")
or die "SQL Error: $DBI::errstr\n"; # Connect to the database or return an error
print $q->header;
print "<html>";
print "<body>";
print " <form name='book' action='bookcart.php' method=post> "; # Open a form for submitting the result of book selection
print "<table width=\"100%\" border=\"0\"> ";
my $title = $data[0];
my $desc = $data[1];
my $author = $data[2];
my $pub = $data[3];
my $isbn = $data[4];
my $photo = $data[5];
print "<tr> <td width=50%>Title: $title</td> <td width=50% rowspan=5><img src=$photo height=300px></td></tr><tr><td>Discreption Tags: $desc</td></tr><tr><td>Publication Date: $pub</td></tr><tr><td>Author: $author</td></tr><tr><td>ISBN: $isbn</td> </tr></table> <br>";
print "Add this to shopping cart:<input type='submit' name='submit' value='Add'>";
if ($q->param('submit')) {
open(FILE, ">>'$ip'.txt");
print FILE "$title\n";
close(FILE);
}
print "</form>"; # Close the form for submitting to shopping cart
You haven't used use strict, to force you to declare all your variables. This is a bad idea
You have used remote_host, which is the name of the client host system. Your server may not be able to resolve this value, in which case it will remain unset. If you want the IP address, use remote_addr
You have prepared and executed your SQL statement but have fetched no data from the query. You appear to expect the results to be in the array #data, but you haven't declared this array. You would have been told about this had you had use strict in effect
You have used the string '$ip'.txt for your file names so, if you were correctly using the IP address in stead of the host name, your files would look like '92.17.182.165'.txt. Do you really want the single quotes in there?
You don't check the status of your open call, so you have no idea whether the open succeeded, or the reason why it may have failed
I doubt if you have really spent the last 48 hours coding this. I think it is much more likely that you are throwing something together in a rush at the last minute, and using Stack Overflow to help you out of the hole you have dug for yourself.
Before asking for the aid of others you should at least use minimal good-practice coding methods such as applying use strict. You should also try your best to debug your code: it would have taken very little to find that $ip has the wrong value and #data is empty.
Use strict and warnings. You want to use strict for many reasons. A decent article on this is over at perlmonks, you can begin with this. Using strict and warnings
You don't necessarily need the following line, you are using DBI and can access mysql strictly with DBI.
use DBD::mysql;
Many of options are available with CGI, I would recommend reading the perldoc on this also based on user preferences and desired wants and needs.
I would not use the following:
my $q = new CGI;
# I would use as so..
my $q = CGI->new;
Use remote_addr instead of remote_host to retrieve your ip address.
The following line you are converting all uppercase to lowercase, unless it's a need to specifically read from your database with all lowercase, I find this useless.
$term =~ tr/A-Z/a-z/;
Next your $sql line, again user preference, but I would look into sprintf or using it directly inside your calls. Also you are trying to read an array of data that does not exist, where is the call to get back your data? I recommend reading the documentation for DBI also, many methods of returning your data. So you want your data back using an array for example...
Here is an untested example and hint to help get you started.
use strict;
use warnings;
use CGI qw( :standard );
use CGI::Carp qw( fatalsToBrowser ); # Track your syntax errors
use DBI;
# Get IP Address
my $ip = $ENV{'REMOTE_ADDR'};
# Get your query from param,
# I would also parse your data here
my $term = param('searchterm') || undef;
my $dbh = DBI->connect('DBI:mysql:db:host', 'user', 'pass',
{RaiseError => 1}) or die $DBI::errstr;
my $sql = sprintf ('SELECT * FROM Books WHERE Title LIKE %s
OR Description LIKE %s', $term, $term);
my $sth = $dbh->selectall_arrayref( $sql );
# Retrieve your result data from array ref and turn into
# a hash that has title for the key and a array ref to the data.
my %rows = ();
for my $i ( 0..$#{$sth} ) {
my ($title, $desc, $author, $pub, $isbn, $pic) = #{$sth->[$i]};
$rows{$title} = [ $desc, $author, $pub, $isbn, $pic ];
}
# Storing your table/column names
# in an array for mapping later.
my #cols;
$cols[0] = Tr(th('Title'), th('Desc'), th('Author'),
th('Published'), th('ISBN'), th('Photo'));
foreach (keys %rows) {
push #cols, Tr( td($_),
td($rows{$_}->[0]),
td($rows{$_}->[1]),
td($rows{$_}->[2]),
td($rows{$_}->[3]),
td(img({-src => $rows{$_}->[4]}));
}
print header,
start_html(-title => 'Example'),
start_form(-method => 'POST', -action => 'bookcart.php'), "\n",
table( {-border => undef, -width => '100%'}, #cols ),
submit(-name => 'Submit', -value => 'Add Entry'),
end_form,
end_html;
# Do something with if submit is clicked..
if ( param('Submit') ) {
......
}
This assumes that you're using the OO approach to CGI.pm, and that $q is the relevant object. This should work, assuming that you have $q = new CGI somewhere in your script.
Can you post the rest of the script?
I've created a mockup to test this, and it works as expected:
#!/usr/bin/perl
use CGI;
my $q = new CGI;
print $q->header;
print "<form><input type=submit name=submit value='add'></form>\n";
if ($q->param('submit')) {
print "submit is \"" . $q->param('submit') . "\"\n";
}
After the submit button is clicked, the page displays that submit is "add" which means the evaluation is going as planned.
I guess what you need to do is make sure that $q is your CGI object, and move forward from there.
I am trying to send an HTML email using Perl.
open(MAIL,"|/usr/sbin/sendmail -t");
## Mail Header
print MAIL "To: $to\n";
print MAIL "From: $from\n";
print MAIL "Subject: $subject\n\n";
## Mail Body
print MAIL "Content-Type: text/html; charset=ISO-8859-1\n\n"
. "<html><head></head><body>#emailBody";
close(MAIL)
Is that the correct way of doing it? It is not working for some reason. Thanks for your help.
Start with Email::Sender::Simple or Email::Sender.
There is a quickstart guide in CPAN, and Ricardo wrote a good use-me in his 2009 advent calendar
From the quickstart guide:
use strict;
use Email::Sender::Simple qw(sendmail);
use Email::Simple;
use Email::Simple::Creator;
my $email = Email::Simple->create(
header => [
To => '"Xavier Q. Ample" <x.ample#example.com>',
From => '"Bob Fishman" <orz#example.mil>',
Subject => "don't forget to *enjoy the sauce*",
'Content-Type' => 'text/html',
],
body => "<p>This message is short, but at least it's cheap.</p>",
);
sendmail($email);
The content type should be part of the mail header. Right now it's part of the mail body. The header is separated from the body by a double newline. So, removing the second newline after the subject header should fix the problem of content type not being correctly interpreted.
You should not really talk to sendmail directly via a pipe. Instead use a proper CPAN module.
Email::Sender is an example.
Mail::Sender has a specific guide on sending HTML messages
If you are just generating spewy emails and you don't need massive robustness or tweaking, you could always just take the shortcut way...
use Email::Stuff;
my $html = <<'END_HTML';
<html>
...
</html>
END_HTML
Email::Stuff->to('"Xavier Q. Ample" <x.ample#example.com>')
->from('"Bob Fishman" <orz#example.mil>')
->subject("Don't forget to *enjoy the sauce*")
->html_body($body)
->send;
Using html tag "pre" will be a simple way to send the script
output in HTML email.
open(MAIL, "|/usr/sbin/sendmail -t");
print MAIL "To: $EMAIL\n";
print MAIL "From: $FROM\n";
print MAIL "Subject: $SUBJECT";
print MAIL "Content-Type: text/html; charset=ISO-8859-1\n\n";
print MAIL < pre >\n$mailoutput< /pre >\n;
close(MAIL);
That will allow you to do all the formating in your script and will
get the same output in email as on screen. [ as you know make sure
no space before and after "pre" ]
I had a problem when sending a MIME multipart message from Perl using sendmail.
After a couple several hours of frustration I found that the entire message
needed to be in a variable with at single statement to send the message
to sendmail. So for example, if your message is contained completely in
a variable called $email_msg, sending the message through sendmail would look
like:
$mailprog = '/usr/sbin/sendmail';
open(MAIL,"|$mailprog -t");
print MAIL $email_msg;
close MAIL;
This works, while using many "print MAIL "message contents"" does not
seem to send a mail message that some mail readers can handle as expected.
This is using Perl 5.8.8 on a CentOS server.
You can use Email::MIME
my $message = Email::MIME->create(
header_str => [
From => 'no-reply#example.com',
To => $address,
Subject => encode_mimewords($subject,
Charset => 'utf-8', Encoding => 'B'),
'Content-Type' => 'text/html',
],
attributes => {
encoding => 'base64',
charset => 'UTF-8',
},
body_str => $message_body,
);
sendmail($message);