Perl - [ Shift ]

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

my %hash = ('1' => 'Perl','2' => 'Linux','3' => 'Bioinformatics');

my $key = shift or die "Key not found\n";
if($key){
    print "$hash{$key}\n";
}


Result 

$ perl blog.pl 1
Perl
$ perl blog.pl 2
Linux
$ perl blog.pl 3
Bioinformatics
$ perl blog.pl
Key not found

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

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}

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

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

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

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

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 - TABLE [ REFERENCE ] \o/

Reference	Definition	Search value	Alternative
climb	$Ref = \$climb	$$Ref	${$Ref}
matrix	$Ref = \@matrix	@$Ref	@{$Ref}
element matrix	$Ref = \@matrix	@{$Ref}[0]	$Ref->[0]
hash	$Ref = \%Hash	%$Ref	%{$Ref}
element hash	$Ref = \%Hash	%{$Ref}{"Name"}	$Ref->{"Name"}

Save ....

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

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

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

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

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

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" }

}

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

1 2 34 46 6 7 7

orderly - the complete number( descending 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 ...