For searching the presence of a value in an array in Perl, we can use following code :
#!/usr/bin/perl -w
my @arry=('asd','hhf','qw33','dfd','ppq');
my $search_value='asd';
if($search_val ~~ @arry) {
print "Value '$search_val' is present in the given array...";
}
The program will give an output as follows if the search value is present in the array.
Value 'asd' is present in the given array...
@names = $query->multi_param @names = $query->param
If the scriptwas invoked with aparameter list (e.g. “name1=value1&name2=value2&name3=value3”), the param() / multi_param() methods will return theparameter names as a list. If the scriptwas invoked as an
script and contains a string without ampersands (e.g. “value1+value2+value3”) , there will be a single parameter named “keywords” containing the “+”-delimited keywords.
NOTE: As of version 1.5, the array of parameter names returned will be in the same order as they were submitted by the browser. Usually this order is the same as the order in which the parameters are defined in the form (however, this isn’t part of the spec, and so isn’t guaranteed).
@values = $query->multi_param('foo');
-or-
$value = $query->param('foo');
Pass the param() / multi_param() method a single argument to fetch the value of the named parameter. If the parameter is multivalued (e.g. from multiple selections in a scrolling list), you can ask to receive an array. Otherwise the method will return a single value.
Warning – calling param() in list context can lead to vulnerabilities if you do not sanitise user input as it is possible to inject other param keys and values into your code. This is why the multi_param() method exists, to make it clear that a list is being returned, note that param() can stil be called in list context and will return a list for back compatibility.
The following code is an example of a vulnerability as the call to param will be evaluated in list context and thus possibly inject extra keys and values into the hash:
my %user_info = (
id => 1,
name => $query->param('name'),
);
The fix for the above is to force scalar context on the call to ->param by prefixing it with “scalar”
name => scalar $query->param('name')
If you call param() in list context with an argument a warning will be raised by CGI.pm, you can disable this warning by setting $CGI::LIST_CONTEXT_WARN to 0 or by using the multi_param() method instead
If a value is not given in the query string, as in the queries “name1=&name2=”, it will be returned as an empty string.
If the parameter does not exist at all, then param() will return undef in a scalar context, and the empty list in a list context.
If your transactions are simple, you can save yourself the trouble of having to issue a lot of commits. When you make the connect call, you can specify an AutoCommit option which will perform an automatic commit operation after every successful query. Here’s what it looks like:
my $dbh = DBI->connect($dsn, $userid, $password,{AutoCommit => 1})
or die $DBI::errstr;
Here AutoCommit can take value 1 or 0, where 1 means AutoCommit is on and 0 means AutoCommit is off.
In normal we use “AutoCommit in on mode“. But in the case of Insertion and updation for a transaction safe DB we have to make “AutoCommit in off mode” temporarily. Currently most of us try to write separate function as follows:
my $dbh1 = DBI->connect($dsn, $userid, $password,{AutoCommit => 0})
or die $DBI::errstr;
Actually we don’t need to write such a thing. we can handle it with
$dbh->begin_work
Many databases support transactions. This means that you can make a whole bunch of queries which would modify the databases, but none of the changes are actually made. Then at the end you issue the special SQL query COMMIT, and all the changes are made simultaneously. Alternatively, you can issue the query ROLLBACK, in which case all the changes are thrown away and database remains unchanged.
Perl DBI module provided begin_work API, which enables transactions (by turning AutoCommit off) until the next call to commit or rollback. After the next commit or rollback, AutoCommit will automatically be turned on again.
$rc = $dbh->begin_work or die $dbh->errstr;
Commit is the operation which gives a green signal to database to finalize the changes and after this operation no change can be reverted to its orignal position.
Here is a simple example to call commit API.
$dbh->commit or die $dbh->errstr;
If you are not satisfied with all the changes or you encounter an error in between of any operation , you can revert those changes to use rollback API.
Here is a simple example to call rollback API.
$dbh->rollback or die $dbh->errstr;
It’s as follows :-
sub age {
use Time::Local;
use Date::Calc qw(Delta_Days);
# Assuming $birth_month is 0..11
my ($birth_day, $birth_month, $birth_year) = @_;
my ($day, $month, $year) = (localtime)[3,4,5];
$year += 1900;
$month+=1;
my @today_sec = localtime();
my $time = timelocal(@today_sec);
my @birthday_sec = (0, 0, 0, $birth_day, $birth_month, $birth_year);
my $birthtime = timelocal(@birthday_sec);
my @birthday=($birth_year, $birth_month, $birth_day);
my @today=($year, $month, $day);
my $days = Delta_Days(@birthday, @today);
my $netage="";
if($days > 28) {
my $age = $year - $birth_year;
$age-- unless sprintf("%02d%02d", $month, $day)
>= sprintf("%02d%02d", $birth_month, $birth_day);
my $mnth=($month>$birth_month)?$month-$birth_month:12+($month-$birth_month);
my $mnth_total=($age*12)+$mnth;
if($mnth_total > 0 && $mnth_total < 4) {
my $week=int($days/7);
if($week > 1) {
$netage = $week." Weeks";
} else {
$netage = $week." Week";
}
} elsif($mnth_total >= 4 && $mnth_total < 24) {
$netage = $mnth_total." Months";
} elsif($age >= 2 && $age < 18) {
$netage = $age." Years";
if($mnth == 1) {
$netage .= " ".$mnth." Month";
} elsif($mnth > 1) {
$netage .= " ".$mnth." Months";
} else { }
} elsif($age >= 18) {
$netage = $age." Years";
} else { }
} else {
$netage = $days." Days";
}
return $netage;
}
print &age(6,4,1990);
Output :-
24 Years
To calculate the age, we can use following subroutine :
print &age($tmpdob[2],$tmpdob[1],$tmpdob[0]);
sub age {
# Assuming $birth_month is 0..11
my ($birth_day, $birth_month, $birth_year) = @_;
my ($day, $month, $year) = (localtime)[3..5];
$year += 1900;
$month+=1;
my $age = $year - $birth_year;
$age-- unless sprintf("%02d%02d", $month, $day)
>= sprintf("%02d%02d", $birth_month, $birth_day);
my $mnth=($month>$birth_month)?$month-$birth_month:12+($month-$birth_month);
return $age."Y/".$mnth."M ";
}
You must be logged in to post a comment.