html/examples/example.pm

   1 use strict;
   2 #---------------------------------------------------------------------
   3 #         Perl Class Package
   4 #---------------------------------------------------------------------
   5 package Example;
   6
   7
   8
   9 sub new {
  10         my $type  = shift;
  11         my $class = ref($type) || $type;
  12         my %parm  = @_;
  13         my @valid_parm = ( 'member_one' );
  14
  15         my %isvalid = ();
  16         foreach my $givenp ( keys %parm ) {
  17                 foreach my $validp ( @valid_parm ) {
  18                         $isvalid{$givenp} = 1 if( $givenp eq $validp );
  19                 }
  20                 die "ERROR in Example->new: Parameter $givenp is not valid\n"
  21                         unless( $isvalid{$givenp} );
  22         }
  23
  24         my $this = ref($type) ? $type : {};
  25
  26         die("Example->new: Scalar parameter member_one is of wrong type:" . ref(\$parm{'member_one'}))
  27                 if (defined $parm{'member_one'}) and !(ref(\$parm{'member_one'}) eq 'SCALAR');
  28         $this -> {'member_one'} = defined $parm{'member_one'} ? $parm{'member_one'} : 1;
  29
  30         bless $this, $class;
  31
  32         # Start of Non-Dia code #
  33
  34         print "Entering \t".ref($this)." -> new\n" if ($this -> {'debug'});
  35         print "This is code inside the constructor\n";
  36         print "Leaving \t".ref($this)." -> new\n" if ($this -> {'debug'});
  37
  38         # End of Non-Dia code #
  39
  40         return $this;
  41 };
  42
  43 sub member_one {
  44         my $self = shift;
  45         my $parm = shift;
  46
  47         # Start of Non-Dia code #
  48         print "Entering \t".ref($self)." -> member_one\n" if ($self -> {'debug'});
  49         print "And this is code inside member_one accessor\n";
  50         print "Leaving \t".ref($self)." -> member_one\n" if ($self -> {'debug'});
  51
  52         # End of Non-Dia code #
  53
  54         if( defined($parm) ){
  55                 $self -> {'member_one'} = $parm;
  56         } else {
  57                 return $self -> {'member_one'};
  58         }
  59 }
  60
  61 sub method_one {
  62         my $self = shift;
  63         my %parm  = @_;
  64         my @valid_parm = ( 'parm_one' );
  65
  66         my %isvalid = ();
  67         foreach my $givenp ( keys %parm ) {
  68                 foreach my $validp ( @valid_parm ) {
  69                         $isvalid{$givenp} = 1 if( $givenp eq $validp );
  70                 }
  71                 die "ERROR in Example->method_one: Parameter $givenp is not valid\n"
  72                         unless( $isvalid{$givenp} );
  73         }
  74
  75         die("Example->method_one: Scalar parameter parm_one is of wrong type:" . ref(\$parm{'parm_one'}))
  76                 if (defined $parm{'parm_one'}) and !(ref(\$parm{'parm_one'}) eq 'SCALAR');
  77         my $parm_one = $parm{'parm_one'};
  78
  79         my @return_value;
  80
  81         # Start of Non-Dia code #
  82
  83         print "Entering \t".ref($self)." -> method_one\n" if ($self -> {'debug'});
  84         print "This is code inside method_one\n";
  85         print "Leaving \t".ref($self)." -> method_one\n" if ($self -> {'debug'});
  86
  87         # End of Non-Dia code #
  88
  89         return \@return_value;
  90 }
  91
  92 1;
  93