Friday, December 2, 2011

Perl - [ Function Splice / Array ]


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

my @array = ( 1..20 );
my @array2 = ( 1000..1005 );
print "\@array : @array\n\@array2 : @array2\n";
my @rmArray = splice ( @array, 5, scalar(@array2), @array2 );
print "After spliece\n";
print "\@array : @array\n\@rmArray : @rmArray\n";

Result :
$ perl splice.pl 
@array : 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
@array2 : 1000 1001 1002 1003 1004 1005
After spliece
@array : 1 2 3 4 5 1000 1001 1002 1003 1004 1005 12 13 14 15 16 17 18 19 20
@rmArray : 6 7 8 9 10 11

perl -e ' @an = ('a','b','c'); splice(@an,1,1); print "@an\n";
a c
andre@T3500:~> perl -e ' @an = ('a','b','c','d','e'); splice(@an,3,1); print "@an\n";   '
a b c e
andre@T3500:~> perl -e ' @an = ('a','b','c','d','e'); splice(@an,2,2); print "@an\n";   '
a b e
andre@T3500:~>





Syntax: splice (array to be modified, early modification, amount of values ​​to be inseritdo, values ​​to be insert)

Perl - [ $perl -e ' Command Line ' ] - [ Shift / Unshift / Pop / Push ]


Note: Open shell and type the code "command line" below!
Syntax : $ perl -e ' command line '

1) Profile example 

$ perl -e '@array = (1..5); print "Result : @array \n";'
Result : 1 2 3 4 5 


2) Removes the first element of the array
$ perl -e '@array = (1..5); shift (@array);print "Result : @array \n";'
Result : 2 3 4 5 


3) Remove the last element of the array
$ perl -e '@array = (1..5); pop (@array);print "Result : @array \n";'
Result : 1 2 3 4 

4) Insert the last element of the array
$ perl -e '@array = (1..5); push (@array,"command line");print "Result : @array \n";'
Result : 1 2 3 4 5 command line 

5) Insert at the beginning of the array
$ perl -e '@array = (1..5); unshift (@array,"command line");print "Result : @array \n";'
Result : command line 1 2 3 4 5


Note: Always use push and pop instead of shit and unshift when possible, for push and pop are more efficient with large array

Wednesday, November 30, 2011

Sunday, November 13, 2011

Perl - [ Seconds To Hours ]

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

my $seconds = shift or die "Entre the seconds parameter\n";
my @parts = gmtime($seconds);
printf ("day -%4d\t hours - %4d\tminute - %4d\tseconds - %4d\n",@parts[7,2,1,0]);


$perl secondsTohours.pl 89600
day -   1        hours -    0   minute -   53   seconds -   20
$perl secondsTohours.pl 3600
day -   0        hours -    1   minute -    0   seconds -    0

Perl - [ Second TO Hours [Sub] ]


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

my $value = shift or die "Enter the second parameter\n";

&secondTOhours(\$value);

sub secondTOhours(){
 
    my ($seconds)= @_;

    my $hrs = int( $$seconds / (60*60) );

    my $min = int( ($$seconds - $hrs*60*60) / (60) );

    my $sec = int( $$seconds - ($hrs*60*60) - ($min*60) );

    print("$hrs hours, $min minutes, and $sec seconds.\n");
}


$perl secondsTohours.pl 3600

1 hours, 0 minutes, and 0 seconds.


Thursday, November 3, 2011

Perl - [ Reference | Array Sub ]


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

my @array = [1,2,3,['a','b',['c']]];
my $rA = \@array;

print"\n[0] = [1,2,3,['a','b',['c']]]";
print"\n[3] = ['a','b',['c']]";
print"\n[2] = ['c']";
print"\n[0] = c";

print "\nResp : $rA->[0][3][2][0]\n";

my @des = [ ['andre','21','PA'],
            ['ela','-','SP']];

my $rD = \@des;
    print $rD->[0][0][0];

result


$ perl line.pl

[0] = [1,2,3,['a','b',['c']]]
[3] = ['a','b',['c']]
[2] = ['c']
[0] = c
Resp : c
andre


Perl - [ Captura Regex ]

#!/usr/bin/perl

use strict;
use warnings;

my $capitura = 'From: gnat@perl.com To: camelo@oreilly.com Date: Mon 17 Jul 200 09:00:00 -100 Subject: Nada';
$capitura =~ /(From:(.*)To:(.*)\s{1}Date:(.*)\s{1}Subject:(.*))/;
print "$1\n$2\n$3\n$4\n$5";

result


$perl  commandLine.pl
$1  # From: gnat@perl.com To: camelo@oreilly.com Date: Mon 17 Jul 200 09:00:00 -100 Subject: Nada
$2  # gnat@perl.com
$3  # camelo@oreilly.com
$4  # Mon 17 Jul 200 09:00:00 -100
$5  # Nada


Perl - [Character class | Change | Replacement | For ]


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

my $name = ' texto gerado automaticamente pelo sistema lattes ';
my $name1;

($name1 = $name) =~ s/o/OoO/g;

print "$name\n$name1\n";

for ($name){
    s/^\s+/+/;
    s/\s+$/++/;
    s/\s+/-/g;
}
print "$name\n";

my @names = ('comand','   ','line');

print "@names\n";

tr/ /./ for @names;

print "@names\n";

my ($num,$string,$space) = (10,'line',' ');

print "numero positive - $num \n"   if ($num =~ /\d/);
print "string positive - $string \n"    if ($string =~ /\w/);
print "space  positive - $space \n" if ($space =~ /\s/);

print "numero positive - $num \n"   if ($num =~ /\p{IsDigit}/);
print "string positive - $string \n"    if ($string =~ /\p{IsWord}/);
print "space  positive - $space \n" if ($space =~ /\p{IsSpace}/);

print "numero negation - $num \n"   if ($num =~ /\D/);
print "string negation - $string \n"    if ($string =~ /\W/);
print "space  negation - $space \n" if ($space =~ /\S/);

print "numero negation - $num \n"   if ($num =~ /\P{IsDigit}/);
print "string negation - $string \n "if ($string =~ /\P{IsWord}/);
print "space  negation - $space \n" if ($space =~ /\P{IsSpace}/);

results 

$perl  blog.pl
 texto gerado automaticamente pelo sistema lattes 
 textOoO geradOoO autOoOmaticamente pelOoO sistema lattes 
+texto-gerado-automaticamente-pelo-sistema-lattes++
comand     line
comand ... line
numero positive - 10 
string positive - line 
space  positive -   
numero positive - 10 
string positive - line 
space  positive - 

Tuesday, November 1, 2011

Perl - [ Relational operators ]



numeric                     string
  >                                gt
  >=                             ge
  <                                lt
 <=                              le
  ==                             eq
  !=                              ne
<=>                             cmp

Friday, October 28, 2011

Perl - Pattern Matching [ Print`s ... ]

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

my $text = "encrypted key\n";

if ($text =~  /key/){
    print qq/$text new print !\n/;
}
if(lc ($text) =~ /key/){
    print "$text";
}

$text = "/home /andre /work /tmp /bin";
if($text =~ m[/bin]){
    print "Directory /tmp found!\n";
}

$text = "andre luiz\n";
$text =~ s(andre)<AnDrE>;
$text =~ s[l]/L/;
$text =~ s{uiz}{UIZ};

print $text;

$text = "Andre Luiz Silva";
$text =~ /Luiz/;

print "$text\n ";
print  "left :  <$`> \n";
print  "center  : <$&> \n";
print  "right  : <$'> \n";

$text =~ "andre luiz silva\n";
if ($text =~ /Andre/){ print "$text\n";}
if ($text =~ m/Andre/){ print "m/$text\n";}

$text = "aaabbb";
$text =~ s/a/A/g;
print "$text\n";

$text = "aaabbb";
$text =~ s/a/A/;
print "$text\n";

$text = "aaabbb";
$text =~ tr/a/A/;
print "$text\n";

Result 

$ perl blog.pl

encrypted key
new print !
encrypted key
Directory /tmp found!
AnDrE LUIZ
Andre Luiz Silva
 left :  <Andre >
center  : <Luiz>
right  : < Silva>
Andre Luiz Silva
m/Andre Luiz Silva
AAAbbb
Aaabbb
AAAbbb

Wednesday, October 26, 2011

Perl - Pattern Matching [ regular expression ]

Metacharacter: Actually, they are very useful and have special meanings within the patterns.

/ | () [] {} ^ $ * +? .

\: The backslash and a wildcard that has the 'power' to transform into something special character literal

e.g. \ b \ D \ t \ 3

Pattern

#!/usr/bin/perl

use strict;
use warnings;

my $text = "Actually, they are very useful and have special meanings within the patterns.\n";
print $text if ($text =~ / special | WhichEitherStandard /);

$text = "thethe men the Women the children\n";
print $text if ($text =~ /(the){2}/);


$text = "theee men the Women the children\n";
print $text if ($text =~ /the{3}/);



$text = "the men the Women the children\n";
print $text if ($text =~ /^the/);


$text = "the men the Women the children ...the\n";
print $text if ($text =~ /the$/);


$text = "Perl -> windows \n";
print $text ;
$text =~ s/windows/linux/;
print $text ;


$text = "Perl -> linux \n";
$text =~ tr/linux/l***x/;
print $text ;

$text = "encrypted key\n";
print $text ;
$text =~ tr/a-zA-Z/n-za-mN-ZA-M/;
print $text ;


result 


$perl  command.pl 
Actually, they are very useful and have special meanings within the patterns.
thethe men the Women the children
theee men the Women the children
the men the Women the children
the men the Women the children ...the
Perl -> windows 
Perl -> linux 
Perl -> l***x 
encrypted key
rapelcgrq xrl

Quantifiers :   Quantifiers only make sense that an atom attached to.


*  +  ?  *?  {3}  {1,2}

Monday, October 24, 2011

Perl - (school media) [hash , array]

#file txt separado por tab

alunosnotasbimestral
ayes    8.5 6.5 7.0 10.0
andre   7.0 9.0 8.5 8.5
la  9.0 7.0 4.5 7.5
gui 4.5 8.0 8.0 6.0
lu  4.0 4.0 4.0 4.0
-----------------------------------------------------------------------------------------------------------------------------
#!usr/bin/perl
use strict;
use warnings;

my %nomes;
my $media = 0;
my $qnt = 4;
open(IN,'alunosnotasbimestral') or die $!;
while(<IN>){
        my($id,@notas) = split(/\t/,$_);
        @{$nomes{$id}} = @notas;
        
}
close(IN);
foreach my $key(keys %nomes){
        for(my $i = 0; $i < 4; $i++){
                $media += $nomes{$key}[$i];
        }
        $nomes{$key}[4] = $media/4;
        $media = 0;
}
foreach my $key(keys %nomes){
        print "\n $key : ";
        for(my $i = 0; $i < 5; $i++){
                print " $nomes{$key}[$i] ";
        }
        print"\n";
}

result 
$perl blog.pl

 ayes :  8.5 6.5 7.0 10.0
 8

 la :  9.0 7.0 4.5 7.5
 7

 gui :  4.5 8.0 8.0 6.0
 6.625

 andre :  7.0 9.0 8.5 8.5
 8.25

 lu :  4.0 4.0 4.0 4.0
 4

Saturday, October 22, 2011

Mysql - [ Sub Query ] function (exists,)


mysql> select * from tabela3;
+--------+--------+-------+------------+
| nome   | codigo | idade | data       |
+--------+--------+-------+------------+
| gilmar |      1 |    24 | 2011-10-10 |
+--------+--------+-------+------------+
1 row in set (0.00 sec)

mysql> select * from tabela2;
+-----------+-------+--------+------------+
| nome1     | idade | codigo | data       |
+-----------+-------+--------+------------+
| higor     |    20 |      3 | 2011-10-10 |
| alexandre |    20 |      4 | 2011-10-19 |
+-----------+-------+--------+------------+
2 rows in set (0.00 sec)

mysql> select * from tabela1;
+--------+-------+--------+------------+
| nome   | idade | codigo | data       |
+--------+-------+--------+------------+
| andre  |    20 |      3 | 2011-10-18 |
| murilo |    20 |      4 | 2011-10-19 |
+--------+-------+--------+------------+
2 rows in set (0.00 sec)

Query  =  select the table 2 that has the date equal to the 'gilmar' table 3.
From the date of the selected second table [ Table 1 lists all of whom date greater than the selected date from table 2 ]

Selecione na 2 tabela que tem a data igual a do 'gilmar' da 3 tabela.
A parti da data selecionada da 2 tabela [ liste todos da 1 tabela quem a data maior que a data selecionada da tabela 2 ]

mysql> select * from tabela1 where data > (select data from tabela2 where data = (select data from tabela3 where nome='gilmar'));
+--------+-------+--------+------------+
| nome   | idade | codigo | data       |
+--------+-------+--------+------------+
| andre  |    20 |      3 | 2011-10-18 |
| murilo |    20 |      4 | 2011-10-19 |
+--------+-------+--------+------------+
2 rows in set (0.00 sec)


Criando uma nova tabela,
Inserindo valores 


mysql> create table tabela4 (nome varchar(45), codigo int primary key auto_increment, idade int, data date);
Query OK, 0 rows affected (0.21 sec)

mysql> insert into tabela4 (nome, idade, data) values ('gilmar', 24, '2011-10-10');
Query OK, 1 row affected (0.01 sec)

mysql> insert into tabela4 (nome, idade, data) values ('ediel', 24, '2011-10-11');
Query OK, 1 row affected (0.00 sec)

 Query = same query a table with the most (Table 4)


mysql> select * from tabela1 where data > (select data from tabela2 where data = (select data from tabela3 where nome=(select nome from tabela4 where nome='gilmar')));
+--------+-------+--------+------------+
| nome   | idade | codigo | data       |
+--------+-------+--------+------------+
| andre  |    20 |      3 | 2011-10-18 |
| murilo |    20 |      4 | 2011-10-19 |
+--------+-------+--------+------------+
2 rows in set (0.00 sec)

select * from tables [ tabela (1..4)]#          -> invalid

mysql> select * from tabela1;
+--------+-------+--------+------------+
| nome   | idade | codigo | data       |
+--------+-------+--------+------------+
| andre  |    20 |      3 | 2011-10-18 |
| murilo |    20 |      4 | 2011-10-19 |
+--------+-------+--------+------------+
2 rows in set (0.00 sec)

mysql> select * from tabela2;
+-----------+-------+--------+------------+
| nome1     | idade | codigo | data       |
+-----------+-------+--------+------------+
| higor     |    20 |      3 | 2011-10-10 |
| alexandre |    20 |      4 | 2011-10-19 |
+-----------+-------+--------+------------+
2 rows in set (0.00 sec)

mysql> select * from tabela3;
+--------+--------+-------+------------+
| nome   | codigo | idade | data       |
+--------+--------+-------+------------+
| gilmar |      1 |    24 | 2011-10-10 |
+--------+--------+-------+------------+
1 row in set (0.01 sec)

mysql> select * from tabela4;
+--------+--------+-------+------------+
| nome   | codigo | idade | data       |
+--------+--------+-------+------------+
| gilmar |      1 |    24 | 2011-10-10 |
| ediel  |      2 |    24 | 2011-10-11 |
+--------+--------+-------+------------+
2 rows in set (0.00 sec)

Query Selection of different tables with the same attribute (exists)


mysql> select * from tabela3 where exists (select nome from tabela4 where tabela4.nome = tabela3.nome);
+--------+--------+-------+------------+
| nome   | codigo | idade | data       |
+--------+--------+-------+------------+
| gilmar |      1 |    24 | 2011-10-10 |
+--------+--------+-------+------------+
1 row in set (0.00 sec)

try to understand !!!

mysql> select * from tabela1 where data > (select data from tabela2 where data = (select data from tabela3 where nome=(select nome from tabela4 where nome=(select nome from tabela3 where exists (select nome from tabela4 where tabela4.idade = tabela3.idade)))));
+--------+-------+--------+------------+
| nome   | idade | codigo | data       |
+--------+-------+--------+------------+
| andre  |    20 |      3 | 2011-10-18 |
| murilo |    20 |      4 | 2011-10-19 |
+--------+-------+--------+------------+
2 rows in set (0.00 sec)

mysql> create table tabela5 (nome varchar(45), codigo int primary key auto_increment, idade int, data date);Query OK, 0 rows affected (0.51 sec)

mysql> insert into tabela5 (nome, idade, data) values ('andre', 20, '2011-10-18');Query OK, 1 row affected (0.00 sec)

mysql> insert into tabela5 (nome, idade, data) values ('murilo', 20, '2011-10-19');
Query OK, 1 row affected (0.00 sec)


mysql> desc tabela1;
+--------+-------------+------+-----+---------+----------------+
| Field  | Type        | Null | Key | Default | Extra          |
+--------+-------------+------+-----+---------+----------------+
| nome   | varchar(45) | YES  |     | NULL    |                |
| idade  | int(11)     | YES  |     | NULL    |                |
| codigo | int(11)     | NO   | PRI | NULL    | auto_increment |
| data   | date        | YES  |     | NULL    |                |
+--------+-------------+------+-----+---------+----------------+
4 rows in set (0.00 sec)

mysql> desc tabela5;  # paste table 1 , next post continues ...
+--------+-------------+------+-----+---------+----------------+
| Field  | Type        | Null | Key | Default | Extra          |
+--------+-------------+------+-----+---------+----------------+
| nome   | varchar(45) | YES  |     | NULL    |                |
| codigo | int(11)     | NO   | PRI | NULL    | auto_increment |
| idade  | int(11)     | YES  |     | NULL    |                |
| data   | date        | YES  |     | NULL    |                |
+--------+-------------+------+-----+---------+----------------+
4 rows in set (0.00 sec)

mysql> show tables;
+-----------------+
| Tables_in_aula1 |
+-----------------+
| tabela1         |
| tabela2         |
| tabela3         |
| tabela4         |
+-----------------+
4 rows in set (0.00 sec)

mysql> Bye


Friday, October 21, 2011

Perl [ hash - Single sample ]

Assuming you have a sample with a column that presenter replications.
you to remove repetitions and maintain a single sample!

-----------------------------------------------------------------------------------------------------------

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


various boot
=cut   # commeted 
my %hash;
$hash{1}='hard';
$hash{1}='soft';
$hash{1}='hard';
$hash{1}='soft';
$hash{2}='perl';
$hash{2}='linux';
$hash{2}='perl';
$hash{2}='linux';
=cut



my %hash=('hard'=>'1',
        'soft'=>'2',
        'hard'=>'3',
        'soft'=>'4',
        'perl'=>'5',
        'linux'=>'6',
        'perl'=>'7',
        'linux'=>'8');


my %hashTmp;
foreach my $key (keys %hash){
    if(exists $hashTmp{$key}){
        next;
    }else{
        $hashTmp{$key} = $hash{$key};
        print "single sample - $key\n";
    }
}


$perl command_line.pl


single sample - perl
single sample - soft
single sample - linux
single sample - hard

Thursday, October 20, 2011

Perl - [ Hash / Sub / Sort / Keys ]


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

my (%HoHoA);

@{$HoHoA{'1'}{'1'}} = (1..10);
@{$HoHoA{'1'}{'2'}} = (11..20);
@{$HoHoA{'1'}{'3'}} = (21..30);
@{$HoHoA{'1'}{'4'}} = (31..40);

&print_ed(\%HoHoA);

sub print_ed{
    my ($rHoHoA) = @_;

    foreach my $kA (keys %{$rHoHoA}){
        foreach my $kB ( sort{$rHoHoA->{$kA}{$b}[1] <=> $rHoHoA->{$kA}{$a}[3] } keys %{$rHoHoA->{$kA}}){
            print "$kA : $kB\t " , join("\t",@{$rHoHoA->{$kA}{$kB}}) , "\n";

        }
    }
}
Resul 

$ perl blog.pl 

1 : 4 31 32 33 34 35 36 37 38 39 40
1 : 3 21 22 23 24 25 26 27 28 29 30
1 : 2 11 12 13 14 15 16 17 18 19 20
1 : 1 1 2 3 4 5 6 7 8 9 10



Tuesday, October 18, 2011

Perl - [ Functions / Reference ]

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

&a();

sub a{

        my @nome = ('ayres','andre');
        print "Rotina a antes: " , join ("\t",@nome) , "\n";
        &print_a(\@nome);
        print "Rotina a depois: " , join ("\t",@nome) , "\n";

}

sub print_a{

        my ($rA_teste) = @_;
        print "Antes push: " , join ("\t",@{$rA_teste}) , "\n";
        push(@{$rA_teste}, 'Mudim');
        print "Depois push: " , join ("\t",@{$rA_teste}) , "\n";

}
result 


$perl blog.pl 
Rotina a antes: ayres andre
Antes push: ayres andre
Depois push: ayres andre Mudim
Rotina a depois: ayres andre Mudim

Perl - [ References /pointers variables ]


Anyone familiar with the C language (and other), you know whatpointers are and how programming can become proficient with its use. References are pointers to previously defined data types(whether it's scalars, arrays or hashes). Through references it is possible to obtain the contents of a scalar variable, an array or ahash the same as using the original name.
------------------------------------------------------------------------------------------------------------------------------
#!/usr/bin/perl

use strict;
use warnings;

my (%HoA,$valor,@nome);
#References scalar ($)
$valor = 10;
my $rvalor = \$valor;
print "$$rvalor\n";

#References array (@)
@nome = ('andre','ayres');
my $rnome = \@nome;
print "$$rnome[0]\n";



#References hash (%)

@{$HoA{'1'}} = (1..10);
print join("\t",@{$HoA{1}}) , "\n";

my $rHoA = \%HoA;
print join ("\t",@{$rHoA->{1}});

result 

$perl tmp.pl 

10
andre
1 2 3 4 5 6 7 8 9 10
1 2 3 4 5 6 7 8 9 10

Friday, October 14, 2011

Perl - ( if ) [ testing if uninitialized variable! ]


#!/usr/bin/perl

use strict;
use warnings;
my $key ; not initialized

if($key != 0){ # line 7
    print "1ok\n";
}
if($key != ''){  # line 10
    print "2ok\n";
}
if($key ne 0){ # line 13
    print "3ok\n";
}
if($key ne ''){ #line  16
    print "4ok\n";
}
if($key){ # line 19
    print "5ok\n";
}

resul


$ perl tmp.pl
Use of uninitialized value $key in numeric ne (!=) at tmp.pl line 7.
Argument "" isn't numeric in numeric ne (!=) at tmp.pl line 10.
Use of uninitialized value $key in numeric ne (!=) at tmp.pl line 10.
Use of uninitialized value $key in string ne at tmp.pl line 13.
3ok
Use of uninitialized value $key in string ne at tmp.pl line 16.


--------------------------------------------------------------------------------------------------------------------------------

#!/usr/bin/perl

use strict;
use warnings;
my $key = 1 ;  initialized

if($key != 0){
    print "1ok\n";
}
if($key != ''){
    print "2ok\n";
}
if($key ne 0){
    print "3ok\n";
}
if($key ne ''){
    print "4ok\n";
}
if($key){
    print "5ok\n";
}

result 

$ perl tmp.pl

1ok
Argument "" isn't numeric in numeric ne (!=) at tmp.pl line 10.
2ok
3ok
4ok
5ok
--------------------------------------------------------------------------------------------------------------------------------

Thursday, October 13, 2011

Perl Hash [SINTAXE]

 high voltage =)
----------------------------------------------------------------------------------------------------------------------------------
#!/usr/bin/perl
use strict;
use warnings;\

my $key = 1;
my $hash;

@{$hash->{$key}} = ("10","11");
$hash->{1}[2] = "sintaxe\n";
print join ("|",@{$hash->{1}});

Result

$ perl tmp.pl 
10|11|sintaxe

Friday, October 7, 2011

Perl - [ Expression ]


#!/usr/bin/perl

use strict;
use warnings;

my $var = 'LGMB-RP_06242011_HGWSI_1.fastq.sai.sam.bam.sort.bam';
if( $var =~ /^(.*)\.fastq/ ){
    $var = $1;
}
print"$var\n";

$var = 'LGMB-RP_06242011_HGWSI_1.fastq.sai.sam.bam.sort.bam';
$var = "$1.sam" if( $var =~ /^(.*)\.sam/ );
print"$var\n";


$ perl t.pl
LGMB-RP_06242011_HGWSI_1
LGMB-RP_06242011_HGWSI_1.fastq.sai.sam


Thursday, October 6, 2011

Perl -[ if , unless ]


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

my $val = 1;

#first  
print "first (if)\n";
if($val > 1){
    print "if > 1\n";
}else{
    print "else <= 1\n";
}   

not functional
#second 
print "second (if)\n";
$val = 2;
if($val < 1){
    print "if < 1\n";
}unless($val > 1){
    print "unless < 1\n";
}   

#third
print "third (if)\n";
$val = 'a';
if($val =~ 'a'){
        print "if = a\n";
}unless($val =~ 'b'){
        print "unless != a\n";

result 

first (if)
else <= 1
second (if)
third (if)
if = a
unless != a 


Perl - A [ Switch ] statement


Necessary import library.
Initialize the variable and play ($val).



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

use Switch;
my $val = 'a';
switch ($val) {
      case 1      { print "number 1" }
      case "a"    { print "string a" }
      case [1..10,42] { print "number in list" }
      case /\w+/  { print "pattern" }
      case qr/\w+/    { print "pattern" }
      else { print "previous case not true" }
}

Wednesday, October 5, 2011

Perl - [Function] (Sort)


  • Number
#!usr/bin/perl
use strict;
use warnings;

my @blog = (1,7,6,34,2,46,7);

print "disorderly\n";
print join (" ",@blog);

@blog = sort @blog;
print "\norderly - the first number\n";
print join (" ",@blog);

print "\norderly - the complete number( descending order )\n";
@blog = sort {$b <=> $a} @blog;
print join (" ",@blog);

print "\norderly - the complete number( ascending order )\n";
@blog = sort {$a <=> $b} @blog;
print join (" ",@blog);


Result 

$ perl blog.pl 



disorderly
1 7 6 34 2 46 7
orderly - the first number
346 6 7 7
orderly - the complete numberdescending order )
46 34 7 7 6 2 1
orderly - the complete number( ascending order )
1 2 6 7 7 34 46

-------------------------------------------------------------------------------------------------------------------------------
  • String 

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

my @blog = ('oi','tim','claro','vivo','nextel');
print "Disorderly : \n";
print join ("\t",@blog);

@blog = sort @blog;
print "\nOrderly : \n";
print join("\t",@blog);

@blog = ('cab','abc','abb','aaa','baa');
print "\nDisorderly : \n";
print join ("\t",@blog);

@blog = sort @blog;
print "\nOrderly : \n";
print join("\t",@blog);

Result 

$ perl blog.pl 



Disorderly :
oi tim claro vivo nextel
Orderly :
claro nextel oi tim vivo

Disorderly :
cab abc abb aaa baa
Orderly :
aaa abb abc baa cab
----------------------------------------------------------------------------------------------------------------------------------


continues soon ...

Friday, September 30, 2011