(29) What is wantarray in perl?

Solution:

wantarray is a special keyword which returns a flag indicating which context your subroutine has been called in.

It will return one of three values.

true: If your subroutine has been called in list context
false: If your subroutine has been called in scalar context
undef: If your subroutine has been called in void context

For example:-

You have a subroutine named "display" and from that subroutine sometimes you want to return an array and sometimes a scalar.

So the syntax would be

sub display(){
return(wantarray() ? qw(A B C) : '1');
}

my @ab = display();
my $bd = display();

then output is

#@ab = (A B C);
and
#$bd = 1;

The output will be depend upon the left hand side
assignment. If you put an array (@ab) it will call
wantarray() else a scalar value will return.

(28) How to use ForkManager in perl code?

Solution:

This post is to demonstrate how to use Parallel::ForkManager, a simple and powerful Perl module available from CPAN that can be used to perform a series of operations in parallel within a single Perl script.

You need to instantiate the ForkManager with the "new" constructor. You must specify the maximum number of processes to be created. If you specify 0, then NO fork will be done; this is good for debugging purposes.

use strict;
use Parallel::ForkManager;

# set a number of maximum process you want to run
my $max_procs = 3;

my @names = qw( print online show );
# hash to resolve PID's back to child specific information

my $pm = new Parallel::ForkManager($max_procs);

# Setup a callback for when a child finishes up so we can
# get it's exit code
$pm->run_on_finish(
sub { my ($pid, $exit_code, $ident) = @_;
print "** $ident just got out of the pool ".
"with PID $pid and exit code: $exit_code\n";
}
);

$pm->run_on_start(
sub { my ($pid,$ident)=@_;
if($ident eq 'print'){
my $a = results(1);
print $a."\n";
}elsif($ident eq 'online'){
my $b = online(2);
print $b."\n";
}else{
my $c = show(3);
print $c."\n";
}
}
);

$pm->run_on_wait(
sub {
print "** Have to wait for one children ...\n"
},
0.5
);

foreach my $child ( 0 .. $#names ) {
my $pid = $pm->start($names[$child]) and next;
$pm->finish($child); # pass an exit code to finish
}

print "Waiting for Children...\n";
$pm->wait_all_children;
print "Everybody is out of the pool!\n";

sub results{
my $process1 = shift;
return "Process number is $process1\n";
}

sub online{
my $process2 = shift;
return "Process number is $process2\n";
}

sub show{
my $process3 = shift;
return "Process number is $process3\n";
}

Do not use Parallel::ForkManager in an environment, where other child processes can affect the run of the main program, so using this module is not recommended in an environment where fork() / wait() is already used.

(27) How to use JSON in perl code?

Solution :

In this post i try to show how to use JSON with perl. JSON (Javascript Object Notation) is a lightweight data-interchange format. It is easy for humans to read and write. It is easy for machines to parse and generate. JSON is a text format that is completely language independent but uses conventions that are familiar to programmers of the C-family of languages, including C, C++, C#, Java, JavaScript, Perl, Python, and many others.

In this example i had created 1 js (javascript) file named a.js, 2 .pl (perl) files (i) index.pl and (ii) json.pl.

In a.js

function checkuser(){
var a = document.getElementById('text1').value;
var b = document.getElementById('text2').value;
$('#loading').show("fast");
$.getJSON("/cgi-bin/json.pl?",{
'user': a,
'pass': b
},function (data) {
$.each(data.check, function (i, check) {
if(check[0] != 'invalid') {
$('#msg').html('');
$(check[1]).appendTo('#msg');

}else{
$('#msg').html('');
$(check[1]).appendTo('#msg');
}
$('#loading').hide("fast");
});
});
}

(i)In index.pl

#!/usr/bin/perl -w

use strict;
use warnings;

print "Content-type: text/html\n\n";

print qq~<html>
<head>
<title>JSON Example</title>
<script src="//ajax.googleapis.com/ajax/libs/jquery/1.5.2/jquery.min.js" type="text/javascript"></script>
<script src="/a.js" type="text/javascript"></script>
</head>
<body>
<div align="center">
<div id="loading" style="background-color:#fff1a8;line-height:23px;display:none;width:15%"><img src="/loading.gif" class="loading_m2"> Loading... </img></div><br>
</div>
<div align="center">
<table>
<tr>
<td>UserName:</td>
<td><input type="text" id="text1" value="Lalit"></td>
</tr>
<tr>
<td>Password:</td>
<td><input type="password" id="text2" value="123456"></td>
</tr>
<tr align="center">
<td><input type="button" value="Submit" onclick="checkuser();"></td>
</tr>
</table>
</div>
<div align="center" id="msg"></div>
</body>
</html>~;

and
(ii)In json.pl

#!/usr/bin/perl -w

use CGI;
use JSON;

my $cgi = CGI->new;

my $username = $cgi->param("user");
my $password = $cgi->param("pass");
my ($return, $msg) = '';

if($username eq 'Lalit' && $password eq '123456'){
($return, $msg) = ('valid', 'Welcome Lalit');
}else{
($return, $msg) = ('invalid','You are not Authorized User');
}

my $json = JSON->new->utf8->space_after->encode({'check' =>
{'rawdata' => [$return, $msg]}});
print $cgi->header(-type => "application/json", -charset => "utf-8");
print $json;

This json script is used to check that a user is a valid user or not.

(26) How to print a matching line, one line immediately above it and one line immediately below?

Solution:

In perl this type of problems or requirement can be easily solved because of its versatility.

my $line='';

open(FILE,'/home/lalit/Desktop/test.txt') or die "Could not open file " . $!;

while (<FILE>){

    if($_ =~ /how are you/ig){
        print "\nprevious line of matching pattern =>" . $line;
        print "\nCurrent Line of matching pattern =>" . $_;
        print "\nNext Line of matching pattern =>" . scalar <FILE>."\n";
    }
    $line = $_;
}

close FILE;

(25) How to use Apache2::Ajax with perl code?

Solution:

In the previous post, no. 24, i tried to show how to use CGI::Ajax with perl code. Now i am going to use Apache2::Ajax which is mod_perl interface to CGI::Ajax.

This module require mod_perl2, CGI::Ajax, as well as a CGI.pm-compatible CGI module for supplying the param() and header() methods. If available, CGI::Apache2::Wrapper will be used, which is a minimal module that uses methods of mod_perl2 and Apache2::Request to provide these methods; if this is not available, CGI (version 2.93 or greater) will be used.

To use this module you have to make some changes in your httpd.conf, which is located at /etc/httpd/conf/.

To make the use of the below example, some steps need to be followed:-

(i) Create a directory cgi-bin2 in /var/www/.

(ii) Following change must be done your httpd.conf :-

PerlModule ModPerl::Registry
Alias /cgi-bin2/ /var/www/cgi-bin2/
<Location /cgi-bin2>
     SetHandler perl-script
     PerlResponseHandler ModPerl::Registry
     PerlOptions +GlobalRequest
     PerlSendHeader On
     PerlOptions +ParseHeaders
     Options +ExecCGI
     Order allow,deny
     Allow from all
</Location>

(iii) Create a file named with myajax.pl with the following code:

#!/usr/bin/perl -w

use strict;
use CGI;
use lib '/usr/lib/perl5/site_perl/5.8.8/';

use Apache2::MyAjaxApp;

my $r =shift;
Apache2::MyAjaxApp->handler($r);

(iv) Create a file named MyAjaxApp.pm in following location:

/usr/lib/perl5/site_perl/5.8.8/Apache2/

Put the following code into the file

package Apache2::MyAjaxApp;

use Apache2::Ajax;
use mod_perl2;
 
sub check {
    my $arg = shift;
    return ( $arg . " with some extra" );
}

sub Show_Form_sub {

    my $html = "";
    $html .= "<HTML>";
    $html .= "<HEAD>";
   
    $html .= <<EOT;
    </HEAD>
    <BODY>
    <FORM name="form">
    <INPUT type="text" id="inarg"
        onkeyup="tester(['inarg'],['output_div']); return true;">
    <hr>
    <div id="output_div"></div>
    </FORM>
    <br/><div id='pjxdebugrequest'></div><br/>
    </BODY>
    </HTML>
EOT

    return $html;
}

sub Show_Form_sub1 {

    my $html = "";
    $html .= "<HTML>";
    $html .= "<HEAD>";
   
    $html .= <<EOT;
    </HEAD>
    <BODY>
    Invalid
    </BODY>
    </HTML>
EOT

    return $html;
}
 
sub handler {

    my ($class,$r) = @_;
    my $ajax = Apache2::Ajax->new($r, 'tester' => \&check);

    $r->print($ajax->build_html('html' => \&Show_Form_sub));
    return Apache2::Const::OK;

}

1;

Restart your apache service and run in the browser with the following url:

http://localhost/cgi-bin2/myajax.pl