Chapter 11: Beyond Scalars - More Data Types

############################################################################################################
#Author: Leo
#Email: ahyeek@gmail.com
#Desc:
# The author has created some codes to test out during the learning process for the book called
# <Professional Perl Programming>, publisher: Wrox Pree Ltd, year in 2001
# ISBN: 1-861004-49-4.
#
#Summary:
# Examples code for <Professional Perl Programming>.
# Chapter 11: Beyond Scalars - More Data Types
#
############################################################################################################

my $string = "AAA:1xBBB:0.21xCCC:0.33xDDD:1";

my $rstring = $string;
$string =~ s/:/*/g;
print "Before replace string =>$rstring\n";

print "After replace string=>$string\n";


############################################################################################################
# The 'Split' function.
############################################################################################################
print "\nThe 'Split' function...\n";
my $text = "affy5;affy6;illumina";

my @values = split(";", $text);
foreach (@values){

print "Split value ==> $_\n";
}

############################################################################################################
# Test match specified string start with certain words.
############################################################################################################
my @html_string = (

"<!-- This is commented html.",
"This is commented html. <!-- Commented at the end.-->",
"Not commneted."
);
foreach my $item (@html_string){

if($item =~ m/^<!--*./){
print "[ $item ] is commented html!\n";
}

else{
print "[ $item ] is not commented html!\n";
}
}


############################################################################################################
# Test for multiple matches.
############################################################################################################
my @tag_html_string = (
"<tag>blablabla</tag>",
"<tag>bla<tag>blabl<tag>a</tag></tag></tag>",
"<Tag>bla<tAg>blabl<taG>a</tag></tag></tag>",
"<Tag>bla<tAg><tAg><tAg>blabl<taG>a</tag></tag></tag>",
"<tag id=blablabla /><tag id=blablabla /><tag id=blablabla />",

);
my $tag_to_detect = "<tag";
my $same_line_tag_to_close = "/>";
foreach my $item (@tag_html_string){

@detected_tag = $item =~ /($tag_to_detect[ >]|$same_line_tag_to_close)/ig;
foreach(@detected_tag){ print "[ $_ ],"; }

print "\n";
}

Examples code for Advance Perl Programming

############################################################################################################
#Author: Leo
#Email: ahyeek@gmail.com
#
#Summary:
# Examples code for Advance Perl Programming.
#
############################################################################################################

#!/usr/bin/perl

use warnings;
use strict;

############################################################################
# Usage : rm_arr_item_for_word_cotain_specific_tag($array, $tag);
# Desc : Removing items from an array where item contain specified word.
############################################################################
my @test_array = ("<div", "<span", "<table", "<div", "<font", "<tr", "<div", "<select", "<p");

foreach my $item(@test_array){
print "[ $item ],";

}
print "\n";

#my @return_array = rm_arr_item_for_word_cotain_specific_tag_once(\@test_array, "</div>");
@test_array = rm_arr_item_for_word_cotain_specific_tag_once(\@test_array, "</div>");

foreach my $item(@test_array){
print "[ $item ],";

}
print "\n";

@test_array = rm_arr_item_for_word_cotain_specific_tag_once(\@test_array, "</p>");
foreach my $item(@test_array){

print "[ $item ],";
}
print "\n";

sub rm_arr_item_for_word_cotain_specific_tag{

my ($array, $tag) = @_;

my @tmp_array = ();

$tag =~ s/(\/|<|>)//g;
print "Targeted tag to remove: $tag\n";

foreach my $item(reverse @$array){

if($item =~ m/$tag/ig) { next; }
push @tmp_array, $item;
}


return @tmp_array;
}

sub rm_arr_item_for_word_cotain_specific_tag_once{
my ($array, $tag) = @_;

my @process_array = reverse @$array;
my @tmp_array = ();

$tag =~ s/(\/|<|>)//g;
print "Targeted tag to remove: $tag\n";

foreach my $item (@process_array){

#print "Process item: $item\n";
if($item =~ m/$tag/ig) {
#print "Found $tag\n";
$tag = "_";
}

else{
#print "Store item: $item\n";
push @tmp_array, $item;
}
}
return reverse @tmp_array;

}



#######################################################################
# Test : Passing array into sub routine and out.
#######################################################################
print "\n\nPassing array into sub routine and out.\n";
my @test_to_change_arr = ('aaa', 'bbba', 'ccca', 'ddda', 'eeea', 'fffa');

my @array_of_hash = ();
my $item_ctr = 0;

foreach my $my_arr_item (@test_to_change_arr)

{
$item_ctr++;
print "Push hash item {$item_ctr => $my_arr_item} into hash array...\n";
push @array_of_hash, {$item_ctr => $my_arr_item};

}
print "\nWhat is having in array, check: \n";
foreach my $arr_item (@array_of_hash)

{
foreach (keys %$arr_item)
{
print "key is $_ value is $$arr_item{$_}.\n";
}

}


sub test_array
{
my ($array, $tag, $tag_to_change) = @_;

}

Chapter 7: Subroutines

############################################################################################################
#Author: Leo
#Email: ahyeek@gmail.com
#Desc:
# The author has created some codes to test out during the learning process for the book called
# <Professional Perl Programming>, publisher: Wrox Pree Ltd, year in 2001
# ISBN: 1-861004-49-4.
#
#Summary:
# Examples code for: Subroutines
# Chapter 7: Subroutines
#
############################################################################################################


#!/usr/bin/perl

use warnings;
use strict;


#Testing global variable...
my $MY_GLOBAL_VARIABLE = "Global assigned variable!";

sub mysubroutine{
print "Hello Perl subroutine!! I am going to learn you!\n";
print "That will be easy like ABC :)...\n";

}

my $subref_print_empty_line = sub { print "\n"; };
my $subref_anonymous = sub { print "This is anonymous sub routine...\n"; };


#Call the sub routine that I created.
mysubroutine();

#Call again the sub routine...
&$subref_print_empty_line;
mysubroutine();

#Call anonymous sub routine.
&$subref_print_empty_line;
&$subref_anonymous;

######################################################
# Build reference to the sub routine.
######################################################

print "\nCalling reference sub routine...\n";
my $subref_mysubroutine = \&mysubroutine;
&$subref_mysubroutine;

######################################################
# Checking for subroutines defination
######################################################
&$subref_print_empty_line;

if(defined &mysubroutine)
{
print "mysubroutine is defined!\n";
}

if(not defined &mysubroutine_xx)
{
print "mysubroutine_xx is NOT defined!\n";

}

######################################################
# Passing parameters into subroutines
######################################################
sub volume_param_type_1{
(my $h, my $w, my $l) = @_;
return $h * $w * $l;

}

sub volume_param_type_2{
my $h = shift;
my $w = shift;
my $l = shift;
return $h * $w * $l;

}

sub print_msg_and_count{
my($message, @count) = @_;

#print scalar message information.
&$subref_print_empty_line;
print "Message --> " . $message . "\n";

foreach(@{count}){

print "Count element: $_\n";
}
}

sub print_arrmsg_and_count{

my($message, $count) = @_;

#print scalar message information.
&$subref_print_empty_line;
foreach(@ {$message}){

print "Message --> " . $_ . "...\n";
}

foreach(@ {$count}){

print "Count element: $_\n";
}
}

sub arraytext_return{

my ($value1,
$value2,
$value3) = @_;

return ("Processed value 1 = " . $value1,
"Processed value 2 = " . $value2,
"Processed value 3 = " . $value3);

}

&$subref_print_empty_line;
print "Call sub with param type 1 ==>" . volume_param_type_1(3, 3, 3); &$subref_print_empty_line;
print "Call sub with param type 2 ==>" . volume_param_type_2(3, 3, 3); &$subref_print_empty_line;


my $message = "msg 1";
my @message = ("msg 1", "msg 2", "msg 3", "firstname " . "lastname");

my @count = (1, 2, 3);
print_msg_and_count($message, @count);
print_arrmsg_and_count(\@message, \@count);


sub call_voltype1_voltype2{
print "Vol type 1 ==>" . &volume_param_type_1; &$subref_print_empty_line;
print "Vol type 2 ==>" . &volume_param_type_2; &$subref_print_empty_line;

}

&$subref_print_empty_line;
print "Inherit @_ from parents\n";
call_voltype1_voltype2 (1, 2, 3);


&$subref_print_empty_line;
my @myvalues = ("html value 1", "html value 2", "html value 3");
my @processesvalues = arraytext_return(@myvalues);
print_arrmsg_and_count(\@processesvalues, \@count);


######################################################
# Test global variable accessing...
######################################################

sub print_global_variable{
print "Accessing global variable inside sub routine =->" . $MY_GLOBAL_VARIABLE . "\n";

}

sub modify_global_variable{
print "Modifying global variable here ...\n";
$MY_GLOBAL_VARIABLE = "Modified global variable...";

}

&$subref_print_empty_line;
print_global_variable();
modify_global_variable();
print_global_variable();

######################################################
# Assign value sub...
######################################################
my $scalarsub = "Before assigning...";

sub assignablesub : lvalue {

$scalarsub;
}

&$subref_print_empty_line;
print $scalarsub , "\n";
assignablesub = "After assigning...";

print $scalarsub , "\n";

#######################################################################
# Passing parameter using hash variable into subroutine...
#######################################################################
print "\nPassing parameter using hash variable into subroutine...\n";
sub CheckPassParam {

my $arg = shift;

my $p1 = $arg->{'param1'};
my $p2 = $arg->{'param2'};
my $p3 = $arg->{'param3'};

print "\nParam1 = $p1, Param2 = $p2, Param3 = $p3\n";

foreach (sort keys %{$arg})

{
print "Key=$_, Param=$arg->{$_}\n";
}

}

CheckPassParam({
'param1' => 'Direct My first param',
'param2' => 'Direct My second param',
'param3' => 'Direct My third param'

});

Chapter 6: Structure, Flow, and Control

############################################################################################################
#Author: Leo
#Email: ahyeek@gmail.com
#Desc:
# The author has created some codes to test out during the learning process for the book called
# <Professional Perl Programming>, publisher: Wrox Pree Ltd, year in 2001
# ISBN: 1-861004-49-4.
#
#Summary:
# Examples code for <Professional Perl Programming>.
# Chapter 6: Structure, Flow, and Control
#
############################################################################################################

use warnings;


#A bare block using definition

{
#define six scalars in new block scope:
my($sec, $min, $hour, $day, $month, $year) = localtime();

#variable exist and can be used inside the block.
print "The time is: $hour: $min. $sec\n";

print "Date before processed: $year / $month / $day \n";
$month++;
$year+=1900;
print "The date is: $year / $month / $day \n";

#End of block.

}

print "\$sec is not defined outside block.\n" unless defined($sec);

#While block.

print "Enter: ";
while(my $line = <>)
{
last if $line =~ /quit/;
print "You entered: $line";
print "Enter: ";

}

###########################################################################################
# Special Blocks
###########################################################################################
END {
print "Exiting... This was printed at the end although it was coded first.\n";
}

print "Running ...Printed during the program run sequentially.\n";

BEGIN{
print "Compiling ... This will be printed first because printed during program was compiled.\n";
}

Chapter 5: Beyond Scalars - More Data Types

############################################################################################################
#Author: Leo
#Email: ahyeek@gmail.com
#Desc:
# The author has created some codes to test out during the learning process for the book called
# <Professional Perl Programming>, publisher: Wrox Pree Ltd, year in 2001
# ISBN: 1-861004-49-4.
#
#Summary:
# Examples code for <Professional Perl Programming>.
# Chapter 5: Beyond Scalars - More Data Types
#
############################################################################################################

#!/usr/bin/perl

use warnings;
use strict;


######################################################
# List and Arrays.
######################################################
print "\nList and Arrays.\n";
my @array = (1, 2, 3, 4, 5, 6);
@array[2..4] = @array[0..2];

print "Array value = @array \n";

######################################################
# Replace element number three with three new elements
# to create eight elements list.
######################################################
print "\nReplace element number...\n";
my @arr1 = ('a', 'b', 'c', 'd', 'e');

my $removed = splice @arr1, 2, 1, (1, 2, 3);
print "New array = @arr1\n";

print "Removed element = $removed \n";

my @removed = splice @arr1, 2, 3;
print "After removing 3 elements from no.2 position = @arr1\n";

print "Removed array = @removed \n";

my @my_next_last_3_elements = splice @arr1, -3;
print "Removing last 3 elements = @arr1\n";

print "Last 3 removed array = @my_next_last_3_elements \n";

######################################################
# Counting an array...
######################################################
print "\nCounting an array...\n";
my @countarray = (11, 22, 33, 44, 55, 66, 77, 88);

my $last_element = (11, 22, 33, 44, 55, 66, 77, 88);
print "Caution! Assigned array directly to a scalar is getting the last element: $last_element \n";

my $num_of_element = scalar(@countarray);

print "The number of element in array: $num_of_element \n";

print "Getting index for each elements...\n";
foreach(0..$#countarray)

{
print "Element number $_ contains $countarray[$_]\n";
}

######################################################
# Ways of adding element to an array...
######################################################
print "\nWays of adding element to an array...\n";
my @addarray = ('aa', 'bb', 'cc');

print "Original array = @addarray\n";

$addarray[3] = "dd";
print "After add 1 element to the array = @addarray\n";


$addarray[scalar(@addarray)] = "ee";
print "After add another element to the array = @addarray\n";


push @addarray, "ff";
print "After add another element to the array = @addarray\n";

######################################################
# Truncating an array...
######################################################
print "\nTruncating an array...\n";

print "Array with elements number = " . scalar(@addarray) . "\n";
print "Truncating the array to 1 element...\n";

$#addarray = 0;
print "Array after truncate = @addarray\n";

######################################################
# Removing element from array ...
######################################################
print "\nRemoving element from array...\n";
my @rmarray = ('bb', 'cc', 'dd');

unshift @rmarray, 'aa', '00', '-1-1'; #Add element in front of an array.
print "@rmarray\n";

shift @rmarray;

print "After removing 1st element from array...@rmarray\n";

shift @rmarray;
print "After removing 1st element again from array...@rmarray\n";

pop @rmarray;

print "After removing 1st element again from array from the end...@rmarray\n";

splice(@rmarray, -1);
print "After removing 1st element again from array from the end...@rmarray\n";



######################################################
# Destroying an array
######################################################
undef @rmarray;
print "Destroyed array ==> @rmarray\n";

######################################################
# Sorting & Reversing Lists and Arrays.
######################################################
print "\nSorting & Reversing Lists and Arrays.\n";

my @testarray = ('aa', 'bb', 'cc', 'dd');
@testarray = reverse @testarray;

print "Reversed array ==> @testarray\n";

@testarray = sort @testarray;
print "Sorted array ==> @testarray\n";


######################################################
# Converting Lists into Formatted Strings
######################################################
my @words = ('This', 'is', 'going', 'to', 'join.,,');

my $string = join ' ', @words;
print "Join array ==> $string\n";


$string = join ';', @words;
print "Join in other format ==> $string\n";

$string = join '', @words;

print "Join in other format ==> $string\n";

my @codes = (80, 101, 114, 108);
my $wordfromarr = pack 'C*', @codes;

print "Word from array ==> $wordfromarr\n";

my @sentences = ('Practical', 'extration', 'reporting', 'language');

my $first_letter_here = pack 'a' x @sentences, @sentences;
print "Extract first letter from every words in array --> $first_letter_here" . "\n";


######################################################
# Research on Data type: HASH
######################################################
print "\nResearch on Data type: HASH\n";
my %hash = ("Mouse" => "Jerry", "Cat" => "Tom", "Dog" => "Spike");

print "The mouse is " . $hash{"Mouse"} . "\n";

my @return_hash_value_in_array = @hash{'Mouse', 'Cat', 'Dog'};

print "Return hash value in array ==> @return_hash_value_in_array\n";

my @hash_keys = keys %hash;
print "Obtain keys value from a hash ==> @hash_keys\n";

print "Sorted keys are:";
print join(',', sort keys %hash);


print "Dump content of a hash:\n";
foreach (sort keys %hash){
print "$_ ==> $hash{$_} \n";

}

print "\nModifying hash value...\n";
$hash{'Cat'} = 'Sylvester';

$hash{'Bird'} = 'Tweety'; #If the key not exist in a hash table, new key will be added.
foreach (sort keys %hash){

print "$_ ==> $hash{$_} \n";
}

print "\nChange hash value by array...\n";

@hash{('Mouse', 'Dog')} = ('Tom', 'XiaoHuangGou');
foreach (sort keys %hash){

print "$_ ==> $hash{$_} \n";
}

print "\nRemoving a hash key...\n";

#undef $hash{'Bird'}; #Doing this only will create warning and error.
delete $hash{'Bird'};
foreach (sort keys %hash){

print "$_ ==> $hash{$_} \n";
}

print "\nConverting an Array to Hash key...\n";

my @tohash = ('key0', 'value0', 'key1', 'value1', 'key2', 'value2');

my %myhash = @tohash;
foreach (sort keys %myhash){

print "$_ ==> $myhash{$_} \n";
}

print "\nPerforming Key and Value reversing in myhash...\n";

print "Check ... The value for Key:Key0 in myhash is ==> $myhash{'key0'}\n";
foreach (keys %myhash)
{

$myhash{$myhash{$_}} = $_; #Inverting the key and value by inserting new key.
delete $myhash{$_}; #Remove original key.

}
print "Check ... The value for Key:Value0 in myhash is ==> $myhash{'value0'}\n";

print "\nGetting just the values in myhash...\n";
my @myhashvalues = values %myhash;

foreach(@myhashvalues)
{
print "Value got: $_\n";
}

print "\nGetting just the values in myhash in more proper and sorted way...\n";
foreach(sort values %myhash)
{

print "Value got: $_\n";
}

print "\nIterate through Hash...\n";
my %Vhash = ('K1' => 1, 'K2' => 2, 'K3' => 3, 'K4' => 4, 'K5' => 5);

while( my ($key, $value) = each %Vhash)

{
print "$key => $value \n";
$Vhash{$key}++;

}

######################################################
# Converting HASHES into SCALARS...
######################################################
print "\nConverting HASHES into SCALARS...\n";
my %hashdata = (one => 1, two => 2, three => 3, four => 4, five => 5);

my $elements = scalar(keys %hashdata);
print "Element data: $elements\n";


my $hashref = \%hashdata;
my $data = $hashref->{'one'};

print "Dereference element 'one' => $data\n";
if($data eq 1) { print "Data matched to 1 tested!\n"; }

if($hashref->{'one'} eq 1) { print "Data matched to 1 from direct ref tested!\n"; }

print "\nConvert hash data to array...\n";
my @hasharray = %hashdata;
foreach(@hasharray)

{
print "Array element from hash => $_\n";
}

print "\nConvert sorted hash data to array...\n";

my @sorthasharray = sort %hashdata;
foreach(@sorthasharray)
{
print "Array element from hash => $_\n";

}

######################################################
# Comparing references...
######################################################
print "\nComparing references...\n";
my $text = "This is a value.";

my $ref1 = \$text;
my $ref2 = \$text;
print "\$ref1==\$ref2 result:" . ($ref1==$ref2) . "\n";

$$ref1 = "Changed value.";
print "After \$ref1 change value, \$ref2=>" . $$ref2 . "\n";


my $test1 = "Text 1";
my $test2 = "Text 2";
my $rt1 = \$test1;

my $rt2 = \$test2;
print "\$rt1==\$rt2 result:" . ($rt1==$rt2) . "\n";

$$rt1 = "Change value.";
print "After \$rt1 change value, \$rt2=>" . $$rt2 . "\n";


######################################################
# Complex data strucutures...
######################################################
print "\nComplex data strucutures...\n";
my @multi_array = (
["one", "two", "three"],
["Red", "Yellow", "Blue"],
["Left", "Middle", "Right"]

);
print "Multi Array Element [0][2] ->$multi_array[0][2]\n";
print "Multi Array Element [2][1] ->$multi_array[2][1]\n";

my @second_row = @{$multi_array[1]};

print "Second row array = @second_row\n";

######################################################
# The undefined value...
######################################################
print "\nThe undefined value...\n";
my $a;

print "defined(a)?==>" . defined($a) . "\n";
print "It's defined\n" if defined $a;

$a=100;
print "defined(a)?==>" . defined($a) . "\n";
print "It's defined\n" if defined $a;


######################################################
# Define constant value...
######################################################
print "\nDefine constant value...\n";
use constant PI => 3.1415926;
print "36 degree is " . 36*PI/180 . "rad.\n";

Chapter 1 ~ 4 - Examples code for [Professional Perl Programming]

############################################################################################################
#Author: Leo
#Email: ahyeek@gmail.com
#Desc: 
# The author has created some codes to test out during the learning process for the book called
#       <Professional Perl Programming>, publisher: Wrox Pree Ltd, year in 2001
# ISBN: 1-861004-49-4.
#
#Summary:
# Examples code for <Professional Perl Programming>.
# Chapter 1: Introduction
# Chapter 2: Basic Concepts
# Chapter 3: Scalars
# Chapter 4: Operators
# 
############################################################################################################

#!/usr/bin/perl

use warnings;
use strict;


###########################
# Assignment
###########################

print +("Helloooo"), " World!!\n";

print "###########################\n";

print "# Assignment\n";
print "###########################\n";

my $variable = "my value";

my $c = $b = $a = 'This is a, b and c values';

print "Variable=" . $variable . "\n";

print "c = b = a = " . $c . "\n";

#For array assignment.
my @myarray = (1, 2, 3, 4, 5);

print "@myarray\n";

@myarray[0] = (9);
print "After changing elelment no. 1 ==> @myarray\n";


@myarray[0..3] = (10, 8, 7, 6);
print "After changing elelment no. 1 to 4th ==> @myarray\n";


print "###########################\n";
print "# Shift operator bit\n";
print "###########################\n";

printf "2 << 1 = %d\n", 2 << 1;

printf "2 << 3 = %d\n", 2 << 3;
printf "42 >> 2 = %d\n", 42 >> 2;


print "###########################\n";
print "# String and List\n";
print "###########################\n";
my $str1 = "First";

my $str2 = "Second";
my $join = $str1 . $str2 . "\n";

print "Concatenate 2 string => " . $join;

my $x = "x";
print "Repeat string =>" . $x x 30 . "\n";


my @reparr = (1, 2, 3) x 3;
print "Repeat array => @reparr \n";


my @arr1 = (1, 2, 3);
my @onlylastelementrepeat = @arr1 x 20;

print "Only last element repeat => @onlylastelementrepeat \n";

my @arr2 = (@arr1) x 3;

print "Repeat the arr = @arr2 \n";

print "###########################\n";
print "# Increment & Decrement \n";

print "###########################\n";
my $number = 0;
$number++;
print "\$number++=" . $number . ", ++\$number=" . ++$number . "\n";

print "--\$number=" . --$number . ", \$number--=" . $number . "\n";


my $Str3 = "Perk";
print "++\$Str3 = " . ++$Str3 . "\n";

print "++\$Str3 = " . ++$Str3 . "\n";
my $serialno = "SN1999";

print "Increment in serial number string ==>" . ++$serialno . ", " . ++$serialno . "\n";

print "###########################\n";

print "# Comparison in perl ... \n";
print "###########################\n";
my $strnum1 = 1;
my $strnum2 = 5;

while($strnum1 < $strnum2)
{ 
 print "\$strnum1=" . $strnum1 . " still less than \$strnum2\n";
 $strnum1++;

} 

my $name = "TSY1";
if ($name ne "TSY")

{
 print "Name not same!\n";
}

print "#############################\n";
print "# Range operator in perl ... \n";

print "#############################\n";
foreach(1..10){
 print "$_\n";

}

print "A".."E"; print "\n";
print reverse "A".."E"; print "\n";


print "#############################\n";
print "# Ternary operator ...       \n";
print "#############################\n";
my $v1;

my $v2;
my $same = 0;
print "Only V1 and V2 is same to exit...\n";
while(!$same){ 
 print "Please input v1: "; $v1=<>;
 print "Please input v2: "; $v2=<>;
 print "Result is " . (($v1==$v2) ? "same" : "different") . "\n"; 
 $same = ($v1==$v2);

}