#!/usr/bin/perl
require 5.008;
our $VERSION = "0.02"; # 2011-01-07
our $THIS = "http://jrf.cocolog-nifty.com/archive/example_oo/example_oo_c1.pl";

## License:
##
##   I in a provincial state made this program intended to be public-domain. 
##   But it might be better for you like me to treat this program as such 
##   under the BSD-License or under the Artistic License.
##
## Author's Link:
##
##   http://jrf.cocolog-nifty.com/software/2011/01/post.html
##   (The page is in Japanese.)
##

use strict;
use warnings;
use utf8; # Japanese

##
## このコードは、上の Author's Link の記事に書いた「Perl で C++ 風のオ
## ブジェクト指向プログラミング」を行うためのサンプル。
##
## クラス変数の例、その１。
##

BEGIN {
  my @mypackage = qw(
		    Main
		    Main::_Simple
		    Main::_C1
		    Main::_C2
		 );
  foreach my $p (@mypackage) {
    eval <<"EOM";
    {
      package $p;
      use Math::Trig; # for pi
      use Storable qw(dclone);
    }
EOM
    die $@ if $@;
  }
}

package Main;

our $DEBUG = 0;

{
  package Main::_Simple;
  ## この「クラス」は example_oo.pl のものと同じ。

  my %template = ("Main::_Simple" => {});

  sub extend_template {
    my $class = shift;
    my @hash = @_;
    if (exists $template{$class}) {
      $template{$class} = {%{$template{$class}}, @hash} if @hash;
    } else {
      $template{$class} = 
	{(map {
	        $_->extend_template() if ! exists $template{$_};
	        %{$template{$_}};
	      } (eval '@{' . $class . '::ISA}')),
	 @hash
	};
    }
    return $template{$class};
  }

  sub get_template {
    my $class = shift;
    return $class->extend_template();
  }

  sub new {
    my $class = shift;
    my $obj = dclone($class->get_template());
    bless $obj, $class;
    return $obj;
  }
}

{
  package Main::_C1;
  use base qw(Main::_Simple);

  ## この「クラス」は「クラス変数」の使用例。

  our $classvar_1 = 0; # クラス変数の実体、このままでは「継承」されない。

  __PACKAGE__->extend_template
    (
     member_1 => 1.0, # ここに member_1 の説明を書こう！
     cvar_1 => \$classvar_1, # クラス変数の例
    );

  sub method_2 { # クラス変数を print するだけ。
    my $self = shift;
    print ${ref($self)->get_template()->{cvar_1}} . "\n";
  }
}

{
  package Main::_C2;
  use base qw(Main::_C1);

  ## この「クラス」は Main::_C1 を継承しただけの定義。
}

## 下の MAIN: はラベルで、特に必要はない。私のクセ。

MAIN:
{
  ## 「クラス変数」により継承先とデータを共有できる。

  my $c1 = Main::_C1->new();
  my $c2 = Main::_C2->new();

  $c1->method_2();
  $c2->method_2();
  ${Main::_C1->get_template()->{cvar_1}} = 1;
  $c2->method_2();
  ${Main::_C2->get_template()->{cvar_1}} = 2;
  $c1->method_2();
}

__END__

=pod

=head1	NAME

example_oo_c1.pl - a sample of C++-like object oriented programming in Perl.

=head1	SYNOPSIS

perl B<example_oo_c1.pl>

=head1	OPTIONS

NONE.

=head1	DESCRIPTION

A sample code to demonstrate such a trick that you can use functions
imported into the "package" in "class"es i.e. in local packages.

=head1	AUTHOR

JRF E<lt>http://jrf.cocolog-nifty.com/softwareE<gt>

=head1	LICENSE

Public Domain.

=cut