The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
########################################################################
# File:     subclass.pl
# Author:   David Winters <winters@bigsnow.org>
# RCS:      $Id: subclass.pl,v 1.1 2000/02/10 01:51:11 winters Exp winters $
#
# An example script that uses inheritance (a subclass) of a
# Persistent class.
#
# Copyright (c) 1998-2000 David Winters.  All rights reserved.
# This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
########################################################################

use strict;

use English;
use Person;

########################################################################
#
# eval all of the persistent code to catch any exceptions
#
########################################################################

my $person;

eval {
  
  mkdir('data', 0777) unless -d 'data';
  
  ### allocate a persistent object ###
  $person = new Person("dbi:mSQL:test", undef, undef, "person");
  
  ### create the table if needed ###
  create_table($person->datastore());

  ########################################################################
  #
  # clear out datastore to start tests
  #
  ########################################################################
  
  print "Deleting all objects\n";
  print "--------------------\n";
  $person->restore_all();
  $person->restore_all();
  while ($person->restore_next()) {
    $person->delete();
    print "Deleted: ";  $person->print();
  }
  print "\n";
  
  ########################################################################
  #
  # insert some objects
  #
  ########################################################################
  
  print "Inserting objects\n";
  print "-----------------\n";
  $person->firstname('Fred');
  $person->lastname('Flintstone');
  $person->telnum('650-555-1111');
  $person->age(45);
  $person->bday('1954-01-23 22:09:54');
  $person->insert();
  print "Inserted: ";  $person->print();
  
  $person->firstname('Wilma');
  $person->lastname('Flintstone');
  $person->telnum('650-555-2222');
  $person->age(38);
  $person->insert();
  print "Inserted: ";  $person->print();
  
  $person->firstname('Barney');
  $person->lastname('Rubble');
  $person->telnum('501-555-3333');
  $person->age(42);
  $person->insert();
  print "Inserted: ";  $person->print();
  
  $person->firstname('Betty');
  $person->lastname('Rubble');
  $person->telnum('408-555-4444');
  $person->age(4);
  $person->bday('1970', '06', '12');
  $person->insert();
  print "Inserted: ";  $person->print();
  
  $person->firstname('Shmu');
  $person->lastname('Moo');
  $person->telnum('415-555-5555');
  $person->age(25);
  $person->insert();
  print "Inserted: ";  $person->print();
  
  print "\n";
  
  ########################################################################
  #
  # restore all objects
  #
  ########################################################################
  
  print "Restoring all objects\n";
  print "---------------------\n";
  $person->restore_all();
  while ($person->restore_next()) {
    print "Restored: ";  $person->print();
  }
  print "\n";
  
  ########################################################################
  #
  # restore a single object
  #
  ########################################################################
  
  print "Restoring a single object\n";
  print "-------------------------\n";
  $person->restore('Betty', 'Rubble');
  print "Restored: ";  $person->print();
  print "\n";
  
  ########################################################################
  #
  # update an object
  #
  ########################################################################
  
  print "Updating an object\n";
  print "------------------\n";
  $person->lastname('Shmu');
  $person->telnum('415-555-5555');
  $person->update();
  print "Updated: ";  $person->print();
  print "\n";
  
  ########################################################################
  #
  # restoring some objects
  #
  ########################################################################
  
  print "Restore all the Flintstones in the 650 area code\n";
  print "------------------------------------------------\n";
  my $lastname = "Flintstone";
  $person->restore_where(sprintf("lastname = %s and telnum LIKE '650%%'",
				 $person->quote($lastname)));
  while ($person->restore_next()) {
    print "Restored: ";  $person->print();
  }
  print "\n";
  
  ########################################################################
  #
  # deleting an object
  #
  ########################################################################
  
  print "Deleting an object\n";
  print "------------------\n";
  $person->delete('Fred', 'Flintstone');
  print "Deleted: ";  $person->print();
  print "\n";
  
  ########################################################################
  #
  # restore an object, views its data, update its data, save it
  #
  ########################################################################
  
  print "Restoring, viewing, updating, and saving an object\n";
  print "--------------------------------------------------\n";
  $person->restore('Wilma', 'Flintstone');
  print "Data:\n";
  my $href = $person->data();
  print "href = $href\n";
  foreach my $key (keys %$href) {
    printf("key = %s, value = %s\n",
	   defined $key ? $key : 'undef',
	   defined $href->{$key} ? $href->{$key} : 'undef');
  }
  
  print "New Data:\n";
  $href = $person->data({firstname => 'Marge', lastname => 'Simpson'});
  $person->bday('1968-11-09 11:09:03');
  print "href = $href\n";
  foreach my $key (keys %$href) {
    printf("key = %s, value = %s\n",
	   defined $key ? $key : 'undef',
	   defined $href->{$key} ? $href->{$key} : 'undef');
  }
  
  $person->save();
  print "\n";
  
  ########################################################################
  #
  # clearing an object
  #
  ########################################################################
  
  print "Clearing an object\n";
  print "------------------\n";
  print "Before: ";  $person->print();
  $person->clear();
  print "After: ";  $person->print();
  print "\n";
  
  ########################################################################
  #
  # restore all objects
  #
  ########################################################################
  
  print "Restoring all objects\n";
  print "---------------------\n";
  $person->restore_all('lastname desc, firstname, telnum');
  while ($person->restore_next()) {
    print "Restored: ";  $person->print();
  }
  print "\n";
  
};

if ($EVAL_ERROR) {
  print "An error occurred: $EVAL_ERROR\n";
}

sub create_table {
  my $dbh = shift;

  $dbh->do(qq(DROP TABLE person));
  $dbh->do(qq(
	      CREATE TABLE person (
				   firstname CHAR(10) NOT NULL,
				   lastname  CHAR(20) NOT NULL,
				   telnum    CHAR(15),
				   bday      DATE
				  )
	     ))  or warn $dbh->errstr;
}