#!/usr/bin/perl -w
#############  Creating Persistent Hashes Via Berkeley DB Files   ############

use DB_File;   # Module which allows ties of hashes to files.

unlink("events.db") if -e "events.db";

#  Open for creation in read-write mode.  O_CREAT necessary for new files.
tie %event, "DB_File", "events.db", O_CREAT | O_RDWR or die "$!\n";

#  Assignments below actually create the file containing the "persistent" hash.
$event{"Stanley Cup"}  = "June";
$event{"World Series"} = "October";

untie %event;
##########################  End of Database Creation  ########################

#!/usr/bin/perl -w
####################  Query the database using hash keys!  ###################
use DB_File;

tie %event, "DB_File", "events.db", O_RDWR or die "Cannot open events.db!\n";

print "Stanley Cup finals are in ", $event{"Stanley Cup"}, "\n";

#  Can I put new stuff in?  Answer should be yes due to O_RDWR permission.
#  Other modes are O_RDONLY and O_WRONLY.
$event{"School Starts"} = "September";

print "World Series is in ", $event{"World Series"}, "\n";  # Fetch!
print "School starts in ", $event{"School Starts"}, "\n";   # Fetch!

untie %event;
##########################  Database Query Results  #########################

Stanley Cup finals are in June
World Series is in October
School starts in September
######################  Script to Test Read-Only Mode  #####################
#!/usr/bin/perl -w
use DB_File;

#  O_WRONLY if you are only assigning to the hash and not fetching values.
tie %event, "DB_File", "events.db" , O_RDONLY or die "Cannot open events.db!\n";

print "Stanley Cup finals are in ", $event{"Stanley Cup"}, "\n";

$event{"Valentine's Day"} = "February";   #  Should not work!!
print "World Series is in ", $event{"World Series"}, "\n";
print "Valentine's Day is in ", $event{"Valentine's Day"}, "\n";

untie %event;
#####################  Output of Read-Only Script  #######################

Stanley Cup finals are in June
World Series is in October
Use of uninitialized value at ./dbinonly.pl line 13.
Valentine's Day is in     #  See!!  No write to $event{"Valentine's Day"}!!
###########  Demo of Built-In Hash Functions with Tied Hashes  ################
#!/usr/bin/perl -w

#  Do the exists(), keys(), values(), and delete() hash functions
#  work with hashes tied to DBM files?  Let's see!!

use DB_File;  

#  A fifth file permission mask argument is allowed!!
tie %event, "DB_File", "events.db", O_RDWR, 0755 or die "$!\n";

$, = ", ";   #  Dump keys and values with comma as output field separator.
print keys(%event);
print "\n";
print "$key, " while ($key,$val) = each(%event);
print "\n";
print values(%event);
print "\n\n";

print "Hello\n" if exists $event{"Stanley Cup"}; 
print "Good Bye!\n" if defined $event{"Stanley Cup"};

delete $event{"Stanley Cup"};
print keys(%event);

untie %event;
##############################  Output Below  ################################

Stanley Cup, World Series, School Starts   #  Output created using keys()
Stanley Cup, World Series, School Starts,  #  Output created using each()
June, October, September    #  Output created using values()

Hello       #  Prints this if  exists($event{"Stanley Cup"}) works.
Good Bye!   #  Prints this if defined($event{"Stanley Cup"}) works.
World Series, School Starts   #  Remaining keys.  Delete worked!!

#################################  End Output  ################################

Note:  Not all systems have the Berkeley DB_File module.  If yours does not,
       then you must use AnyDBM_File and dbmopen in the following way.  The
       script which follows works identically to the first script on page 1.
       What you *MUST* realize is that AnyDBM_File can do everything shown
       in the handout above this point *EXCEPT* for the exists() function.
       However, it cannot do any of the stuff on pages 3 and 4 of this handout!!

#!/usr/bin/perl -w

use AnyDBM_File;

unlink("events.db") if -e "events.db";
dbmopen(%event, "events", 0744) or die "Cannot open events.db!\n";

$event{"Stanley Cup"}  = "June";
$event{"World Series"} = "October";
$event{"Super Bowl"}   = "January";

dbmclose %event;
#!/usr/bin/perl -w
#####################  Auto-Sorting DB Files For Speed  ########################
use DB_File;

unlink("homers.db");

#  This sub must come above the tie statement.  I have no idea why.
$DB_BTREE->{'compare'} = sub {  #  Limited to *key* comparisons (not values!)
          my ($player1, $player2) = @_;
          my ($fname1, $lname1) = split /\s/, $player1;
          my ($fname2, $lname2) = split /\s/, $player2;
          
          $lname1 cmp $lname2
                  or
          $fname1 cmp $fname2
};

tie %homeruns, "DB_File", "homers.db", O_RDWR | O_CREAT, 0744, $DB_BTREE
        or
die "Cannot tie homers.db: $!";

 
$homeruns{"Sammy Sosa"} = 66;
$homeruns{"Mark McGuire"} = 70;
$homeruns{"Mo Vaughn"} = 50;
$homeruns{"Juan Gonzalez"} = 45;
$homeruns{"Ken Griffey"} = 58;
$homeruns{"Tom McGuire"} = 44;


$, = ",";
print keys %homeruns;
print "\n";
print values %homeruns;
print "\n";

print "$player $homers, " while ($player, $homers) = each %homeruns;
print "\n\n";

#  If we need to sort by hash value, we can do it by getting keys
#  delivered by $DB_BTREE->{'compare} and then use our own sort. 
foreach $player (sort {$homeruns{$a} <=> $homeruns{$b}} keys %homeruns)
{
     print "$player $homeruns{$player}\n";
}

untie %homeruns;
#############################  Output Below  ###############################

Juan Gonzalez,Ken Griffey,Mark McGuire,Tom McGuire,Sammy Sosa,Mo Vaughn
45,58,70,44,66,50
Juan Gonzalez 45, Ken Griffey 58, Mark McGuire 70, Tom McGuire 44, Sammy Sosa 66, Mo Vaughn 50, 

Tom McGuire 44
Juan Gonzalez 45
Mo Vaughn 50
Ken Griffey 58
Sammy Sosa 66
Mark McGuire 70
#!/usr/bin/perl55 -w
##########  Associating DB_File Hash Keys With Multiple Values  #############
use DB_File;

$DB_BTREE->{flags}   = R_DUP;
$DB_BTREE->{compare} = sub {$_[0] cmp $_[1]};

$db = tie(%h, "DB_File", "xxx.x", O_CREAT | O_TRUNC | O_RDWR, 0777, $DB_BTREE)
or die "$!";

$h{foo} = "bar";
$h{foo} = "what";
$h{foo} = "when";
$h{xxx} = "why";
$h{foo} = "where";
$h{xxx} = "how";

$k = $v = 0;  #  Shuts off "Use of uninitialized variable" message.

for ($status = $db->seq($k, $v, R_FIRST); $status == 0; 
     $status = $db->seq($k, $v, R_NEXT))  #  Gets one key/value pair like "each"
{
    print "$k $v\n";
}


@values = $db->get_dup("foo");
print "@values\n";

@values = $db->get_dup("Not There!");
print scalar @values,"\n";

undef $db;
untie %h;
##############################   Program Output  ############################

foo what   #  Next six lines of output from "seq" loop.
foo when
foo where
foo bar
xxx how
xxx why

what when where bar    #  Next two lines of output from "get_dup"
0
#!/usr/bin/perl -w
#############  Insertable/Deleteable Textfiles with Tied Lists  ##############
die "Usage: $0\n" if @ARGV != 0;
use DB_File;

#  When you tie an array to a file, the array BECOMES THE FILE with
#  magical results.  Look at the code and output below!

tie(@lines, 'DB_File', "dbrecno.dat", O_RDWR, 0744, $DB_RECNO)
or die "Cannot tie \@lines to dbrecno.dat\n"; 

# Current file contents.  Join needed to put \n back which tie removes.
print join("\n", @lines), "\n\n";

splice(@lines, 2, 0, "Before line 2");  #  Notice!  Don't put \n in new lines!
push(@lines, "At the end");
unshift(@lines, "At the start");
print join("\n", @lines), "\n\n";

#  Yes, you CAN treat the @lines list like a normal list and use it
#  in normal Perl list processing functions.
@matches = grep {$_ =~ /2/} @lines;
print join("\n", @matches), "\n\n";

#  Can I change all the lines at once?  YES!!!!!!!!!
@lines   = map {s/line/lyne/; $_} @lines;
print join("\n", @lines), "\n\n";

######  Tie's file open modes (like O_RDWR) can be bitwise OR'ed.
######  Example:  O_CREAT | O_TRUNC | O_RDWR if you are creating
######  a new textfile.  Other modes you should know about are
######  O_RDONLY and O_WRONLY (read-only and write-only). 

line 0  #  The text file's original lines
line 1
line 2
line 3
line 4

At the start   #  The lines after a splice, unshift, and push
line 0
line 1
Before line 2
line 2
line 3
line 4
At the end

Before line 2  #  Finding matching lines with grep
line 2

At the start   #  Substitute within a map changes the whole file!!
lyne 0
lyne 1
Before lyne 2
lyne 2
lyne 3
lyne 4
At the end
#!/usr/bin/perl -w
##############  Dealing with Tied Hashes with Non-Scalar Values  ############
use DB_File;
tie %sportteams, "DB_File", "emp.db";  #  Use O_RDWR default.

#  If your hash values are reference scalars you can get MLDBM from CPAN
#  and learn how to use it.  Or you can "stringify" values!!  What's that?
#  Read ahead!  DB_File values MUST be strings or numbers, not references!

#  Two hash of hash of list below!!
$league{NHL}{TEAMS}    =  ["Sharks", "Stars", "Flyers", "Red Wings"];
$league{NFL}{TEAMS}    =  ["49ers", "Lions", "Eagles", "Cowboys", "Rams"];
$league{NHL}{GAMES}    =  82;
$league{NFL}{GAMES}    =  16;

#  How can I store %league so that I don't violate DB_File's non-ref rule?? 

foreach $team (@{$league{NHL}->{TEAMS}}) # -> is unnecessary but probably good.
{
     $temp .= "$team# ";  ##  Not legal to concat into tied hash.
}
$sportteams{NHL}  = $temp;  #  Simple hash with string values!
$sportteams{NHL} .= $league{NHL}{GAMES};
$temp = "";

foreach $team (@{$league{NFL}->{TEAMS}}) # -> is unnecessary but probably good.
{
     $temp .= "$team# ";  ##  Not legal to concat into tied hash.
}
$sportteams{NFL}  = $temp;
$sportteams{NFL} .= $league{NFL}{GAMES};

#  Did it work out Okay??
print "NFL teams and number of games per season: $sportteams{NFL}\n\n";
print "NHL teams and number of games per season: $sportteams{NHL}\n";

#  Now how to get teams and games back from the file created above.
#  Must "unstringify" string values of %sportteams to re-create HoHoL! 

#  First, re-create the National Football League.
$teams = [split /#\s/, $sportteams{NFL}];
$games = splice(@$teams, -1);   #  Get games out of @$teams.  Splice out games.
$newleague{NFL}{TEAMS} = $teams; 
$newleague{NFL}{GAMES} = $games; 

#  Now re-create the National Hockey League.
$teams = [split /#\s/, $sportteams{NHL}];
$games = splice(@$teams, -1);
$newleague{NHL}{TEAMS} = $teams; 
$newleague{NHL}{GAMES} = $games;

#  Did the re-creation work?
$" = ",";  #  Separate list element output with a comma.
print "\n\nNational Football League Teams: @{$newleague{NFL}{TEAMS}}\n";
print "National Football League Number of Games: $newleague{NFL}{GAMES}\n";
print "\n\nNational Hockey League Teams: @{$newleague{NHL}{TEAMS}}\n";
print "National Hockey League Number of Games: $newleague{NHL}{GAMES}\n";

untie %sportteams;  #  Close database and clean up.
#####################  Output of Program on Previous Page  ####################

NFL teams and number of games per season: 49ers# Lions# Eagles# Cowboys# Rams#
                                          16

NHL teams and number of games per season: Sharks# Stars# Flyers# Red Wings# 82

National Football League Teams: 49ers,Lions,Eagles,Cowboys,Rams
National Football League Number of Games: 16

National Hockey League Teams: Sharks,Stars,Flyers,Red Wings
National Hockey League Number of Games: 82