#
#  Short introduction in Perl and object orientation.
#
# 07-JUN-2004, Bernd Ulmann fecit.
#

###############################################################################
# Example 1 - use a simple hash to store information about a book
###############################################################################
use strict;

my %book_hash = ('title'     => 'VAX/VMS Internals and Data Structures',
                 'author'    => 'Ruth E. Goldenberg, Lawrence J. Kenah',
                 'publisher' => 'Digital Press',
                 'year'      => 1991
                );

print "Title: $book_hash{'title'}\n";

###############################################################################
# Example 2 - the same with an anonymous hash
###############################################################################
my $book_ah = {'title'     => 'Functional Programming Languages and CA',
               'author'    => 'Gilles Kahn (Ed.)',
               'publisher' => 'Springer Verlag',
               'year'      => 1987
              };

print "Title: $book_ah->{'title'}\n";

###############################################################################
# Example 3 - a subroutine to create new books
###############################################################################
sub new_book
{
  my ($title, $author, $publisher, $year, $pstate) = @_;
  my $book = {'title'     => $title,
              'author'    => $author,
              'publisher' => $publisher,
              'year'      => $year,
              'pstate'    => $pstate
             };
  return $book;
}

my $book1 = new_book ('ANSI Common LISP', 'Paul Graham', 'Prentice Hall', 
                      1996, 'Good');
print "$book1->{'title'}, preservation state: $book1->{'pstate'}\n";

###############################################################################
# Introducing behaviour
###############################################################################
sub change_preservation_state 
{
  my ($book, $new_state) = @_;
  $book->{'pstate'} = $new_state;
}

change_preservation_state ($book1, 'Fair');
print "$book1->{'title'}, preservation state: $book1->{'pstate'}\n";

###############################################################################
# We need polymorphism - e.g. for introducing journals.
#  Just using two functions to generate a book or a journal would not be
# very comfortable and readable since a distinction between both of them
# would be necessary each time a "method" would be needed to access
# data stored in "attributes" like the hash structures above.
#  The main trick is using the bless operation to tag the newly created
# data structures as belonging to one of the following two packages.
###############################################################################
package Book;
sub new
{
  my ($title, $author, $publisher, $year, $edition, $pstate) = @_;
  my $publication = {'title'     => $title,
                     'author'    => $author,
                     'publisher' => $publisher,
                     'year'      => $year,
                     'edition'   => $edition,
                     'pstate'    => $pstate
                    };
  bless $publication, 'Book'; # Magic occurs here!
  return $publication;
}
sub change_preservation_state 
{
  my ($publication, $new_state) = @_;
  $publication->{'pstate'} = $new_state;
}
sub get_date_of_publication
{
  my $publication = $_[0];
  return $publication->{'year'};
}
#------------------------------------------------------------------------------
package Journal;
sub new
{
  my ($title, $publisher, $year, $issue, $pstate) = @_;
  my $publication = {'title'     => $title,
                     'publisher' => $publisher,
                     'year'      => $year,
                     'issue'     => $issue,
                     'pstate'    => $pstate
                    };
  bless $publication, 'Journal'; # Magic occurs here!
  return $publication;
}
sub change_preservation_state 
{
  my ($publication, $new_state) = @_;
  $publication->{'pstate'} = $new_state;
}
sub get_date_of_publication
{
  my $publication = $_[0];
  return $publication->{'year'}.'/'.$publication->{'issue'};
}

###############################################################################
# Now create a book and a journal by using the class method(s) new
# and work with both of the new publications
###############################################################################
my $pub1 = Book::new ('Elementary Number Theory', 'David M. Burton',
                      'WCB', 1994, 3, 'Excellent');
my $pub2 = Journal::new ('The Analog Devices Solutions Bulletin',
                         'ANALOG DEVICES', 2004, 'February', 'Excellent');

# The following is equivalent to calling Book::get_date_of_publication($pub1);
# So much for syntactic sugar... :-) This is called an "object method" since
# this method is called "via" an object.
# The advantage of coupling methods to objects (or classes) is that the 
# programmer does not have to distinguish between different implementations
# of semantically identical methods each time one of these is called - thanks
# to bless this is done on the fly, depending on the type of object.
print $pub1->get_date_of_publication(), "\n";
print $pub2->get_date_of_publication(), "\n";

###############################################################################
# Inheritance
###############################################################################
package Publication; # This is the "base class"
sub create # Common routine to create a publication - note usage of bless :-)
{
  my ($package, $title, $author, 
      $publisher, $year, $issue, $edition, $pstate) = @_;
  my $publication = bless {'title'     => $title,
                           'author'    => $author,
                           'publisher' => $publisher,
                           'year'      => $year,
                           'issue'     => $issue,
                           'edition'   => $edition,
                           'pstate'    => $pstate
                          }, $package;
  return $publication;
}
#------------------------------------------------------------------------------
package Books;
sub new # Create a new book
{
  my ($package, $title, $author, $publisher, $year, $edition, $pstate) = @_;
  my $book = Publication::create ($package, $title, $author, $publisher,  
                                  $year, '', $edition, $pstate);
  return $book;
}
sub out # Write all relevant attributes of the object to stdout
{
  my $journal = $_[0];
  print "Journal
----------------------------------
Title:                 $journal->{'title'}
Author:                $journal->{'author'}
Publisher:             $journal->{'publisher'}
Year:                  $journal->{'year'}
Edition:               $journal->{'edition'}
State of Preservation: $journal->{'pstate'}
";
}
sub DESTROY
{
  my $book = $_[0];
  print "AAARGH! The book \"$book->{'title'}\" has been destroyed!\n";
}
#------------------------------------------------------------------------------
package Journals;
sub new # Create a new journal
{
  my ($package, $title, $publisher, $year, $issue, $pstate) = @_;
  my $journal = Publication::create ($package, $title, '', $publisher, $year,
                                     $issue, '', $pstate);
  return $journal;
}
sub out # Write all relevant attributes of the object to stdout
{
  my $journal = $_[0];
  print "Journal
----------------------------------
Title:                 $journal->{'title'}
Publisher:             $journal->{'publisher'}
Year:                  $journal->{'year'}
Issue:                 $journal->{'issue'}
State of Preservation: $journal->{'pstate'}
";
}
sub DESTROY
{
  my $journal = $_[0];
  print "AAARGH! The journal \"$journal->{'title'}\" has been destroyed!\n";
}

###############################################################################
# Now create a book and a journal (again) using the new class methods
###############################################################################
my $book2 = Books->new ('Advanced Perl Programming', 'Sriram Srinivasan',
                        'O\'Reilly', 1997, 1, 'Excellent');
my $journal2 = Journals->new ('Skeptiker', 'GWUP', 2001, 2, 'Excellent');

###############################################################################
# Now play a bit with the two objects and their methods - note that both
# objects are created in a block and are thus destroyed when leaving the 
# block, demonstrating the DESTROY methods of both of them.
###############################################################################
{
  $book2->out;
  $journal2->out;
}