I have 2 functions that generates simple HTML output
sub one_data {}
sub generate_page {}
The generate_page is the 'meat and potatoes' which generates all of the content, however the one_data{} function generates a small amount of html (divs, etc)
I am trying to add it to a section of code that generate_page does, something like this, ie:
$npage .= sprintf "<div class=sidepage>%s</div>", &one_data();
That doesn't seem to accomplish what I'm doing even though one_data is a simple string (in theory it should work per perldoc sprintf.
I've also tried this, ie:
my $data = &one_data();
$npage .= sprintf "<div class=whatever>%s</div>", $data;
But the format modifier "%s" only contains the number 1 at all times.
One_data /does/ work, as I've moved it into a simple perl script and it displays the required html output.
Your one_data sub should use an explicit return statement:
use warnings;
use strict;
my $npage .= sprintf "<div class=sidepage>%s</div>", one_data();
print "$npage\n";
sub one_data {
return 'foooo';
}
__END__
<div class=sidepage>foooo</div>
If your sub uses print instead of return, the value returned by the sub will be 1 (assuming the print was successful). See also perldoc perlsub.
Fixed this by adding an artificial sleep into the function, as it was returning too early/timing out.
Related
I have a Perl CGI script for online concordance application that searches for an instance of word in a text and prints the sorted output.
#!/usr/bin/perl -wT
# middle.pl - a simple concordance
# require
use strict;
use diagnostics;
use CGI;
# ensure all fatals go to browser during debugging and set-up
# comment this BEGIN block out on production code for security
BEGIN {
$|=1;
print "Content-type: text/html\n\n";
use CGI::Carp('fatalsToBrowser');
}
# sanity check
my $q = new CGI;
my $target = $q->param("keyword");
my $radius = $q->param("span");
my $ordinal = $q->param("ord");
my $width = 2*$radius;
my $file = 'concordanceText.txt';
if ( ! $file or ! $target ) {
print "Usage: $0 <file> <target>\n";
exit;
}
# initialize
my $count = 0;
my #lines = ();
$/ = ""; # Paragraph read mode
# open the file, and process each line in it
open(FILE, " < $file") or die("Can not open $file ($!).\n");
while(<FILE>){
# re-initialize
my $extract = '';
# normalize the data
chomp;
s/\n/ /g; # Replace new lines with spaces
s/\b--\b/ -- /g; # Add spaces around dashes
# process each item if the target is found
while ( $_ =~ /\b$target\b/gi ){
# find start position
my $match = $1;
my $pos = pos;
my $start = $pos - $radius - length($match);
# extract the snippets
if ($start < 0){
$extract = substr($_, 0, $width+$start+length($match));
$extract = (" " x -$start) . $extract;
}else{
$extract = substr($_, $start, $width+length($match));
my $deficit = $width+length($match) - length($extract);
if ($deficit > 0) {
$extract .= (" " x $deficit);
}
}
# add the extracted text to the list of lines, and increment
$lines[$count] = $extract;
++$count;
}
}
sub removePunctuation {
my $string = $_[0];
$string = lc($string); # Convert to lowercase
$string =~ s/[^-a-z ]//g; # Remove non-aplhabetic characters
$string =~ s/--+/ /g; #Remove 2+ hyphens with a space
$string =~s/-//g; # Remove hyphens
$string =~ s/\s=/ /g;
return($string);
}
sub onLeft {
#USAGE: $word = onLeft($string, $radius, $ordinal);
my $left = substr($_[0], 0, $_[1]);
$left = removePunctuation($left);
my #word = split(/\s+/, $left);
return($word[-$_[2]]);
}
sub byLeftWords {
my $left_a = onLeft($a, $radius, $ordinal);
my $left_b = onLeft($b, $radius, $ordinal);
lc($left_a) cmp lc($left_b);
}
# process each line in the list of lines
print "Content-type: text/plain\n\n";
my $line_number = 0;
foreach my $x (sort byLeftWords #lines){
++$line_number;
printf "%5d",$line_number;
print " $x\n\n";
}
# done
exit;
The perl script produces expected result in terminal (command line). But the CGI script for online application produces unexpected output. I cannot figure out what mistake I am making in the CGI script. The CGI script should ideally produce the same output as the command line script. Any suggestion would be very helpful.
Command Line Output
CGI Output
The BEGIN block executes before anything else and thus before
my $q = new CGI;
The output goes to the server process' stdout and not to the HTTP stream, so the default is text/plain as you can see in the CGI output.
After you solve that problem you'll find that the output still looks like a big ugly block because you need to format and send a valid HTML page, not just a big block of text. You cannot just dump a bunch of text to the browser and expect it to do anything intelligent with it. You must create a complete HTML page with tags to layout your content, probably with CSS as well.
In other words, the output required will be completely different from the output when writing only to the terminal. How to structure it is up to you, and explaining how to do that is out of scope for StackOverflow.
As the other answers state, the BEGIN block is executed at the very start of your program.
BEGIN {
$|=1;
print "Content-type: text/html\n\n";
use CGI::Carp('fatalsToBrowser');
}
There, you output an HTTP header Content-type: text/html\n\n. The browser sees that first, and treats all your output as HTML. But you only have text. Whitespace in an HTML page is collapsed into single spaces, so all your \n line breaks disappear.
Later, you print another header, the browser cannot see that as a header any more, because you already had one and finished it off with two newlines \n\n. It's now too late to switch back to text/plain.
It is perfectly fine to have a CGI program return text/plain and just have text without markup be displayed in a browser when all you want is text, and no colors or links or tables. For certain use cases this makes a lot of sense, even if it doesn't have the hyper in Hypertext any more. But you're not really doing that.
Your BEGIN block serves a purpose, but you are overdoing it. You're trying to make sure that when an error occurs, it gets nicely printed in the browser, so you don't need to deal with the server log while developing.
The CGI::Carp module and it's functionality fatalsToBrowser bring their own mechanism for that. You don't have to do it yourself.
You can safely remove the BEGIN block and just put your use CGI::CARP at the top of the script with all the other use statements. They all get run first anyway, because use gets run at compile time, while the rest of your code gets run at run time.
If you want, you can keep the $|++, which turns off the buffering for your STDOUT handle. It gets flushed immediately and every time you print something, that output goes directly to the browser instead of collecting until it's enough or there is a newline. If your process runs for a long time, this makes it easier for the user to see that stuff is happening, which is also useful in production.
The top of your program should look like this now.
#!/usr/bin/perl -T
# middle.pl - a simple concordance
use strict;
use warnigns;
use diagnostics;
use CGI;
use CGI::Carp('fatalsToBrowser');
$|=1;
my $q = CGI->new;
Finally, a a few quick words on the other parts I deleted from there.
Your comment requires over the use statements is misleading. Those are use, not require. As I said above, use gets run at compile time. require on the other hand gets run at run time and can be done conditionally. Misleading comments will make it harder for others (or you) to maintain your code later on.
I removed the -w flag from the shebang (#!/usr/bin/perl) and put the use warnings pragma in. That's a more modern way to turn on warnings, because sometimes the shebang can be ignored.
The use diagnostics pragma gives you extra long explanations when things go wrong. That's useful, but also extra slow. You can use it during development, but please remove it for production.
The comment sanity check should be moved down under the CGI instantiation.
Please use the invocation form of new to instantiate CGI, and any other classes. The -> syntax will take care of inheritance properly, while the old new CGI cannot do that.
I ran your cgi. The BEGIN block is run regardless and you print a content-type header here - you have explicitly asked for HTML here. Then later you attemp to print another header for PLAIN. This is why you can see the header text (that hasn't taken effect) at the beginning of the text in the browser window.
I'm trying to make a perl subroutine similar to this php function.
private function writeOutput($msg, $type) {
echo date("H\:i\:s") . " - [$type] . > $msg\n";
}
I need a little help defining $msg and $type.
sub WriteOutput {
$sec = sprintf ("%02d", $sum%60);
$mins = sprintf("%02d", ($sum%3600)/60);
$hrs = int($sum/3600);
print "[$hrs:$mins:$sec]:[$type]>: $msg";
}
As I understand, your question is about passing arguments to Perl subroutine.
Perl stores arguments passed to subroutine in special variable #_. Add following line at the beginning of your subroutine.
my ($msg, $type) = #_;
And call this subroutine with
writeOutput("test", "type1");
Bdw, I hope you're not trying to use global variables here, since my is missing.
Apart from that it's not clear what is $sum
Let's take a look at your PHP subroutine:
private function writeOutput($msg, $type) {
echo date("H\:i\:s") . " - [$type] . > $msg\n";
}
First, Perl doesn't have a builtin date formatter. Instead, you have to use a module to handle dates.
Also, you're taking two parameters in your function called $msg and $type. Perl doesn't use function parameters in the function call. Instead, you use shift:
use Time::Piece; # A nice way to handle datetime. Included since Perl 5.10
use feature qw(say); # Better than `print`. Included since Perl 5.10
sub write_output {
my $msg = shift;
my $type = shift;
my $time = Time::Piece->new(localtime);
say $time->hms . " - [$type] . > $msg";
}
The shift command is the standard way of taking your function's input parameters. Time::Piece is the standard Perl module for handling time since Perl 5.10. This is an object oriented module. The -> is similar to the dot in most other languages. The my $time = Time::Piece->new(localtime); creates a new Time::Piece object based upon the current time. The $time->hms uses the hms method to print out the time in HH:MM:SS format.
Note the use of my which declares and localizes variables (something that PHP doesn't really have). You should always have use strict; and use warnings; on all of your Perl programs. Then, you have to declare all of your variables with my.
Note in Perl, the standard way for variables is to use all lowercase and use underscores as separators. This is taken from Perl Best Practices by Damian Conway. You may or may not agree with all of Conway's coding standards, but one of the nice things about standard is that everyone uses them which makes working with other's people code so much nicer -- whether you like them or not.
For this function in PHP:
private function writeOutput($msg, $type) {
echo date("H\:i\:s") . " - [$type] . > $msg\n";
}
Perl offers the possibility to do the same thing:
use POSIX qw(strftime);
sub WriteOutput {
my($msg, $type) = #_;
my $date = strftime("[%H:%M:%S]", localtime);
print "$date:[$type]>: $msg";
}
WriteOutput "Ok", "Not OK?";
Gives:
[19:12:01][Not Ok?]>: Ok
I'd like to program a wrapper around printf(...).
My first attempt was:
sub printf2 {
my $test = sprintf(#_);
print $test;
}
As the array (in scalar context) isn't a format string, this doesn't work (as expected).
Does anyone know a solution? Probably without using any special packages?
EDIT: In the real context, I'd like to use sprintf. Apparently there is a difference between printf and sprintf.
The sprintf function has a ($#) prototype, so the first argument to sprintf is always evaluated in scalar context, even if it is an array.
$x = sprintf(#a); # same as sprintf(scalar #a)
So before you call sprintf, you need to separate the template from the rest of the arguments.
Here's a concise way:
sub printf2 {
my $test = sprintf(shift, #_);
print $test;
}
Curiously, printf doesn't have a prototype and does what you expect.
printf(#a); # same as printf($a[0], #a[1..$#a])
How about this
sub pf { printf $_[0],#_[1..$#_] }
Many of the named operators (such as sprintf) have special syntaxes. sprintf's syntax is defined to be
sprintf FORMAT, LIST
This can often (but not always) be seen using prototype.
>perl -wE"say prototype 'CORE::sprintf'"
$#
The problem is that you used one of the following syntaxes instead of the documented syntax.
sprintf ARRAY
sprintf LIST
Simply switch to the documented syntax to solve your problem.
sub printf2 {
my ($format, #args) = #_;
print sprintf($format, #args);
}
Or if you want to avoid the copying,
sub printf2 {
print sprintf($_[0], #_[ 1..$#_ ]);
}
I need to use some string replacement in Perl to ease translations, i.e. replace many
print "Outputting " . $n . " numbers";
by something like
printf ("Outputting %d numbers", $n);
However, I'd like to replace printf with something easier to parse for humans, like this:
printX ("Outputting {num} numbers", { num => $n });
or generally something more Perly.
Can you recommend something (from CPAN or not) you like and use?
What about simply:
print "Outputting $n numbers";
That's very Perly. If you don't need any kind of fancy formatting, string interpolation is definitely the way to go.
Most Templating modules on CPAN will probably do what you want. Here's an example using Template Toolkit...
use Template;
my $tt = Template->new;
$tt->process( \"Outputting [% num %] numbers\n", { num => 100 } );
And you can mimic your required example with something like this...
sub printX {
use Template;
my $tt = Template->new( START_TAG => '{', END_TAG => '}' );
$tt->process( \( $_[0] . "\n" ), $_[1] );
}
and you've got...
printX 'Outputting {num} numbers' => { num => 100 };
The print builtin is very convenient for most situations. Besides variable interpolation:
print "Outputting $n numbers"; # These two lines
print "Outputting ${n} numbers"; # are equivalent
Remember that print can take multiple arguments, so there is no need to concatenate them first into a single string if you need to print the result of a subroutine call:
print "Output data: ", Dumper($data);
However, for outputting numbers other than simple integers, you'll probably want the formatting convenience of printf. Outputting other data types is easy with print, though.
You can use join to conveniently output arrays:
print join ', ', #array;
And combine with map and keys to output hashes:
print join ', ', map {"$_ : $hash{$_}"} keys %hash;
Use the qq operator if you want to output quotes around the data:
print join ', ', map {qq("$_" : "$hash{$_}"}) keys %hash;
If you're looking to ease translations you should consider using one of the L10n/i18n CPAN modules that are available. Specifically, a good overview of why your approach will end up falling short is written up as part of the Local::Maketext docs.
Another great module that pairs nicely with Locale::Maketext is Locale::Maketext::Lexicon. This allows you to use more standard localization formats such as gettext's .po/.mo files which have GUI tools to help translators work through all the text that needs translating. Locale::Maketext::Lexicon also comes with a helper script (xgettext.pl) that helps keep your localization files up-to-date with your templates or modules that have text that need translating. I've had very good results with this kind of setup in the past.
It seems you want to have a different way of parsing strings. I would advise you not to do this. The only one who is seeing the syntax with the %d in it is the developer and he will exactly understand what is meant. The printf syntax is powerful because of the options like padding, decimals etc.
I think you want to use more a replace method. It is perlish to do s/{num}/$n/.
In light of your comment about being for translators I suggest writing a perl script that strips all printf() and tabulates them in an easier more translator friendly manner.
Something like this:
while(<>)
{
#regex for striping printf
#print in tabulated form
}
If you print out the line number too you can easily write another program to replace the translated text.
This solution wouldn't take you any longer than re-factoring away from printf() and it's reusable.
I would definitely stick with printf(), it's standard across many languages.
It has almost become a standard for string output. Like i is for for loops.
Generally answer from Draegtun is great, but if you'd need something smaller (i.e. less memory), and not as powerful you can easily do it using this function:
sub printX {
my ( $format, $vars ) = #_;
my #sorted_keys = sort { length($b) <=> length($a) } keys %{ $vars };
my $re = join '|', map { "\Q$_\E" } #sorted_keys;
$format =~ s/ \{ \s* ($re) \s* \} /$vars->{$1}/xg;
print $format;
}
well, perl has printf function...
wait, do you want something like python's string formatting with dict?
>>> print '%(key)s' % {'key': 'value'}
value
mmm, I don't know something like that exist in perl...
at least not this "easy"...
maybe Text::Sprintf::Named can be your friend
I have a Perl program that reads in a bunch of data, munges it, and then outputs several different file formats. I'd like to make Perl be one of those formats (in the form of a .pm package) and allow people to use the munged data within their own Perl scripts.
Printing out the data is easy using Data::Dump::pp.
I'd also like to print some helper functions to the resulting package.
What's an easy way to print a multi-line string without variable substitution?
I'd like to be able to do:
print <<EOL;
sub xyz {
my $var = shift;
}
EOL
But then I'd have to escape all of the $'s.
Is there a simple way to do this? Perhaps I can create an actual sub and have some magic pretty-printer print the contents? The printed code doesn't have to match the input or even be legible.
Enclose the name of the delimiter in single quotes and interpolation will not occur.
print <<'EOL';
sub xyz {
my $var = shift;
}
EOL
You could use a templating package like Template::Toolkit or Text::Template.
Or, you could roll your own primitive templating system that looks something like this:
my %vars = qw( foo 1 bar 2 );
Write_Code(\$vars);
sub Write_Code {
my $vars = shift;
my $code = <<'END';
sub baz {
my $foo = <%foo%>;
my $bar = <%bar%>;
return $foo + $bar;
}
END
while ( my ($key, $value) = each %$vars ) {
$code =~ s/<%$key%>/$value/g;
}
return $code;
}
This looks nice and simple, but there are various traps and tricks waiting for you if you DIY. Did you notice that I failed to use quotemeta on my key names in the substituion?
I recommend that you use a time-tested templating library, like the ones I mentioned above.
You can actually continue a string literal on the next line, like this:
my $mail = "Hello!
Blah blah.";
Personally, I find that more readable than heredocs (the <<<EOL thing mentioned elsewhere).
Double quote " interpolates variables, but you can use '. Note you'll need to escape any ' in your string for this to work.
Perl is actually quite rich in convenient things to make things more readable, e.g. other quote-operations. qq and q correspond to " and ' and you can use whatever delimiter makes sense:
my $greeting = qq/Hello there $name!
Nice to meet you/; # Interpolation
my $url = q|http://perlmonks.org/|; # No need to escape /
(note how the syntax coloring here didn't quite keep up)
Read perldoc perlop (find in page: "Quote and Quote-like Operators") for more information.
Use a data section to store the Perl code:
#!/usr/bin/perl
use strict;
use warnings;
print <DATA>;
#print munged data
__DATA__
package MungedData;
use strict;
use warnings;
sub foo {
print "foo\n";
}
Try writing your code as an actual perl subroutine, then using B::Deparse to get the source code at runtime.