#!/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;
}

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

#!/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'
          ]
        ];

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

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

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/

#!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

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

Output

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

- from Learning Perl 5E

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