• Source
    1. package Persona;
    2. use strict; #Nos ponemos serios
    3.  
    4.  
    5. ######################################################################
    6. #Constructor de la clase
    7. #
    8.  
    9. sub new {
    10. my $this=shift; #Cogemos la clase que somos o una referencia a la clase (si soy un objeto)
    11. my $class = ref($this) || $this; #Averiguo la clase a la que pertenezco
    12.  
    13. my $self={}; #Inicializamos la tabla hash que contendrá las var. de instancia (NOMBRE Y EDAD)
    14. $self ->{NOMBRE} =undef ; #La clase Persona nace sin nombre
    15. $self ->{EDAD} =0 ; #La clase Persona se construye con 0 años
    16.  
    17. bless $self, $class; #Perl nos tiene que dar el visto bueno (bendecirla)
    18. return ($self); #Devolvemos la clase recién construida
    19. }
    20.  
    21. ######################################################################
    22. #Métodos de acceso a los datos de la clase
    23. #
    24.  
    25. #metodo para ver/cambiar el nombre
    26. sub nombre{
    27. my $self=shift; #El primer parámetro de un metodo es la clase
    28.  
    29. #Miramos si se le ha pasado algún parámetro, en cuyo caso será el nombre
    30. $self->{NOMBRE}=shift if (@_);
    31.  
    32. #Devolvemos el nombre
    33. return $self->{NOMBRE};
    34. }
    35.  
    36. #metodo para ver/cambiar la edad
    37. sub edad{
    38. my $self=shift; #El primer parámetro de un metodo es la clase
    39.  
    40. #Miramos si se le ha pasado algún parámetro, en cuyo caso será la edad
    41. $self->{EDAD}=shift if (@_);
    42.  
    43. #Devolvemos el nombre
    44. return $self->{EDAD};
    45. }
    46.  
    47. ######################################################################
    48. #Métodos de la clase
    49. #
    50.  
    51. #metodo para cumplir años
    52. sub cumple{
    53. my $self=shift; #El primer parámetro de un metodo es la clase
    54.  
    55. #Incrementamos la edad
    56. $self->{EDAD}++;
    57.  
    58. #Devolvemos el nombre
    59. return $self->{EDAD};
    60. }
    61.  
    62.  
    63. ######################################################################
    64. #Destructor
    65. #
    66.  
    67. sub DESTROY {
    68. my $self=shift; #El primer parámetro de un metodo es la clase
    69. delete ($self->{NOMBRE});
    70. delete ($self->{EDAD});
    71. }
    72.  
    73. #Fin
    74. 1;
    75.