# objects and inheritance in perl.

sub newteam
{
    my ($wins,$losses) = (0,0);

    my $win = sub { $wins += 1 };
    my $lose = sub {$losses += 1 };
    my $wp = sub    # calculate winning percentage
     {
         print "calling superclass team method\n";
	 my $total = $wins + $losses;
         if ($total == 0) {0} else {$wins*1.0/$total}
     };

    my $betterthan = sub
    {   
	my $this = shift;  # rigged, not uniform.
	my $other = shift;
	my $x = $other->("percentage")->();
	#$wp->() > $x;   # will not implement dynamic dispatch.
	$this->("percentage")->() > $x;
    };

    my $printrecord = sub
    {
	print "wins: ", wins, "\n";
	print "losses: ", losses, "\n";
    };

    my ($public,$protected);   # must declare first because of mutual reference

    $public =  # public interface:
    sub {
           my $req = $_[0]; 
	   if ($req eq "win") {return $win}   # use eq instead of == to compare
	   if ($req eq "lose") {return $lose} # strings
	   if ($req eq "percentage") {return $wp}
	   if ($req eq "betterthan") {return $betterthan}
	   if ($req eq "record") {return $printrecord}
	   if ($req eq "inherit") {return $protected}
           else { "error" }  # die means abort
       };


    my $setwins = sub {$wins += $_[0]};
    my $setlosses = sub {$losses += $_[0]};

    $protected  =  # protected interface - allows read/write access to locals
    sub {
	my $req = shift;
	if ($req eq "getwins") { $wins }
	elsif ($req eq "getlosses") { $losses }
	elsif ($req eq "setwins") { $setwins }
	elsif ($req eq "setlosses") { $setlosses }
	else { $public->($req) }   # else let public interface handle it
    };

    $public;   # newteam() returns public interface.
}


my $giants = newteam();
my $jets = newteam();
$jets->("win")->();
$jets->("lose")->();
$jets->("win")->();
print $jets->("percentage")->(), "\n";  
#print $giants->("percentage")->(), "\n";
#print $giants->("betterthan")->($jets), "\n";

######### subclass: hockeyteam can tie:

sub newhkteam
{
    my $ties = 0;
    my $tie = sub { $ties += 1 };
    my $super = newteam()->("inherit");   # call superclass constructor
    my $wp = sub
    {
        print "calling subclass hkteam method\n";
	my $total = $ties + $super->("getwins") + $super->("getlosses");
        if ($total==0) {0} {($super->("getwins")*1.0 + $ties*0.5)/$total}	
    };

   sub {
         my $req = shift;
	 if ($req eq "tie") { $tie }
	 elsif ($req eq "percentage") {$wp}
	 else { $super->($req) }
       }
}

my $rangers = newhkteam();
$rangers->("win")->();
$rangers->("win")->();
$rangers->("tie")->();
$rangers->("lose")->();
#print $rangers->("win"), "\n";
print $rangers->("percentage")->(), "---\n";
print $jets->("betterthan")->($jets,$rangers), "\n";


# problem:

print $rangers->("betterthan")->($rangers,$jets), "\n";

# superclass' betterthan will be called both times.
# missing true dynamic dispatch.  need an additional parameter.