Install
* CPAN WikiMedia::API page
* This module requires the following perl modules
LWP::UserAgent
URI::Escape
JSON
Encode
Carp
and optionally JSON::XS for faster JSON decoding.
* Install
perl -MCPAN -e shell
cpan> install MediaWiki::API
Usage
use strict;
use MediaWiki::API;
# Point to your MediaWiki site api.php page
my $mw = MediaWiki::API->new();
$mw->{config}->{api_url} = 'http://mymediawiki.com/api.php';
# Login
$mw->login( { lgname => 'me', lgpassword => 'secret' } )
|| die $mw->{error}->{code} . ': ' . $mw->{error}->{details};
# Edit TestPage
my $pagename = "TestPage";
my $ref = $mw->get_page( { title => $pagename } );
unless ( $ref->{missing} ) {
my $timestamp = $ref->{timestamp};
$mw->edit( {
action => 'edit',
title => $pagename,
basetimestamp => $timestamp, # to avoid edit conflicts
text => $ref->{'*'} . "\nAdditional text 2" } )
|| die $mw->{error}->{code} . ': ' . $mw->{error}->{details};
}
# Retrieve TestPage content
my $page = $mw->get_page( { title => 'TestPage' } );
print $page->{'*'};
Filed under: perl | |Comments off
Install Cygwin
See this post for details.
In addition
* Install all Perl packages.
* Install "devel/make" and all its dependencies.
* Install "devel/gcc-core" and "devel/gcc-g++" packages.
* Install "openssl" and "openssl-devel" packages.
* Install "mail/ssmtp" package.
ssmtp-config
Install from CPAN
* Install "XML::Simple"
shell> perl -MCPAN -e shell
cpan> install XML::Simple
OR
cd .cpan/build/XML-Simple-2.18-ICtnsp
make test
make install
* Install "Crypt::SSLeay"
shell> perl -MCPAN -e shell
cpan> install Crypt::SSLeay
OR
cd .cpan/build/Crypt-SSLeay-0.57-MJnTGM
perl Makefile.PL
make test
make install
* Install "Error" pacakge
shell> perl -MCPAN -e shell
cpan> install Error
* Create a new ParserDetails.ini file in the /usr/lib/perl5/vendor_perl/5.10/XML/SAX directory
<pre>
[XML::SAX::PurePerl]
http://xml.org/sax/features/namespaces = 1
[XML::LibXML::SAX::Parser]
http://xml.org/sax/features/namespaces = 1
[XML::LibXML::SAX]
http://xml.org/sax/features/namespaces = 1
Install WebInject
* Download WebInject from its download page. I downloaded the source version webinject-1.41.src.tar.gz.
* Unzip webinject-1.41.src.tar.gz into a local directory.
Run WebInject
./webinject.pl
Configure External Email Module
* Create an external email module named "Plugin.pm":
if ($casefailedcount > 0) {
open(MAIL, '| /usr/sbin/ssmtp.exe me\@my.com') or "die";
print MAIL <<EOF;
To:me\@my.com
From:me\@my.com
Subject:Passed: $casepassedcount, Failed: $casefailedcount
Start Time: $currentdatetime \n
Total Run Time: $totalruntime seconds \n
\n
Test Cases Run: $totalruncount \n
Test Cases Passed: $casepassedcount \n
Test Cases Failed: $casefailedcount \n
Verifications Passed: $passedcount \n
Verifications Failed: $failedcount \n
\n
Average Response Time: $avgresponse seconds \n
Max Response Time: $maxresponse seconds \n
Min Response Time: $minresponse seconds \n
EOF
}
1;
* Add to config.xml:
<reporttype>external:/path/to/Plugin.pm</reporttype>
Setup as cron job
* Setup Cygwin cron service as described in this post
* Setup crontab for webinject to run every 30 min:
crontab -e
*/30 * * * * /cygdrive/c/webinject/webinject.pl
Filed under: cygwin, perl | |Comments off
Introduction
Basic Concepts
Perl program is a bunch of Perl statements and definitions thrown into a file. It incorporated object oriented support since Perl 5.
Perl is both a compiler and an interpreter. Perl program is compiled into an internal format and then executed.
Finding Help
perldoc perl # list of the many standard Perl manual pages
perldoc perlrun # Perl's command-line options
perldoc perlapi # C-based interfaces
perldoc -f funcname # look up a Perl function
perldoc -q pattern # search the questions in the Perl FAQ
perldoc -r pattern # search documentation recursively
perldoc -f split
perldoc -q '(mail|address)'
perldoc -q -r '(un)pack'
perldoc IO::File
perldoc perldoc
perldoc -m IO::File
perldoc -l IO::File
perldoc -i exutils::makemaker
perldoc -i -q CGI
Running Perl
perl myscript.pl # run perl
perl -w myscript.pl # with warning
perl -V:startperl # ask how to start perl (startperl='#!/usr/bin/perl5.10.0';)
perl -h # print command options
Install Perl Modules
# For Unixes, use CPAN
perl -MCPAN -e shell
cpan> install Apache::Registry # install
cpan> i CGI # info on CGI module
cpan> i /CGI/ # info on modules containing CGI
cpan> i /^CGI/ # info on modules start with CGI
cpan> i /^CGI::/ # info on CGI child modules
cpan> m /XML/ # info on XML module
cpan> a DOUGM # info on author
cpan> d /-1.\d/ # info on version 1.x
cpan> b # list all available bundles
cpan> r # list out of date modules
cpan> u /^XML::/ # list available *not* installed modules start with XML
cpan> readme Apache::Session # reading document without installing
# For Windows, use ActiveState Perl
ppm install Math::Matrix
Perl Operators
Perl Operators
Comments
# This is a commented out single line
# Use POD
=For comment
This is a multiple line
comments
=Cut
# Use Acme::Comment
use Acme::Comment type => 'C++';
/*
This is a comment ...
... C++ style!
*/
More on here.
Hello, World
#!/usr/bin/perl -w # -w: produce extra warnings
$secretword="llama";
print("What is your name?"); # writes to screen
$name = <STDIN>; # reads from keyboard
chomp($name); # removes trailing newline character
if ($name eq "Jimmy") { # if statement
print("Hello, Jimmy! How good of you to be here!\n");
} else {
print("Hello, $name!\n");
print("What's the secret word? ");
$guess = <STDIN>;
chomp($guess);
while ($guess ne $secretword) { # while loop
print("Wrong, try again. What is the secret word?");
$guess = <STDIN>;
chomp($guess);
}
print("Welcome again, $name");
}
Here Doc
my $heredoc = <<END;
Hello,
Here Doc.
END
* Reference: http://www.stonehenge.com/merlyn/UnixReview/col12.html
Date Time String
* localtime()
Converts a time as returned by the time function to a 9-element list with the time analyzed for the local time zone:
0: $sec, 1: $min, 2: $hour, 3: $mday, 4: $mon, 5: $year, 6: $wday, 7: $yday, 8: $isdst
my ($current_min, $current_hour, $current_day, $current_mon,$current_year)
= (localtime)[1,2,3,4,5];
my $curretn_date_string = sprintf '%02d/%02d/%d %02d:%02d',
$current_mon+1, $current_day, $current_year+1900, $current_hour, $current_min;
* Reference: http://perldoc.perl.org/functions/localtime.html
Arrays
* Array variable names begin with '@', for example, '@words'.
* Array element is accessed with zero based subscript reference. For example, '$words[0]', '$words[1]'.
@pets = ("dog", "cat", "fish", "hermit crab");
$dog = $pets[0];
# Anonymous array
$array = [ 'One', 'Two', 'Three' ];
@arrayarray = ( 1, 2, [1, 2, 3]);
Hash
* Hash variable names begine with '%', for example, '%words'.
* Hash element is accessed with a key reference which can be any scalar value, for example, '$words{"fred"}'.
%words = (
"fred", "camel",
"barney", "llama",
"betty", "fish"
);
$word1 = $words{"fred"};
# Anonymous hash
$hash = { 'Man' => 'Bill',
'Woman' => 'Mary,
'Dog' => 'Ben'
};
Manipulate Strings with Regular Expression
* =~ # Match
* != # Not match
Match Operator
* m/PATTERN/ or /PATTERN/ # Match all occurrance
* ?PATTERN? # Match only once
my $str1 = 'Hello world!';
if ($str1 =~ m/world/){
print "\$str1 contains 'world'\n";
}
if ($str1 =~ /Hello/){
print "\$str1 contains 'Hello'\n";
}
my $str2 = '10:10:10';
my ($hours, $minutes, $seconds) = ($str2 =~ m/(\d+):(\d+):(\d+)/);
print "hour: $hours, minute: $minutes, second: $seconds";
Match Operator Modifiers
/PATTERN/i # case insensitive
/PATTERN/m # ^ $ match begin and end of line char
/PATTERN/g # global find all matches
Substitue Operator
* s/PATTERN/REPLACEMENT/;
* Substitue Operator Modifiers
s/PATTERN/REPLACEMENT/i # case insensitive
s/PATTERN/REPLACEMENT/m # ^ $ match begin and end of line char
s/PATTERN/REPLACEMENT/g # global find all matches
Translate Operator
* tr/SEARCHLIST/REPLACEMENTLIST/
* y/SEARCHLIST/REPLACEMENTLIST/
* Translate operator modifiers
tr/SEARCHLIST/REPLACEMENTLIST/c # Complement search list, i.e. all non-matched will be replaced
tr/SEARCHLIST/REPLACEMENTLIST/d # Delete found but unreplaced characters
tr/SEARCHLIST/REPLACEMENTLIST/s # Squash duplicately replaced characters
# Match first word is jimmy, case insensitive:
$name =~ /^jimmy\b/i
# Remove everything after the first word:
$name =~ s/\W.*//;
# Convert all letters to lower case:
$name =~ tr/A-Z/a-z/;
if ($name =~ /^jimmy\b/i) {
print("Hi Jimmy!");
}else{
print("Hi, not Jimmy.");
}
Subroutines
# Call subroutine
good_word('john', 'myguess');
sub good_word {
# Access parameters
#my $somename = shift;
#my $someguess = shit;
# Or
my($somename, $someguess) = @_; # my() defines variables as private
$somename =~ s/\W.*//; # want want only the first word
$somename =~ tr/A-Z/a-z/; # convert to lower cases
if ($somename eq "jimmy") {
return 1;
} elsif (($words{$somename} || "groucho") eq $someguess) {
return 1;
} else {
return 0;
}
}
* Reference: http://www.perl.com/doc/manual/html/pod/perlsub.html
Modules
Two Kinds
Functional Modules
* User modules
* Usually upper cases and more than one word long separated by double colons.
Pragmatic Modules
* Implements pragmas to modify Perl behavior at compile time.
* Uses lower case and usually one word long.
How to include modules
# include a perl file
do '/home/perl/loadme.pl';
# include the old-style (and obsolete) getopts library
require 'getopts.pl';
# include the newer Getopt::Std library
# (i.e. PATH/Getopt/Std.pm)
require Getopt::Std;
# include Getopt::Std at compile time
use Getopt::Std;
# importing a list of symbols with a comma-separated list:
use Module qw(sub1 sub2 $scalar @list :tagname);
use Module; # import default symbols
use Module(); # suppress all imports
# if pragma
use if $ENV{USE_XML_PARSER},"XML::Parser";
use if !$ENV{USE_XML_PARSER},"XML::SAX";
# require Perl version 5.6.0 or higher
require 5.6.0;
use 5.6.0;
# require CGI.pm version 2.36 or higher
use CGI 2.36 qw(:standard);
Include Path
# Print out @INC
print "$_\n" foreach @INC;
foreach (@INC) { print "$_\n"; }
# Print out %INC which contains modules requested
print "\%INC contains: \n";
foreach (keys %INC) {
print " $INC{$_}\n";
}
# Add to start of @INC externally
perl -I/home/httpd/perl/lib,/usr/local/extra/lib/modules perl
PERL5OPT="I/home/httpd/perl/lib,/usr/local/p5lib"
PERL5LIB="/home/httpd/perl/lib:/usr/local/p5lib"
# add directory to end of @INC
push @INC, "/home/httpd/perl/lib";
use lib '/home/httpd/perl/lib';
# include libraries relative to script
use FindBin qw($RealDir); # or $Bin, $Dir, or $RealBin ...
use lib "$RealDir/../lib";
# remove paths from @INC with the no directive:
no lib 'home/httpd/perl/lib';
# lazy include a module
use autouse 'Module' => qw(sub1 sub2 Module::sub3);
# Checking for module availability
warn "GD module not available" unless eval {require GD; 1};
BEGIN {
foreach ('GD', 'CGI', 'Apache::Session') {
warn "$_ not available" unless eval "use $_; 1";
}
}
List All Installed Modules
#!/usr/bin/perl
# installedfiles.pl
use warnings;
use strict;
use ExtUtils::Installed;
my $inst = new ExtUtils::Installed;
foreach my $package ($inst->modules) {
my $valid = $inst->validate($package)?"Failed":"OK";
my $version = $inst->version($package);
$version = 'UNDEFINED' unless defined $version;
print "\n\n--- $package v$version [$valid] ---\n\n";
if (my @source = $inst->files($package, 'prog')) {
print "\t", join "\n\t", @source;
}
if (my @docs = $inst->files($package, 'doc')) {
print "\n\n\t", join "\n\t", @docs;
}
}
BEGIN and END blocks
BEGIN
(compile phase)
CHECK
INIT
(run phase)
END
Use Exporter
* Use Exporter:
package My::Module;
use strict;
use Exporter;
# Extends Exporter
@My::Module::ISA = qw(Exporter);
# Export hello subroutine
@My::Module::EXPORT = qw(hello);
# exported only on request
@EXPORT_OK = qw(helloAgain);
sub hello {
return "Hello World\n";
}
sub helloAgain {
return "Hello World\n";
}
1;
* Test
#!/usr/bin/perl
use warnings;
use strict;
use lib '.'; #look in current directory for My/Module.pm
use My::Module; # or use My::Module qw(hello);
print hello;
Automatically Create Module Template
h2xs -AXn MyModule
Object Oriented Perl
Object References
* A reference is a pointer to another object
Hard Reference
* Hard reference refers to the *actual data* contained in data structure.
$foo = 'foo';
$fooref = \$foo;
$arrayref = \@ARGV;
$hashref = \%ENV;
$globref = \*STDOUT;
sub foo { print "foo" };
$foosub = \&foo;
* Dereference a reference by prepending with corresponding data type characters
$$fooref;
testRef();
sub testRef {
my $foo = 'foo';
print "\$foo: $foo";
print "\n";
my $fooref = \$foo;
print "\$fooref: $fooref";
print "\n";
$$fooref = 'bar';
print "\$foo: $foo";
print "\n";
}
@$arrayref;
%$hashref;
&$foosub;
Symbolic Reference
* Symbolic reference uses another variable to point to the actual variable.
* E.g. $x = 10; $foo = "x"; $$foo = 20; print $x will produces 20 instead of 10.
* Symbolic references can be disallowed by use strict 'refs';
* Symbolic references are only allow for global variables, not variables declared by 'my'.
Object Basics
* A Perl class is a Perl package that contains methods to manipulate class objects.
* A Perl method is a Perl subroutine defined within the class whose first argument is always an object reference or package name.
Define a Class
# Class name
package Person;
# Imports
use strict;
use Exporter;
# Export
@Person::ISA = qw(Exporter);
@Person::EXPORT = qw(new getFirstName setFirstName);
# Constructor
sub new
{
my $class = shift;
my $self = {
# These are class variables
_firstName => shift,
_lastName => shift,
_ssn => shift,
};
# Return a reference to this object
bless $self, $class;
return $self;
}
# Destructor
sub DESTROY {
print "Employee::DESTROY called\n";
}
# Called whenever undefined subroutines are called
sub AUTOLOAD
{
print "Employee::AUTOLOAD called.\n";
return();
}
Inheritance
# Subclass name
package Employee;
use strict;
use Person;
use Exporter;
# Inherits Person
@Employee::ISA = qw(Person);
# Overrides constructor
sub new {
my $class = $_[0];
my $self = $class->SUPER::new($_[1], $_[2], $_[3]);
# Defines new class variable
$self->{_title} = $_[4];
bless $self, $class;
return $self;
}
Useful Stuff
# trim string
$blank =~ s/^\s+|\s+$//g;
DBI::Oracle
Install
* Install Oracle client or copy an existing Oracle client installation over. CPAN needs libraries from Oracle client in order to compile DBI and DBD::Oracle.
* Set ORACLE_HOME env var.
* Set Path to include Perl\bin and %ORACLE_HOME%\bin (Path=c:\perl\bin;%ORACLE_HOME%\bin;%PATH%)
* Set ORACLE_SID env var. Make sure user 'scott' is unlock and password set to 'tiger'. DBD::Oracle test script uses scott/tiger for testing.
* Install
c:\perl -MCAPN -e shell
cpan>install DBI
cpan>install DBD::Oracle
Connect to Oracle
# Connect to Oracle
my $host = "192.168.1.4";
my $sid = "orcl";
my $user = "scott";
my $passwd = "tiger";
my $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd, {AutoCommit => 0})
or die $DBI::errstr;
# Default to AutoCommit on
#my $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd) or die $DBI::errstr;
CRUD
use DBI;
my ($dbh);
openDB();
testCreate();
testRetrieve();
testUpdate();
testRetrieve();
testDelete();
closeDB();
sub openDB {
print "Open DB...";
print "\n";
my $host = "192.168.0.105";
my $sid = "orcl";
my $user = "scott";
my $passwd = "tiger";
unless (defined $dbh){
$dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd, {AutoCommit => 0})
or die $DBI::errstr;
}
print "DB opened";
print "\n";
}
sub closeDB {
print "Closing DB...";
print "\n";
$dbh->disconnect() or warn $dbh->errstr();
print "DB closed";
print "\n";
}
sub testCreate {
print "Creating...\n";
my $sth = $dbh->prepare("insert into test_table values ('John', 'Doe')");
$sth->execute() or die $DBI::errstr;
$dbh->commit() or die $DBI::errstr;
$sth->finish();
my $sth2 = $dbh->prepare("insert into test_table values (?,?)");
$sth2->execute('Jane', 'Doe') or die $DBI::errstr;
$dbh->commit() or die $DBI::errstr;
$sth2->finish();
print "Done Creating...\n";
}
sub testRetrieve {
print "Retrieving...\n";
my $sth3 = $dbh->prepare("select * from test_table");
$sth3->execute() or die $DBI::errstr;
while (my @row = $sth3->fetchrow_array()){
my ($firstName, $lastName) = @row;
print "Fist name: $firstName; Last name: $lastName\n";
}
$sth3->finish;
print "Done Retrieving...\n";
}
sub testUpdate {
print "Updating...";
print "\n";
my $updateSth = $dbh->prepare("update test_table set first_name= ? where first_name = ?");
$updateSth->execute('Jack', 'Jane') or die $DBI::errstr;
print "Number of rows update: ", $updateSth->rows;
print "\n";
$dbh->commit() or die $DBI::errstr;
$updateSth->finish();
print "Done updating";
print "\n";
}
sub testDelete {
print "Deleting...\n";
my $deleteSth = $dbh->prepare("delete from test_table");
$deleteSth->execute() or die $DBI::errstr;
$deleteSth->finish();
$dbh->commit() or die $DBI::errstr;
$deleteSth->finish();
print "Done Deleting...\n";
}
Useful Stuff
# trim string
$blank =~ s/^\s+|\s+$//g;
# Find and replace string in files
# e.g. find all .txt files and replace string two with ten
perl -e "s/two/ten/g;" -pi $(find . -name "*.txt")
# Same as above but save found files with .ori extenstion
perl -e "s/two/ten/g;" -pi.ori $(find . -name "*.txt")
References
Learning Perl by RandalL. Schwartz etc.
http://www.steve.gb.com/perl/lesson08.html
Pro Perl by Peter Wainwright
http://www.tutorialspoint.com/perl/index.htm
Perl Books
Filed under: perl | |Comments off