martes, 24 de febrero de 2015

Perl: Constants

Constantes en Perl y Moose


Ejemplo de como usar constantes en Perl usando Moose


{
    package Parent;
    use Moose;
    use namespace::autoclean;

    use constant MY_CONSTANT => 'CONSTANT';

    use constant {
        MY_CONSTANT => 'CONSTANT'
        NO_LEVEL => 0,
        MY_LEVEL => 1,
    };

    sub printMyConstant {
        my $self = shift;
        print &MY_CONSTANT;
    }


    __PACKAGE__->meta->make_immutable;
};

{
    package Child;
    use Moose;
    use namespace::autoclean;

    extends 'Parent';

    sub printMyLevel {
        my $self = shift;
        my $class = ref $self;

        print $class->MY_LEVEL;
        print &Parent::MY_CONSTANT;
    }
    __PACKAGE__->meta->make_immutable;
}

package main;

my $child = Child->new;
$child->printMyLevel;



miércoles, 18 de febrero de 2015

Perl: Using Maybe attribute not die on undef

Perl: Moose, Using Maybe attribute not die on undef


Problema


Cuando definimos atributos en Moose con constraint en tiempo de ejecución podemos encontrarnos con el siguiente tipo de excepciones: "Attribute (AttributeName) does not pass the type constraint because: Validation failed for 'Str' with value undef"
Para evitarlo podemos usar "Maybe". A continuación un ejemplo:

Class to Test


package ClassWithMaybe;

use Moose;

has 'atributoSinConstraints' => ( 
                is => 'rw', 
                isa => 'Maybe[Str]', 
                default => '',
                reader => 'getAtributoSinConstraints',
                writer => 'setAtributoSinConstraints'
                ); # will NOT die on undef

has 'atributoConConstraints' => (
                is => 'rw', 
                isa => 'Str',
                reader => 'getAtributoConConstraints',
                writer => 'setAtributoConConstraints'
                ); # will die on undef (esto puede generar la exception mostrada anteriormente)
    
sub BUILD {
    my $self = shift;
    $self->setAtributoSinConstraints('') unless defined $self->getAtributoSinConstraints;
}

no Moose; __PACKAGE__->meta->make_immutable;

TEST


package ClassWithMaybeTest;

use Moose;
use Test::More;
use Test::Exception; #cpanm Test::Exception
use ClassWithMaybe;

throws_ok { ClassWithMaybe->new( atributoConConstraints => undef ) }
    qr/Validation failed for 'Str' with value undef/; # will die on undef
    
lives_ok  { ClassWithMaybe->new( atributoConConstraints => "with data" ) } 
    'atributoConConstraints with data ok';

lives_ok  { ClassWithMaybe->new( atributoSinConstraints => undef ) } 
    'atributoSinConstraints supplied as undef'; # will not die on undef

my $classWithMaybe = ClassWithMaybe->new( atributoSinConstraints => undef , atributoConConstraints => "with data");

is $classWithMaybe->getAtributoSinConstraints, '', "atributoSinConstraints is ''";

$classWithMaybe = ClassWithMaybe->new();
$classWithMaybe->setAtributoSinConstraints(undef);# will not die on undef

is $classWithMaybe->getAtributoSinConstraints, undef, "atributoSinConstraints is undef";

done_testing;

Run test


perl ClassWithMaybeTest.t
ok 1 - threw Regexp ((?^:Validation failed for 'Str' with value undef))
ok 2 - atributoConConstraints with data ok
ok 3 - atributoSinConstraints supplied as undef
ok 4 - atributoSinConstraints is ''
ok 5 - atributoSinConstraints is undef
1..5


References:




jueves, 12 de febrero de 2015

Perl: How to Debug in Perl

How to Debug in Perl?

Perl Debugger

Si ejecutamos perl con la opción -d se ejecuta en modo debugger.


Código para hacer debug:

#!/usr/bin/perl
# example.pl
my $name = "Daro";
my $email = "daro@daro.com.ar";
$DB::single = 1; #breakpoint
if (!defined($email)){
print "Mail es undef. \n";
}else{
print "Mail es defined. \n";
}
$DB::single = 1; #breakpoint
if (!defined($name)){
print "Name es undef. \n";
}else{
print "Name es defined. \n";
}
#end script example.pl

Ejecutar por consola:

perl -d example.pl 

Loading DB routines from perl5db.pl version 1.33
Editor support available.

Enter h or `h h' for help, or `man perldebug' for more help.

main::(ej.pl:5): my $name = "Daro";
  DB<1> c
main::(ej.pl:8): if (!defined($email)){
  DB<1> c
Mail es defined. 
main::(ej.pl:14): if (!defined($name)){
  DB<1> c
Name es defined. 
Debugged program terminated.  Use q to quit or R to restart,
  use o inhibit_exit to avoid stopping after program termination,
  h q, h R or h o to get additional info.  

  DB<1> h
List/search source lines:               Control script execution:
  l [ln|sub]  List source code            T           Stack trace
  - or .      List previous/current line  s [expr]    Single step [in expr]
  v [line]    View around line            n [expr]    Next, steps over subs
  f filename  View source in file         <CR/Enter>  Repeat last n or s
  /pattern/ ?patt?   Search forw/backw    r           Return from subroutine
  M           Show module versions        c [ln|sub]  Continue until position
Debugger controls:                        L           List break/watch/actions
  o [...]     Set debugger options        t [expr]    Toggle trace [trace expr]
  <[<]|{[{]|>[>] [cmd] Do pre/post-prompt b [ln|event|sub] [cnd] Set breakpoint
  ! [N|pat]   Redo a previous command     B ln|*      Delete a/all breakpoints
  H [-num]    Display last num commands   a [ln] cmd  Do cmd before line
  = [a val]   Define/list an alias        A ln|*      Delete a/all actions
  h [db_cmd]  Get help on command         w expr      Add a watch expression
  h h         Complete help page          W expr|*    Delete a/all watch exprs
  |[|]db_cmd  Send output to pager        ![!] syscmd Run cmd in a subprocess
  q or ^D     Quit                        R           Attempt a restart
Data Examination:     expr     Execute perl code, also see: s,n,t expr
  x|m expr       Evals expr in list context, dumps the result or lists methods.
  p expr         Print expression (uses script's current package).
  S [[!]pat]     List subroutine names [not] matching pattern
  V [Pk [Vars]]  List Variables in Package.  Vars can be ~pattern or !pattern.
  X [Vars]       Same as "V current_package [Vars]".  i class inheritance tree.
  y [n [Vars]]   List lexicals in higher scope <n>.  Vars same as V.
  e     Display thread id     E Display all thread ids.
For more help, type h cmd_letter, or run man perldebug for all docs.
  
DB<1> q




References:
http://perldoc.perl.org/perldebug.html