Nano's Blog

07/20/2010

Perl trim function to strip whitespace from a string

Filed under: programming — Tags: — nano @ 09:47

Perl does not have a built-in trim function. Use the subroutine below to trim whitespace (spaces and tabs) from the beginning and end of a string in Perl. This function is directly based on the Perl FAQ entry, How do I strip blank space from the beginning/end of a string?. The ltrim and rtrim functions can trim leading or trailing whitespace.

#!/usr/bin/perl

# Declare the subroutines
sub trim($);
sub ltrim($);
sub rtrim($);

# Create a test string
my $string = "  \t  Hello world!   ";

# Here is how to output the trimmed text "Hello world!"
print trim($string)."\n";
print ltrim($string)."\n";
print rtrim($string)."\n";

# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}
# Left trim function to remove leading whitespace
sub ltrim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	return $string;
}
# Right trim function to remove trailing whitespace
sub rtrim($)
{
	my $string = shift;
	$string =~ s/\s+$//;
	return $string;
}

06/04/2010

How to parse multi record XML file ues XML::Simple in Perl

Filed under: programming — Tags: , — nano @ 03:30

How to access multiple records

data.xml

<?xml version="1.0" encoding="ISO-8859-1"?>
<catalog>
  <cd country="UK">
    <title>Hide your heart</title>
    <artist>Bonnie Tyler</artist>
    <price>10.0</price>
  </cd>
  <cd country="CHN">
    <title>Greatest Hits</title>
    <artist>Dolly Parton</artist>
    <price>9.99</price>
  </cd>
  <cd country="USA">
    <title>Hello</title>
    <artist>Say Hello</artist>
    <price>0001</price>
  </cd>
</catalog>

test.pl

#!/usr/bin/perl
   # use module
   use strict;
   use warnings;

   use XML::Simple;
   use Data::Dumper;

   # create object
   my $xml = new XML::Simple;

   # read XML file
   my $data = $xml->XMLin("data.xml");

   # access XML data
   # print "$data->{name} is $data->{age} years old and works in the $data->{department} section\n";

  print $data->{cd}[0]{country}."\n";
  print $data->{cd}[0]{artist}."\n";
  print $data->{cd}[0]{price}."\n";
  print $data->{cd}[0]{title}."\n";
  print "\n\n";
  print "$data->{cd}->[0]->{country}\n";
  print "$data->{cd}->[0]->{artist}\n";
  print "$data->{cd}->[0]->{price}\n";
  print "$data->{cd}->[0]->{title}\n";

  print "\n\n";
   # print output
  print Dumper($data);

output:


D:\learning\perl>t1.pl
could not find ParserDetails.ini in C:/Perl/site/lib/XML/SAX
UK
Bonnie Tyler
10.0
Hide your heart

UK
Bonnie Tyler
10.0
Hide your heart

$VAR1 = {
          'cd' => [
                    {
                      'country' => 'UK',
                      'artist' => 'Bonnie Tyler',
                      'price' => '10.0',
                      'title' => 'Hide your heart'
                    },
                    {
                      'country' => 'CHN',
                      'artist' => 'Dolly Parton',
                      'price' => '9.99',
                      'title' => 'Greatest Hits'
                    },
                    {
                      'country' => 'USA',
                      'artist' => 'Say Hello',
                      'price' => '0001',
                      'title' => 'Hello'
                    }
                  ]
        };

D:\learning\perl>

References:

http://www.go4expert.com/forums/showthread.php?t=812

Tips:

http://www.perlmonks.org/index.pl?node_id=218480

06/03/2010

Perl Practice Scripts Collection

Filed under: programming — Tags: , — nano @ 04:57

test1.pl

#!/usr/bin/perl -w
use strict;
use warnings;

use Data::Dumper;

my $s;

$s="status MaterializeU4";

print (($s =~ /s\s.*?((MaterializeU4)?)/) ? "Match\n" : "No Match\n");

$s="status MaterializeU4";

print (($s =~ /s\s.*?((MaterializeU4)?)/) ? "Match\n" : "No Match\n");

$s="statusaa dMaterializeU4";

print (($s =~ /s\s.*?((MaterializeU4)?)/) ? "Match\n" : "No Match\n");

$s="status < MaterializeU4>";

print (($s =~ /s\s.*?((MaterializeU4)?)/) ? "Match\n" : "No Match\n");

$s="status VIDNAME9000 = <U4 MaterializeU4()>";

print (($s =~ /s\s.*?((MaterializeU4)?)/) ? "Match\n" : "No Match\n");

# I inserted another one below
$s="status VIDNAME9000 = <U4 MaterializeU4()>";
print (($s =~ /^status .*?((MaterializeU4)?)/) ? "Match\n" : "No Match\n");

output

Match
Match
No Match
Match
Match
Match

test2.pl

#!/usr/bin/perl -w
use strict;
use warnings;

use Data::Dumper;
my @all_lines = (
 "s 1"
,"b 1"
,""
, "status VIDNAME9000 = <U4 MaterializeU4()>"
,"b 2"
,""
, "s 3"
,"b 3"
,""

);

while (@all_lines) {
    my @block = read_block();
    print Data::Dumper->Dump([\@block]);
}
exit 0;

# Read a constant definition block from a file handle.
# void return when there is no data left in the file.
# Empty return for skippable (Materialize4U) block!!!
# Otherwise return an array ref containing lines to in the block.
sub read_block {
    my @lines = ();
    my $block_started = 0;
    my $block_ignore = 0;
    while (my $line = shift @all_lines) {
        if ($line =~ /s\s.*?((MaterializeU4)?)/){
            $block_started = 1;   # why can't execute
            $block_ignore = 1 if $1; # or is it #1?
        }
        last if $line =~ /^\s*$/ && $block_started;
        push @lines, $line unless $block_ignore;
    }
    return \@lines if @lines;
    return;
}

output

$VAR1 = [
          [
            's 1',
            'b 1'
          ]
        ];
$VAR1 = [
          [
            'status VIDNAME9000 = <U4 MaterializeU4()>',
            'b 2'
          ]
        ];
$VAR1 = [
          [
            's 3',
            'b 3'
          ]
        ];

test3.pl

#!/usr/bin/perl -w
use strict;
use warnings;

use Data::Dumper;
my @all_lines = (
 "s 1"
,"b 1"
,""
, "status VIDNAME9000 = <U4 MaterializeU4()>"
,"b 2"
,""
, "s 3"
,"b 3"
,""

);

while (@all_lines) {
    my @block = read_block();
    print Data::Dumper->Dump([\@block]);
}
exit 0;

# Read a constant definition block from a file handle.
# void return when there is no data left in the file.
# Empty return for skippable (Materialize4U) block!!!
# Otherwise return an array ref containing lines to in the block.
sub read_block {
    my @lines = ();
    my $block_started = 0;
    my $block_ignore = 0;
    while (my $line = shift @all_lines) {
        if ($line =~ /^status .*?((MaterializeU4)?)/) {
            $block_started = 1;   # why can't execute
            $block_ignore = 1 if $1; # or is it #1?
        }
        last if $line =~ /^\s*$/ && $block_started;
        push @lines, $line unless $block_ignore;
    }
    return \@lines if @lines;
    return;
}

output

$VAR1 = [
          [
            's 1',
            'b 1'
          ]
        ];
$VAR1 = [
          [
            'status VIDNAME9000 = <U4 MaterializeU4()>',
            'b 2'
          ]
        ];
$VAR1 = [
          [
            's 3',
            'b 3'
          ]
        ];

Why test2.pl, test3.pl can’t skip the 2nd block content? thanks.

test4.pl – final

#!/usr/bin/perl -w
use strict;
use warnings;

use Data::Dumper;
my @all_lines = (
 "s 1"
,"b 1"
,""
, "status VIDNAME9000 = <U4 MaterializeU4()>"
,"b 2"
,""
, "s 3"
,"b 3"
,""

);

while (@all_lines) {
    my @block = read_block();
    print Data::Dumper->Dump([\@block]);
}
exit 0;

# Read a constant definition block from a file handle.
# void return when there is no data left in the file.
# Empty return for skippable (Materialize4U) block!!!
# Otherwise return an array ref containing lines to in the block.
sub read_block {
    my @lines = ();
    my $block_started = 0;
    my $block_ignore = 0;
    while (my $line = shift @all_lines) {
        # original expression as below comment.
        # if ($line =~ /status\s.*?((MaterializeU4)?)/){
        if ($line =~ /^status\s.*?((MaterializeU4))/){
            $block_started = 1;   # why can't execute
            $block_ignore = 1 if $1; # or is it #1?
        }
        last if $line =~ /^\s*$/ && $block_started;
        push @lines, $line unless $block_ignore;
    }
    return \@lines if @lines;
    return;
}

output:

$VAR1 = [
          [
            's 1',
            'b 1'
          ]
        ];
$VAR1 = [];
$VAR1 = [
          [
            's 3',
            'b 3'
          ]
        ];

01/16/2010

The shift and unshift Operators

Filed under: programming — Tags: — nano @ 02:39

The shift and unshift operators perform the corresponding actions on the “start” of the array (or the “left” side of an array, or the portion with the lowest subscripts).
push and pop operators do things to the “end” of an array(or the “right” sidce of an array).

The foreach control involved to the sample code below.

#!C:\Perl\bin\perl.exe
use strict;
use warnings;

my @array = qw# dino fred barney #;
# print @array;
foreach my $array (@array) {
$array = "\t$array"; # put a tab in front of each element of @rocks
$array.= "\n"; # put a newline on the end of each
print $array;
}

my $m = shift(@array); # $m gets "dino", @array now has ("fred", "barney")
my $n = shift @array; # $n gets "fred", @array now has ("barney")
shift @array; # @array is now empty
# print a empty array
foreach my $array (@array) {
$array = "\t$array"; # put a tab in front of each element of @rocks
$array.= "\n"; # put a newline on the end of each
print $array; # nothing printed
}

my $o = shift @array; # $o gets undef, @array is still empty
unshift(@array, 5); # @array now has the one-element list (5)
unshift @array, 4; # @array now has (4, 5)
my @others = 1..3;
unshift @array, @others; # @array now has (1, 2, 3, 4, 5)
foreach my $array (@array) {
$array = "\t$array"; # put a tab in front of each element of @rocks
$array.= "\n"; # put a newline on the end of each
print $array;
}

Output:


D:\learning\perl>hi.pl
        dino
        fred
        barney
        1
        2
        3
        4
        5

D:\learning\perl>

- from Learning Perl 5E

01/14/2010

XAMPP for windows

Filed under: programming — Tags: , , — nano @ 16:32

new version of XAMPP 1.7.3, including:
Apache 2.2.14 (IPv6 enabled) + OpenSSL 0.9.8l
MySQL 5.1.41 + PBXT engine
PHP 5.3.1
phpMyAdmin 3.2.4
Perl 5.10.1
FileZilla FTP Server 0.9.33
Mercury Mail Transport System 4.72

Download and Install XAMPP 1.7.3
Destination folder: c:\

The perl cgi script could located in
C:\xampp\htdocs\hello.cgi (or hello.pl) recommend.
C:\xampp\cgi-bin\hello.cgi (or hello.pl)

Link: http://www.apachefriends.org/en/xampp-windows.html

Beginning Perl and MySQL Tutorial

Filed under: programming — Tags: , — nano @ 07:41

Step1.
Download & install MySQL.
mysql-essential-5.1.36-win32.zip
Download Link: http://download.cnet.com

Step2.
Setting a root password for MySQL
1. Start your command line by going to the Start Menu > Run and typing cmd (or type command if you are using an older version of windows)
2. Change directory to where you installed mysql to:

C:\> cd C:\mysql\bin

3. Switch to mysql command line:

C:\mysql\bin> mysql -u root mysql

4. Then set a default password:

mysql> SET PASSWORD FOR root@localhost=PASSWORD(‘newpass’);

where “newpass” is the password you want to use

Adding more users
Start your command line by going to the Start Menu > Run and typing cmd (or type command if you are using an older version of windows)
Change directory to where you installed mysql to:

C:\> cd C:\mysql\bin

Switch to mysql command line (if you have not set a root password remove the -p switch when you type it in):

C:\mysql\bin> mysql -u root -p mysql

Then then add your new user:

mysql> GRANT ALL PRIVILEGES ON *.* TO rachel@localhost IDENTIFIED BY ’summer’;

where “rachel” is the username and “summer” is the password you want to use. You can also limit users to specific database, allow only certain remote hosts to connect all using the GRANT statement. However, that is outside the scope of this tutorial so search for more info on using GRANT if you are interested in those features.

- from www.ricocheting.com

Step3.
let’s create a database called perltest and in that database, we will create a simple table called samples and populate it with some data. Here is the SQL you’ll need to create the table and fill in a few records, just connect to your MySQL database and run them.

CREATE DATABASE perltest;
USE perltest;
CREATE TABLE samples (
id int(10) unsigned NOT NULL auto_increment,
name varchar(128) NOT NULL default '',
phone varchar(128) NOT NULL default '',
PRIMARY KEY (id)
);
INSERT INTO samples VALUES (1, 'Some Person', '555-5555');
INSERT INTO samples VALUES (2, 'Another Person', '222-2222');

Step4.
Sample Script

#!/usr/bin/perl -w

use strict;
use warnings;
use DBI;

my $dbh = DBI->connect('dbi:mysql:perltest','root','myroot')
or die "Connection Error: $DBI::errstr\n";
my $sql = "select * from samples";
my $sth = $dbh->prepare($sql);
$sth->execute
or die "SQL Error: $DBI::errstr\n";
while (my @row = $sth->fetchrow_array) {
print "@row\n";
}

Dissection.

$dbh = DBI->connect('dbi:mysql:DATABASE_NAME', USERNAME, PASSWORD)</blockquote>

The die option provides an alternative to the program simply not working if a connection is not established. Basically, the connect it tried, and if it fails, your script will die and display an error message that should help you debug. Once we’ve established a connection to the MySQL database, we will need to create a string of SQL and then prepare it to query the database.

$sql = "select * from samples";
$sth = $dbh->prepare($sql);

Next we query the database with our prepared SQL query, or exit the program and display some debugging information if the MySQL query fails to execute.

$sth->execute
or die "SQL Error: $DBI::errstr\n";

Finally we use the fetchrow_array function to fetch each row of the results from the MySQL database and print them one to a line.

while (@row = $sth->fetchrow_array) {
print "@row\n";
}

If the program is successful, you should see the following output:

1 Some Person 555-5555
2 Another Person 222-2222

- from perl.about.com

[Tips]
DBD-mysql
I run the script using ActivePerl 5.10.1 on Winxp.
The DBD-mysql package didn’t installed by default. You need install it via Perl Package Manager.
More about DBD-mysql
A MySQL driver for the Perl5 Database Interface (DBI)
Version: 4.011
Released: 2009-04-14
Author: Patrick Galbraith CPAN: http://search.cpan.org/dist/DBD-mysql-4.011/

01/06/2010

The each Function

Filed under: programming — Tags: — nano @ 09:09

If you wish to iterate over (that is, examine every element of) an entire hash, one of the usual ways is to use the each function, which returns a key-value pair as two-element list.

#!C:\Perl\bin\perl.exe
use strict;
use warnings;

# declare a new hash
my %some_hash;

%some_hash = ("foo", 35, "bar", 12.4, 2.5, "hello",
      "wilma", 1.72e30, "betty", "bye");

my $key;
my $value;

while ( ($key, $value) = each %some_hash)
{
  print "$key => $value\n";
}

print "\n";
foreach $key (sort keys %some_hash) {
  $value = $some_hash{$key};
  print "$key => $value\n";
  # Or, we could have avoided the extra $value variable:
  #  print "$key => $hash{$key}\n";
}

Output

betty => bye
bar => 12.4
wilma => 1.72e+030
foo => 35
2.5 => hello

2.5 => hello
bar => 12.4
betty => bye
foo => 35
wilma => 1.72e+030

-from Learning Perl 5E

The Hash As a Whole

Filed under: programming — Tags: — nano @ 09:01

The order is jumbled because Perl keeps the key-value pairs in an order that’s conven-
ient for Perl so that it can look up any item quickly.

Elements of a hash are printed out in their internal order, which can not be relied upon and will change as elements are added and removed. If you need all of the elements of a hash in some sort of order, sort the keys, and use that list to index the hash.

If you are looking for a structure that holds its elements in order, either use an array, or use one of the ordered hash’s on CPAN.

the only ordering you can rely upon from a list context hash expansion is that key => value pairs will be together.

use the keys function to get a list of the keys. They will most likely be in the same order as they’re stored in the hash itself, although there’s no guarantee. If the order matters, then you either shouldn’t be using a hash in the first place, or you should use the keys function to get a list, put the items in the desired order, and then loop through that list, accessing each corresponding hash item.

#!C:\Perl\bin\perl.exe
use strict;
use warnings;

# declare a new hash
my %some_hash;

%some_hash = ("foo", 35, "bar", 12.4, 2.5, "hello",
      "wilma", 1.72e30, "betty", "bye");

my @any_array;
@any_array = %some_hash;

print %some_hash;
print "\n";
print "\n";
print @any_array;
print "\n";
print "\n";

my @keys;
@keys = keys %some_hash;
for my $k (sort @keys)
{
    print $k, $some_hash{$k};
}
print "\n";
print "\n";
print map {$_, $some_hash{$_}} sort keys %some_hash;

Output


D:\learning\perl>test.pl
bettybyebar12.4wilma1.72e+030foo352.5hello

bettybyebar12.4wilma1.72e+030foo352.5hello

2.5hellobar12.4bettybyefoo35wilma1.72e+030

2.5hellobar12.4bettybyefoo35wilma1.72e+030
D:\learning\perl>

-from StackOverflow.com

Hash Element Access

Filed under: programming — Tags: — nano @ 06:28
#!C:\Perl\bin\perl.exe
use strict;
use warnings;

# declare a new hash
my %family_name;

# Initial hash.
# Compared to array access, we use curly braces instead of square brackstes around the subscript(key)
$family_name{"fred"} = "flintstone";
$family_name{"barney"} = "rubble";

# print the Values
print $family_name{"fred"};
print "\n";
print $family_name{"barney"};
print "\n";

# the hash key maybe any expression. not just the literal strings and simple scalar variables
my $foo = "bar";
print $family_name{ $foo . "ney" };  # prints "rubble"
print "\n";

# Stuff $person and as the Keys for hash.
foreach my $person (qw< barney fred >) {
  print "I've heard of $person $family_name{$person}.\n";
}

Output

flintstone
rubble
rubble
I've heard of barney rubble.
I've heard of fred flintstone.

- from Learning Perl 5E

01/05/2010

The pop and push Operators

Filed under: programming — Tags: — nano @ 13:55

The pop operator takes the last element off of an array and returns it;

The converse operation is push, which adds and element (or a list of elements) to the end of array.

The first argument to push or the only argument for pop must be an array variable – pushing and poping would not make sense on a literal list.

#!C:\Perl\bin\perl.exe
use strict; # enabled
use warnings; 

my @array; 

@array  = 5..9;
my $fred   = pop(@array);  # $fred gets 9, @array now has (5, 6, 7, 8 )
my $barney = pop @array;   # $barney gets 8, @array now has (5, 6, 7)
pop @array;             # @array now has (5, 6). (The 7 is discarded.)

print $fred;
print "\n";
print $barney;
print "\n";
print @array;
print "\n";

my @others;
push(@array, 0);      # @array now has (5, 6, 0)
push @array, 8;       # @array now has (5, 6, 0, 8 )
push @array, 1..10;   # @array now has those ten new elements
@others = qw/ 9 0 2 1 0 /;
push @array, @others; # @array now has those five new elements (19 total)

print @others;
print "\n";
print @array;

Output

9
8
56
90210
56081234567891090210

- from Learning Perl 5E

Older Posts »

Powered by WordPress