#!/usr/local/bin/perl5 -w

use Sprite;

my ($rdb, $start, $database, $data, $end);

local *FILE;

$rdb   = new Sprite;
$start = (times)[0];

##++
##  Illustrates the power of regexps.
##--

$rdb->set_delimiter ('-read'  => '\s{2,}|\t');
$rdb->set_delimiter ('-write' => '::');

##++
##  You might want to let Sprite know what platform you're using. 
##  This is no longer required as of v3.2, as Perl guesses at a 
##  value from looking at $^O.
##
##  Valid arguments (case insensitive) include:
##
##  Unix, Win95, Windows95, MSDOS, NT, WinNT, OS2, VMS,
##  MacOS or Macintosh. 
##
##  $rdb->set_os ("Unix");
##--

##++
##  If you're on a platform that doesn't support flock, the following 
##  method might be of interest to you:
##
##  $rdb->set_lock_file ("c:\win95\tmp\Sprite.lck", 10);
##
##  If you're using Sprite on Windows 95/NT or on OS2, make sure
##  to use backslashes -- and NOT forward slashes -- when specifying 
##  a path for a database or to the set_db_dir or set_lock_file 
##  methods!
##--

##++
##  Send the query to the database. If your database is in a directory 
##  that contains spaces or characters other than:
##
##  \w, \x80-\xFF, -, /, \, ., :
##
##  use the set_db_dir method:
##
##  $rdb->set_db_dir ("Mac OS:Perl 5:Data");
##--

$database = "test.db";

##++
##  S E L E C T
##--

print STDERR "Performing select ... \n\n";

$data = $rdb->sql (<<EOS);

    select * from $database
    where (Years  >= 10) and 
          (Points >= 20) and
          (Championships >= 1)

EOS

check_and_display ($data);

undef $data;

##++
##  U P D A T E 
##--

print STDERR "\nPerforming update ... \n\n";

$rdb->sql (<<EOU) || die "Update failed!\n";

    update $database
    set Years = (Years + 1),
        Championships = (Championships + 1),
        Player = ("Air MJ")
    where (Player =~ /Jordan\$/)

EOU

##++
##  D E L E T E
##--

print STDERR "Performing delete ... \n\n";

$rdb->sql (<<EOD) || die "Delete failed!\n";

    delete from $database
        where (Points < 20)

EOD

##++
##  I N S E R T 
##--

print STDERR "Performing insert ... \n\n";

$rdb->sql (<<EOI) || die "Insert failed!\n";

    insert into $database
           (Player, Years, Points, Rebounds, Assists, Championships)
    values
           ("Shaquille O'Neil", 4, 27, 11, 3, 0)

EOI

##++
##  A D D   C O L U M N
##--

print STDERR "Performing add column and filling in new data ... \n\n";

$rdb->sql (<<EOAC) || die "Add column failed!\n";

    alter table $database
          add column Legend

EOAC

$rdb->sql ("update $database set Legend = ('Yes')") || die "Update failed!\n";

##++
##  D R O P   C O L U M N
##--

print STDERR "Performing drop column ... \n\n";

$rdb->sql (<<EODC) || die "Drop column failed!\n";

    alter table $database
          drop column Years

EODC

##++
##  Save the database to a "new" file
#--

$rdb->close ("$database.new");

##++
##  Dump modified database
##--

print STDERR "Displaying modified database ... \n\n";

open (FILE, "$database.new") || die "Could not open database!\n";

print while (<FILE>);

close (FILE);

##++
##  Exit
##--

$end = (times)[0];

printf STDERR "\nDone, elapsed time: %.2f seconds. Bye!\n", $end-$start;

exit (0);

##++
##  Subroutine
##--

sub check_and_display
{
    my ($status, $no_elements, $record);

    $status      = shift (@$data);
    $no_elements = scalar (@$data);

    if (!$status) {
	die "Sprite database error. Check your query!\n";
    } elsif (!$no_elements) {
	die "There are no records that match your criteria!\n";
    } else {

	##++
	##   Display the data.
	##--

	$~ = 'HEADER';

	write;

	$~ = 'STDOUT';

	local ($player, $years, $points, $rebounds, $assists, $championships);

	foreach $record (@$data) {
	    ($player, $years, $points, $rebounds, $assists, $championships)
		= @$record;

	    write;
	}
    }
}

##++
##  Display format. If you don't want to deal with formats, you can
##  use the Data::ShowTable module.
##--

format HEADER = 
Player                    Years  Points  Rebounds  Assists  Championships
-------------------------------------------------------------------------
.

format STDOUT =
@<<<<<<<<<<<<<<<<<<<<<<<< @||||  @|||||  @|||||||  @||||||  @||||||||||||
$player,                  $years, $points, $rebounds, $assists, $championships
.
