package foobar; 
 
my $m_Self = undef; 
my $m_LastError = ""; 
 
sub new { 
  my $type = @_; 
  $m_Self = {}; 
  bless $m_Self, $type; 
  return $m_Self; 
}   
sub __foo { #private 
  if ($_[0] eq $m_Self) {  
    $m_LastError = "Access to private method denied."; 
    return -1; 
  } 
  my $name = shift(@_); 
  print "Hello $name.\n"; 
  return 0; 
} 
 
sub run {#public, but can also be called from this package. 
  if ($_[0] eq $self) { shift(@_); } 
  my $name = shift(@_); 
  return __foo($name); 
} 
 
sub iAmFoobar { #public 
  return run("foobar"); 
} 
1;

package TacoBell; 
our @ISA = qw(foobar); 
 
my $m_Self = undef; 
 
sub new { 
    my ($type) = @_;     
    $m_Self = $type->SUPER::new(); 
    bless $m_Self, $type; 
    return $m_Self; 
} 
 
sub burrito { 
   return $m_Self->SUPER::__foo("Charles"); 
} 
1;

 
  if ($_[0] eq $self) {  
    my $me = shift; 
     
    if ($me->isa(__PACKAGE__) ){ 
      print("is a package.\n"); 
    } else { print "not a package.\n"; }

 
package foobar;  
use Carp; 
  
sub new {  
  my $class = shift;  
  my $self = {};  
  bless ($self, $class); 
  return $self; 
}    
 
sub __foo { #private  
  my $name = shift; 
  if ( ref($name) ) { 
      my $self = $name; 
      # make it private 
      if ( ref($self) ne __PACKAGE__ ) { 
          confess("Access to private method denied."); 
      } 
      $name = shift; 
  } 
  print "Hello $name.\n"; 
  return 0;  
}  
  
sub run {#public, but can also be called from this package.  
  my $name = shift; 
  if ( ref($name) ) { 
     my $self = $name; 
     $name = shift; 
     return $self->__foo($name); 
  }  
  else { 
    return  __foo($name); 
  } 
}  
  
sub iAmFoobar { #public  
  return run("foobar");  
}  
1;

package TacoBell; 
 
use parent foobar;            
  
sub new {  
    my $class = shift; 
    my $self = $class->SUPER::new(); 
    #my $self = {}; 
    #bless ($self, $class); 
    return $self;  
}  
  
sub burrito {  
    my $self = shift; 
    return $self->__foo("Charles");   
    # calling the inherited __foo from parent will fail 
}  
 
sub burrito2 { 
    my $self = shift; 
    # use this form if you need the super class's method  
    # to run before your overrides take place 
    my $x = $self->SUPER::__foo("Charles"); 
    # override some stuff 
    return $x; 
} 
 
1;

perl -MTacoBell -le '$t=TacoBell->new();$t->iAmFoobar' 
Hello foobar. 
 
perl -MTacoBell -le '$t=TacoBell->new();$t->__foo("Chuck")' 
Access to private method denied. at foobar.pm line 17. 
	foobar::__foo('TacoBell=HASH(0x605998)', 'Chuck') called at -e line 1 
 
perl -Mfoobar -le '$t=foobar->new();$t->iAmFoobar' 
Hello foobar. 
 
perl -Mfoobar -le '$t=foobar->new();$t->__foo("Chuck")' 
Hello Chuck. 
 
 
perl -MTacoBell -le '$t=TacoBell->new();$t->burrito()' 
Access to private method denied. at foobar.pm line 15. 
	foobar::__foo('TacoBell=HASH(0x605998)', 'Charles') called at TacoBell.pm line 17 
	TacoBell::burrito('TacoBell=HASH(0x605998)') called at -e line 1 
 
perl -MTacoBell -e '$t=TacoBell->new();$t->burrito2()' 
Access to private method denied. at foobar.pm line 15. 
	foobar::__foo('TacoBell=HASH(0x605a70)', 'Charles') called at TacoBell.pm line 26 
	TacoBell::burrito2('TacoBell=HASH(0x605a70)') called at -e line 1

$ret_code = $t->__foo("Charles"); 
print "RC: $ret_code\n"; 
if ($ret_code != 0) { print "t->__foo(\"Charles\") failed.\n"; }

use parent 'fooBar';

sub __foo { #private  
  my $name = shift; 
  if (ref($name)) { 
    my $self = $name; 
    unless ( (caller)[0]->isa( ref($self) ) ) { 
      $m_LastError = "Access to private method denied."; 
      return -1; 
    } 
    $name = shift; 
  } 
  print "Hello $name.\n";  
  return 0;  
}

my $ret_code = 0; 
 
print "TacoBell:\n"; 
my $t = TacoBell->new(); 
$ret_code = $t->iAmfooBar(); 
if ($ret_code) { print "t->iAmfooBar() failed.\n"; } 
$ret_code = $t->__foo("Charles"); 
if ($ret_code) { print "t->__foo(\"Charles\") failed.\n"; } 
 
print "fooBar:\n"; 
my $fb = fooBar->new(); 
$ret_code = $fb->iAmfooBar(); 
if ($ret_code) { print "f->iAmfooBar() failed.\n"; } 
$ret_code = $fb->__foo("d'oh"); 
if ($ret_code) { print "f->__foo(\"d'oh\") failed.\n"; }

Output: 
TacoBell: 
Hello fooBar. 
t->__foo("Charles") failed. 
fooBar: 
Hello fooBar. 
f->__foo("d'oh") failed.

in fooBar.pm: 
  our $m_LastError; 
 
in TacoBell.pm: 
  print $fooBar::m_LastError;

in fooBar: 
sub getLastError { 
    return $m_LastError; 
} 
 
in TacoBell: 
  print $self->getLastError(),"\n";

sub lastError { 
    my $self = shift; 
    if (@_) { 
          $self->{"_LAST_ERROR"} = shift; 
    } 
    return $self->{"_LAST_ERROR"}; 
} 
 
in TacoBell: 
   print $self->lastError();     # get it 
   $self->lastError("something happened");   # set it

sub __foo { #private  
  my $name = shift; 
  if (ref($name)) { 
    my $self = $name; 
    unless ( (caller)[0]->isa( ref($self) ) ) { 
        $self->lastError("Access to private method denied. $_[0]"); 
        $m_LastError = "Access to private method denied. $_[0]"; 
        return -1; 
    } 
    $name = shift; 
    if ( $name =~ /Burr/ ) { 
        $self->lastError("Weeeee Burrito!"); 
    } 
  } 
  print "Hello $name.\n"; 
  return 0; 
} 
 
# here is you class attribute accessor 
sub GetLastError { 
    return $m_LastError; 
} 
 
# using the object data 
sub lastError { 
    my $self = shift; 
    if (@_) { 
        $self->{"_LAST_ERROR"} = shift; 
    } 
    return $self->{"_LAST_ERROR"}; 
}

print "TacoBell:\n"; 
my $t = TacoBell->new(); 
$ret_code = $t->iAmfooBar(); 
if ($ret_code) { print "t->iAmfooBar() failed.\n"; } 
$ret_code = $t->__foo("Charles"); 
if ($ret_code) { print "t->__foo(\"Charles\") failed.\n"; } 
$ret_code = $t->burrito(); 
if ($ret_code) { print "t->burrito() failed.\n"; } 
print $t->GetLastError(); 
 
 
print "\nTacoBell2:\n"; 
my $tb = TacoBell->new(); 
$ret_code = $tb->iAmfooBar(); 
if ($ret_code) { print "tb->iAmfooBar() failed.\n"; } 
$ret_code = $tb->__foo("Peter"); 
if ($ret_code) { print "tb->__foo(\"Peter\") failed.\n"; } 
print $t->GetLastError(),"\n"; 
print $t->lastError(),"\n"; 
print $tb->GetLastError(),"\n"; 
print $tb->lastError(),"\n";

TacoBell2: 
Hello fooBar. 
tb->__foo("Peter") failed. 
Access to private method denied. Peter  <--- WRONG 
Weeeee Burrito! 
Access to private method denied. Peter 
Access to private method denied. Peter

 my $m_Self; 
 my $m_LastError;

sub new { 
  my ($type) = @_; 
  my $self = {};  
  bless($self, $type);    
  return $self;   
} 
 
sub lastError { 
    my $self = shift; 
    if (@_) { 
        $self->{"_LAST_ERROR"} = shift; 
    } 
    return $self->{"_LAST_ERROR"}; 
}

sub run { 
   my $this = shift; 
   if ( ref($this) ) { return $this->__foo(+shift) } 
   else { return __foo($this) }    
}

sub __foo { 
   my $this = shift; 
   if ( ref($this) ) { 
      unless (  (caller)[0]->isa( ref($this) ) ) { 
         $this->lastError("Access to private method denied."); 
         return -1; 
      } 
   } 
   my $name = ref($this) ? shift : $this; 
   print "Hello $name\n"; 
   return 0;    
}

	package fooBar; 
        use Modern::Perl; 
	use Moose; 
 
        my $m_LastError = ''; 
         
        after 'new' => sub { say "created instance from ".__PACKAGE__ }; 
 
	has iAmFooBar => ( 
	   isa => 'Str', 
	   is  => 'ro', 
	   lazy => 1, 
	   default => sub { run("fooBar") }, 
	   ); 
 
	has lastError => ( 
	   isa => 'Str', 
	   is  => 'rw', 
	   default => '', 
	   ); 
	around lastError => sub { 
            my $orig = shift; 
            my $self = shift; 
            return blessed $self ? $self->$orig(@_) : $m_LastError ;  
	   }; 
	 
	    
	has priv_attrib => ( 
	   isa => 'Int', 
	   is => 'ro', 
	   writer => 'private_set_attrib', 
	   default => sub { shift->default_value } 
	   ); 
         
        has run => (is => 'rw'); 
        around 'run' => sub { 
            my $orig = shift; 
            my $self = shift; 
            return blessed $self ? $self->__foo(@_) : __foo($self,@_);  
        }; 
 
 
        sub isa_friend { 
            my $class = shift; 
            my $this = shift; 
            if ( blessed $this ) { 
               unless ( $class->isa( ref($this) ) ) { 
                  $this->lastError("Access to private method denied."); 
                  return 0; 
               } 
            } 
            return 1; 
        } 
 
        sub default_value { return 0 } 
         
	sub __foo { 
	   my $this = shift; 
	   # private access only 
	   my $class = (caller)[0]; 
	   return -1 unless isa_friend( $class, $this); 
	   my $name = blessed $this ? shift : $this; 
	   print "Hello $name\n"; 
	   my $error_occurred = 0; # to test modular code 
	   if ( ! blessed $this && $error_occurred != 0 ) { 
	       $m_LastError = "some error"; 
	       return $error_occurred; 
	   } 
	   else { $m_LastError = "" } 
	   return 0;    
	} 
 
 
	1;

	package TacoBell; 
        use Modern::Perl; 
	use Moose; 
	extends 'fooBar'; 
	 
	after 'new' => sub { say "we can add stuff in ".__PACKAGE__ }; 
	 
	has burrito => ( 
           is  => 'ro', 
           isa => 'Str', 
           default => sub { 
               my $self = shift; 
               my $retcode = $self->__foo("Burrito!"); 
               $self->lastError("problem with burrito") if $retcode; 
               return $retcode; 
            }, 
            lazy => 1, 
            ); 
                
 
	1;

#!/usr/bin/perl 
use Modern::Perl; 
use TacoBell; 
my $tb = TacoBell->new(); 
 
say "private var is ".$tb->priv_attrib(); 
$tb->private_set_attrib(55); 
say "private var is now ".$tb->priv_attrib(); 
 
# cause read-only error 
#$tb->priv_attrib(10); 
 
say "\ntb->Burrito:"; 
my $retcode = $tb->burrito(); 
say "RC: $retcode ", $tb->lastError(); 
 
say "\ntb->iAmFooBar:"; 
$retcode = $tb->iAmFooBar(); 
say "RC: $retcode ", $tb->lastError(); 
 
say "\ntb->__foo test"; 
$retcode = $tb->__foo("test"); 
say "RC: $retcode ", $tb->lastError(); 
 
 
say "\nFooBar:"; 
my $fb = fooBar->new(); 
 
say "\nfb->iAmFooBar:"; 
$retcode = $fb->iAmFooBar(); 
say "RC: $retcode ", $fb->lastError(); 
 
say "\nfb->__foo test"; 
$retcode = $fb->__foo("test"); 
say "RC: $retcode ", $fb->lastError(); 
 
# don't do this :) 
#say "\nModular test for __foo test"; 
#$retcode = fooBar::__foo("test"); 
#say "RC: $retcode ", fooBar::lastError();

created instance from fooBar 
we can add stuff in TacoBell 
private var is 0 
private var is now 55 
 
tb->Burrito: 
Hello Burrito! 
RC: 0  
 
tb->iAmFooBar: 
Hello fooBar 
RC: 0  
 
tb->__foo test 
RC: -1 Access to private method denied. 
 
FooBar: 
created instance from fooBar 
 
fb->iAmFooBar: 
Hello fooBar 
RC: 0  
 
fb->__foo test 
RC: -1 Access to private method denied.

my @strArray = obj->getStructArray(); 
print $strArray[0]->data . "\n";

sub getStructArray{  
  my $self = shift;  
  return $self->{_StructArray}; 
}  
sub getStructArray{ 
  my $self = shift; 
  return @{$self->{_StructArray}}; 
} 
sub getStructArray{  
  my $self = shift;  
  my @tmp= $self->{_StructArray}; 
  return @tmp; 
}  
 
sub getStructArray{  
  my $self = shift;  
  my @tmp= @{$self->{_StructArray}}; 
  return @tmp; 
}