Initial revision
authorStefanus Du Toit <sjdutoit@csclub.uwaterloo.ca>
Sun, 25 May 2003 23:51:54 +0000 (23:51 +0000)
committerStefanus Du Toit <sjdutoit@csclub.uwaterloo.ca>
Sun, 25 May 2003 23:51:54 +0000 (23:51 +0000)
36 files changed:
.cvsignore [new file with mode: 0644]
ChangeLog [new file with mode: 0644]
HACKING [new file with mode: 0644]
Makefile [new file with mode: 0644]
README [new file with mode: 0644]
TODO [new file with mode: 0644]
booklist [new file with mode: 0644]
ceo.pl.in [new file with mode: 0755]
ceoquery.pl.in [new file with mode: 0644]
db/import.sh [new file with mode: 0755]
db/makedb.sh [new file with mode: 0755]
db/mem_db.txt.gz [new file with mode: 0644]
db/tables [new file with mode: 0644]
db/term_db.txt.gz [new file with mode: 0644]
getbooks.pl [new file with mode: 0755]
manual-0429 [new file with mode: 0644]
manual.isbn [new file with mode: 0644]
manual.loc [new file with mode: 0644]
mkaccounts.pl [new file with mode: 0644]
modules/Accounts.pm [new file with mode: 0644]
modules/BookQuery.pm [new file with mode: 0644]
modules/Books.pm [new file with mode: 0644]
modules/Common.pm [new file with mode: 0644]
modules/Format.pm [new file with mode: 0644]
modules/Members.pm [new file with mode: 0644]
modules/Quotas.pm [new file with mode: 0644]
modules/Scripts.pm [new file with mode: 0644]
modules/Settings.pm [new file with mode: 0644]
modules/Terms.pm [new file with mode: 0644]
modules/UI-curses.pm [new file with mode: 0644]
modules/UI-text.pm [new file with mode: 0644]
test.pl [new file with mode: 0644]
test_bookq.pl [new file with mode: 0755]
test_db.pl [new file with mode: 0755]
test_fr.pl [new file with mode: 0644]
todo/.cvsignore [new file with mode: 0644]

diff --git a/.cvsignore b/.cvsignore
new file mode 100644 (file)
index 0000000..5c1ded0
--- /dev/null
@@ -0,0 +1,4 @@
+ceo.pl
+ceo.pl.install
+ceoquery.pl
+ceoquery.pl.install
diff --git a/ChangeLog b/ChangeLog
new file mode 100644 (file)
index 0000000..300fe5e
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,56 @@
+2002-01-22  Stefanus Du Toit  <sjdutoit@uwaterloo.ca>
+
+       * ceo.pl (action_register_multiple): Added frontend to
+       RegisterMultiple.
+       (menu_ceo): Added action_register_multiple to main menu.
+
+       * modules/Terms.pm (RegisterMultiple($$$)): Added function
+       register members for multiple consecutive terms.
+
+       * modules/Common.pm (NumericToStringTerm($)): Added function to
+       convert numeric terms to string terms.
+       (NumericToStringTerm($)): Added function to convert string terms
+       to numeric representations.
+
+2002-01-10  Stefanus Du Toit  <sjdutoit@uwaterloo.ca>
+
+       * modules/Books.pm (Add(\%)): Completed add function. Fixed a
+       small bug.
+
+       * modules/Members.pm (Add(\%)): Fixed a small bug I introduced
+       earlier - Whoops!
+
+       * ceo.pl (action_library_add_book): Added book addition function.
+
+2002-01-09  Stefanus Du Toit  <sjdutoit@uwaterloo.ca>
+
+       * ceo.pl (menu_library): Hooked up action_library_loc_info to the
+       library menu.
+       (action_library_loc_info): Better output.
+
+2002-01-08  Stefanus Du Toit  <sjdutoit@uwaterloo.ca>
+
+       * ceo.pl (action_library_loc_info): Added function.
+
+       * modules/Books.pm (Get($)): Added function implementation.
+       (GetByISBN($)): Added function implementation.
+       (GetISBNFromBarcode($)): Added function implementation.
+
+2002-01-07  Stefanus Du Toit  <sjdutoit@uwaterloo.ca>
+
+       * modules/UI.pm (Menu($\@)): Made menu seperator item 'nil'
+       instead of -1.
+
+       * modules/BookQuery.pm: Added book query functionality.
+
+       * db/tables: Added members_books table and class field to books
+       relation.
+
+       * modules/Books.pm: Added initial Books interface.
+
+       * modules/UI.pm (Page($)): Removed sleep(2), left behind from
+       debugging. Cleaned up code a little.
+
+       * db/tables: Set START to 3000 for memberid_seq, to reflect
+       members after new CEO.
+
diff --git a/HACKING b/HACKING
new file mode 100644 (file)
index 0000000..a1076d7
--- /dev/null
+++ b/HACKING
@@ -0,0 +1 @@
+I should write this some time. :)
diff --git a/Makefile b/Makefile
new file mode 100644 (file)
index 0000000..017d960
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,26 @@
+PREFIX = /usr/local
+INSTALL_DIR = $(PREFIX)/lib/ceo
+PERM_GROUP = burners
+PERM_OWNER = ceo
+
+all: ceo.pl ceoquery.pl
+
+clean:
+       rm -f ceo.pl ceo.pl.install ceoquery.pl ceoquer.pl.install
+
+install: ceo.pl.install ceoquery.pl.install
+       install -d $(INSTALL_DIR) $(INSTALL_DIR)/modules
+       install -m "u=rwxs,g=rx,o=" -o $(PERM_OWNER) -g $(PERM_GROUP) ceo.pl.install $(INSTALL_DIR)/ceo.pl
+       install -m "u=rwxs,g=rx,o=rx" -o $(PERM_OWNER) -g $(PERM_GROUP) ceoquery.pl.install $(INSTALL_DIR)/ceoquery.pl
+       install -m "u=rwx,g=rx,o=" -o $(PERM_OWNER) -g $(PERM_GROUP) modules/*.pm $(INSTALL_DIR)/modules
+       rm -f $(PREFIX)/bin/ceo $(PREFIX)/bin/ceoquery
+       ln -s $(INSTALL_DIR)/ceo.pl $(PREFIX)/bin/ceo
+       ln -s $(INSTALL_DIR)/ceoquery.pl $(PREFIX)/bin/ceoquery
+
+%.pl: %.pl.in
+       sed "s/MODULE_PATH/.\\/modules/" $< > $@
+       chmod +x $@
+
+%.install: %.in
+       sed "s/MODULE_PATH/\\/usr\\/local\\/lib\\/ceo\\/modules/" $< > $@
+       chmod +x $@
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..3bab956
--- /dev/null
+++ b/README
@@ -0,0 +1,19 @@
+CSC Electronic Office 2002 edition
+
+GOALS
+
+CEO should handle the following tasks of the Computer Science Club:
+ * Keep track of members in the CSC, terms for which they are
+   registered and accounts which they have
+ * Keep track of books owned by the CSC and those having books on loan
+ * Provide useful information (statistical, user lists, etc.)
+
+Additionally it should have the following features:
+ * Be remotely accessible
+ * Keep its information in a sane and usable format (ie. a proper
+   database)
+ * Provide security functions to avoid unauthorized usage
+
+HELPING OUT
+
+To help out with CEO, please read the HACKING file.
diff --git a/TODO b/TODO
new file mode 100644 (file)
index 0000000..a42bd43
--- /dev/null
+++ b/TODO
@@ -0,0 +1,6 @@
+Medium term
+ * Transactions on quotas
+ * Clean up directory structure in CVS tree
+ * Passwords for accessing user information
+ * Books
+
diff --git a/booklist b/booklist
new file mode 100644 (file)
index 0000000..b6a9b7f
--- /dev/null
+++ b/booklist
@@ -0,0 +1,37 @@
+9781565920989
+9780201633986
+9781565921245
+9780201633573
+9781565925885
+9780201134445
+9780201489972
+9780201563177
+9780201517972
+9780131019089
+9780201181272
+9791568811542
+9781565920026
+9780937175118
+9781565920088
+9780937175149
+9780937175125
+9781565920156
+9780937175569
+9781565920132
+9781565920033
+9781565920071
+9780937175576
+9780937175873
+9781558510586
+9780125434553
+9781558510197
+9780201633955
+9780201624007
+9780471951094
+9780070419209
+9780135881873
+9780201100884
+9770475130175
+9781558603165
+9780030097393
+9780070305076
diff --git a/ceo.pl.in b/ceo.pl.in
new file mode 100755 (executable)
index 0000000..1dd9b1f
--- /dev/null
+++ b/ceo.pl.in
@@ -0,0 +1,645 @@
+#!/usr/bin/perl -w
+
+use lib 'MODULE_PATH';
+use strict;
+
+# the main CEO script
+
+require UI;
+require Members;
+require Accounts;
+require Common;
+require Terms;
+require Quotas;
+require Scripts;
+require Format;
+require BookQuery;
+require Books;
+
+### Displays the menu #########################################################
+
+sub menu_library {
+       &UI::Menu('CEO Library functions', [
+                ['a', 'Add book', \&action_library_add_book],
+                ['i', 'Import book list', \&action_library_import_list],
+                ['nil'],
+                ['g', 'Get Library Of Congress info', \&action_library_loc_info],
+                ['nil'],
+               ['d', 'Done', \&action_exit]
+       ]);
+        
+        return 1;
+}
+
+sub menu_ceo {
+
+       &UI::Menu('Welcome to the CSC Electronic Office', [
+               ['n', 'New member', \&action_new_member],
+               ['r', 'Register for a term', \&action_register],
+               ['m', 'Register for multiple terms', \&action_register_multiple],
+               ['d', 'Display a member', \&action_show_member],
+                ['t', 'List members registered in a term', \&action_list_registered],
+                ['s', 'Search for a member by name', \&action_list_by_name],
+                ['i', 'Search for a member by student id', \&action_list_by_studentid],
+                ['nil'],
+               ['a', 'Create an account', \&action_create_account],
+                ['nil'],
+                ['l', 'Library functions', \&menu_library],
+               ['nil'],
+               ['x', 'Exit', \&action_exit]
+       ]);
+}
+
+
+### Methods for performing menu actions #######################################
+
+sub action_new_member {
+#{{{
+       # get name of member
+       my $name =
+               &UI::Prompt('      Name: ', 'string');
+
+       # get student id of member
+       my $studentid =
+               &UI::Prompt('Student id: ', 'regex', q(\\d+));
+
+       # get member's program
+       my $program =
+               &UI::Prompt('   Program: ', 'string');
+
+        my @list = &Members::GetByStudentID($studentid);
+        if (@list) {
+            &UI::MsgWait("A member with this student ID exists.");
+            &UI::Page(&Format::format_member_list(@list));
+            return 1;
+        }
+        
+       $Common::CEODB->{AutoCommit} = 0; # enable transactions
+       # add member
+       my $memberid = &Members::Add({
+               name => $name,
+               studentid => $studentid,
+               program => $program,
+               type => 'user',
+       });
+
+       # verify add
+       if($memberid == 0) {
+               $Common::CEODB->rollback();
+               &UI::MsgWait("Failure trying to add you to the database");
+               $Common::CEODB->{AutoCommit} = 1;
+               return 1;
+       }
+
+       # register member for current term
+       my $status = &Terms::Register(
+               $memberid,
+               &Common::CurrentTerm());
+
+       if(!$status) {
+               $Common::CEODB->rollback();
+               &Common::Log(
+                       5,
+                       "ceo.pl::action_new_member",
+                       "new member registration",
+                       "Added member $memberid, but could not register!");
+
+               &UI::MsgWait(
+                       "Failure trying to add you to the DB.");
+               $Common::CEODB->{AutoCommit} = 1;
+               return 1;
+       }
+       $Common::CEODB->commit();
+       $Common::CEODB->{AutoCommit} = 1;
+
+       &UI::MsgWait(
+               "Success! Your memberid is $memberid.  You are now registered\n" .
+               "for the " . &Common::CurrentTerm() . " term.");
+#      print "\n";
+#      my $do_account = &UI::Prompt(
+#              'Do you want an account(yes/no)? ',
+#              'yesno');
+#      if($do_account) {
+#              action_create_account($memberid);
+#              return 1;
+#      }
+       return 1;
+#}}}
+}
+
+sub action_show_member {
+#{{{
+       # get the user's memberid
+       my $memberid = &UI::Prompt(
+               'Memberid: ',
+               'custom',
+               \&prompt_memberid_or_userid);
+
+       # retrieve the associated member
+       my $member = &Members::Get($memberid);
+
+#      print "\n";
+       # print it out
+       if(!$member) {
+               &UI::MsgWait("No member with id: $memberid");
+       } else {
+               &Members::Print($member);
+       }
+       return 1;
+#}}}
+}
+
+sub action_create_account {
+#{{{
+       # takes an optional argument specifying memberid (if this method
+       # is invoked after action_new_member)
+       my ($memberid) = @_;
+
+       if(!$memberid) {
+               # memberid was not provided in the arg, prompt for one
+               $memberid = &UI::Prompt(
+                       'Enter member ID (exit to cancel): ',
+                       'custom',
+                       \&prompt_memberid_or_userid);
+       }
+
+       my $member = &Members::Get($memberid);
+       if(!$member) {
+               &UI::MsgWait("No member with id: $memberid");
+                return 1;
+       } else {
+               &Members::Print($member);
+       }
+
+        if (!(&UI::Prompt("Is this the correct member?", 'yesno'))) {
+            &UI::MsgWait("I suggest searching for the member by userid or name from the main menu.");
+            return 1;
+        }
+
+       # get the account's userid
+       my $userid = &UI::Prompt('Userid: ', 'regex', q(^\\w+$));
+
+       # add the account
+        my $result = &Accounts::Add($memberid, $userid);
+
+       if(!$result) {
+               &UI::MsgWait(
+                       "Error adding your account to the database.\n" .
+                       "Please talk to the sysadmin");
+               return 1;
+       }
+
+       # all good
+       &UI::MsgWait("Success! Your account has been added");
+
+       return 1;
+
+#}}}
+}
+
+sub action_list_registered {
+    my $term = &UI::Prompt(
+                           'Which term to list members for ([fws]20nn): ',
+                           'regex',
+                           q(^[swf]\\d{4}$));
+    my @list = &Members::GetByTerm($term, "members.name");
+
+    my $dis_string = &Format::format_member_list(@list);
+    &UI::Page($dis_string);
+    return 1;
+}
+
+sub action_list_by_name {
+    my $name = &UI::Prompt(
+                           'Enter the member\'s name: ',
+                           'string');
+    my @list = &Members::GetByName($name);
+
+    my $dis_string = &Format::format_member_list(@list);
+    &UI::Page($dis_string);
+    return 1;
+}
+
+sub action_list_by_studentid {
+    my $name = &UI::Prompt(
+                           'Enter the member\'s student id: ',
+                           'regex',
+                           q(\\d+));
+    my @list = &Members::GetByStudentID($name);
+
+    my $dis_string = &Format::format_member_list(@list);
+    &UI::Page($dis_string);
+    return 1;
+}
+
+sub action_buy_quota {
+#{{{
+
+       # get the userid
+       my $userid = &UI::Prompt(
+               'Enter userid: ',
+               'custom',
+               \&prompt_valid_userid);
+
+       # get the term to buy quota for
+       my $term = &UI::Prompt(
+               'Which term to buy quota for ([fws]20nn): ',
+               'regex',
+               q(^[swf]\\d{4}$));
+
+       # get amount of quota to buy
+       my $quota = &UI::Prompt(
+               'How much quota to buy: ',
+               'int');
+
+       # make sure that member for account is registered for that term
+
+       # first get the account info (for memberid)
+       my $member = &Accounts::Get($userid);
+       if(!$member) {
+               # could not get that account.  Wierd.  Print an error message
+               &UI::MsgWait("Error retrieving account info!");
+               return 1;
+       }
+
+       # check the registration for that term for the member
+       my $result = &Terms::IsRegistered($member->{'memberid'}, $term);
+       if(!$result) {
+               &UI::MsgWait(
+                       "You are not registered for that term.  A member must register\n" .
+                       "for a term before she is allowed buy account quota for that\n" .
+                       "term.");
+               return 1;
+       } elsif($result == -1) {
+               &UI::MsgWait("Error while trying to verify member registration!");
+               return 1;
+       }
+
+       # the member is registered for that term, go ahead and buy quota
+
+       $result = &Quotas::BuyQuota($userid, $term, $quota);
+       if(!$result) {
+               &UI::MsgWait(
+                       "Error occurred while trying to update quota in database.\n" .
+                       "Please notify a sysadmin to resolve this.");
+               return 1;
+       }
+
+       # add a command to scripts to set quota for user
+       my $current_term = &Common::CurrentTerm();
+       if($current_term eq $term) {
+               # if quota is being bought for current term, issue command
+               # to cronjobs to set quota
+               my $result = &Scripts::SetQuota($userid, $quota);
+
+               if(!$result) {
+                       &UI::MsgWait(
+                               "You have bought $quota quota for account $userid \n" .
+                               "for term $term.  But an error occurred trying to \n" .
+                               "set the actual quota.  Please notify a sysadmin.\n");
+                       return 1;
+               }
+       }
+
+       &UI::MsgWait(
+               "Success! You have bought $quota quota for account $userid \n" .
+               " for term $term.  Thank you.");
+
+       return 1;
+#}}}
+}
+
+sub action_register {
+#{{{
+       my $memberid = &UI::Prompt(
+               'Enter memberid ("exit" to cancel): ',
+               'custom',
+               \&prompt_memberid_or_userid);
+
+       # retrieve the associated member
+       my $member = &Members::Get($memberid);
+
+#      print "\n";
+       # print it out
+       if(!$member) {
+               &UI::MsgWait("No member with id: $memberid");
+       } else {
+               &Members::Print($member);
+       }
+        
+       my $term = &UI::Prompt(
+               'Which term to register for ([fws]20nn): ',
+               'regex',
+               q(^[swf]\\d{4}$));
+
+       # check if the member is registerd for that term
+       my $status = &Terms::IsRegistered($memberid, $term);
+       if($status == -1) {
+               # error doing registration lookup
+               &UI::MsgWait(
+                       'Error trying to retrieve registration information.\n' .
+                       'Please contact the sysadmin to get this resolved.');
+               return 1;
+       }
+       if($status == 1) {
+               # already registered for that term
+               &UI::MsgWait("You are already registered for term $term");
+               return 1;
+       }
+       # not registered yet
+       $status = &Terms::Register($memberid, $term);
+       if($status == 0) {
+               # error registering
+               &UI::MsgWait(
+                       "Error registering you for term $term.\n" .
+                       "Please contact the sysadmin to get this resolved.");
+               return 1;
+       }
+       # success registering
+       &UI::MsgWait("Your are now registered for term $term\n");
+
+       return 1;
+
+#}}}
+}
+        
+sub action_register_multiple {
+#{{{
+       my $memberid = &UI::Prompt(
+               'Enter memberid ("exit" to cancel): ',
+               'custom',
+               \&prompt_memberid_or_userid);
+
+       # retrieve the associated member
+       my $member = &Members::Get($memberid);
+
+#      print "\n";
+       # print it out
+       if(!$member) {
+               &UI::MsgWait("No member with id: $memberid");
+       } else {
+               &Members::Print($member);
+       }
+
+       my $term = &UI::Prompt(
+               'Which term to start registering ([fws]20nn): ',
+               'regex',
+               q(^[swf]\\d{4}$));
+
+       # check if the member is registerd for that term
+       my $status = &Terms::IsRegistered($memberid, $term);
+       if($status == -1) {
+               # error doing registration lookup
+               &UI::MsgWait(
+                       'Error trying to retrieve registration information.\n' .
+                       'Please contact the sysadmin to get this resolved.');
+               return 1;
+       }
+       if($status == 1) {
+               # already registered for that term
+               &UI::MsgWait("You are already registered for term $term");
+               return 1;
+       }
+       # not registered yet
+        my $num = &UI::Prompt('How many terms? ', 'int');
+       $status = &Terms::RegisterMultiple($memberid, $term, $num);
+       if($status == 0) {
+               # error registering
+               &UI::MsgWait(
+                       "Error registering you for $num terms starting at term $term.\n" .
+                       "Please contact the sysadmin to get this resolved.");
+               return 1;
+       }
+       # success registering
+       &UI::MsgWait("You are now registered for $num terms starting at $term\n");
+
+       return 1;
+
+#}}}
+}
+
+sub action_exit { return 0; }
+
+### Helper functions ##########################################################
+
+sub prompt_memberid_or_userid {
+#{{{
+       # converts a memberid or userid into a valid memberid
+       # written for use with the &UI::Prompt function
+       my ($id) = @_;
+
+       if($id !~ /^\d+$/) {
+               # guess that it's a userid and try to get the memberid
+               my $account = &Members::GetByUserId($id);
+               if(!$account) {
+                    &UI::MsgWait("$id is an invalid account userid\n");
+                    return 0;
+               }
+               $id = $account->{'memberid'};
+       }
+
+       # check member id to be valid
+       my $member = &Members::Get($id);
+       if(!$member) {
+               &UI::MsgWait("$id is an invalid memberid\n");
+               return 0;
+       }
+
+       return (1, $id);
+#}}}
+}
+
+sub prompt_valid_userid {
+#{{{
+       # function to be used with &UI::Prompt
+       # checks if an input is a valid userid
+       my ($id) = @_;
+
+       my $account = &Accounts::Get($id);
+       if(!$account) {
+               # not a valid account
+               return 0;
+       } else {
+               return (1, $id);
+       }
+#}}}
+}
+
+sub action_library_loc_info {
+    my $barcode;
+    do {
+        $barcode = &UI::Prompt("Please scan/enter the book's barcode: ",
+                               'regex', q([0-9]{13}));
+    } while (!(&Books::CheckBarcode($barcode)));
+
+    my $isbn = &Books::GetISBNFromBarcode($barcode);
+    my %session = &BookQuery::InitiateSession("z3950.loc.gov", "7090",
+                                              "VOYAGER");
+    if ($session{'success'} == 0) {
+        &UI::MsgWait("Error logging in to LOC.");
+        return 1;
+    }
+    my %book = &BookQuery::LookupBook(\%session, $isbn);
+
+    if ($book{'success'} == 0) {
+        &UI::MsgWait("Error fetching book with ISBN " . $isbn . ".");
+        return 1;
+    }
+    my $output;
+    foreach my $key (keys %book) {
+        if ($key eq "content" || $key eq "success") { next; }
+        $output .= $key . ": " . $book{$key} . "\n";
+    }
+    &UI::MsgWait($output);
+    return 1;
+}
+
+sub action_library_add_book {
+    my $code = 'N';
+#     my $code = &UI::Prompt("[r]ed/[b]lue/[n]one: ", 'regex',
+#                            q(r|b|n));
+    my $barcode = &UI::Prompt("Please scan/enter the book's barcode: ",
+                              'regex', q([0-9]{13}));
+    my $isbn = &Books::GetISBNFromBarcode($barcode);
+
+    my $bookexists = &Books::GetByISBN($isbn);
+    if ($bookexists) {
+        &UI::MsgWait("Sorry, the book with ISBN " . $isbn . " is already in the database.");
+        return 1;
+    }
+
+    my $count = &UI::Prompt("Number of copies: ", 'regex',
+                            q([1-9][0-9]*));
+    my $bookid;
+
+    my $msg;
+
+    my %book;
+    do {
+        if (&UI::Prompt("Use Library of Congress? ", 'yesno')) {
+            my %session = &BookQuery::InitiateSession("z3950.loc.gov", "7090",
+                                                      "VOYAGER");
+            if ($session{'success'} == 0) {
+                &UI::MsgWait("Error logging in to LOC.");
+                return 1;
+            }
+            %book = &BookQuery::LookupBook(\%session, $isbn);
+            
+            if ($book{'success'} == 0) {
+                &UI::MsgWait("Error fetching book with ISBN " . $isbn
+                             . ".");
+                return 1;
+            }
+            $book{'class'} = $code;
+            $book{'count'} = $count;
+        } else {
+            $book{'count'} = $count;
+            $book{'class'} = $code;
+            $book{'title'} = &UI::Prompt("Title: ", 'string');
+            $book{'author'} = &UI::Prompt("Author: ", 'string');
+            $book{'published'} = &UI::Prompt("Publisher: ", 'string');
+            $book{'isbn'} = $isbn;
+        }
+        
+        $msg = "--- Book information ---\n";
+        foreach my $key (keys %book) {
+            if ($key eq "content" || $key eq "success") { next; }
+            $msg .= $key . ": " . $book{$key} . "\n";
+        }
+        
+    } while (!(&UI::Prompt($msg . "Is this good? ", 'yesno')));
+    
+    $bookid = &Books::Add(\%book);
+    &UI::MsgWait("Added book with ID $bookid.");
+    return 1;
+}
+
+sub action_library_import_list {
+    my $pipe = $|;
+    $| = 1;
+    print "Logging into Library of Congress...";
+    $| = $pipe;
+
+    my %session = &BookQuery::InitiateSession("z3950.loc.gov", "7090",
+                                              "VOYAGER");
+    if ($session{'success'} != 1) {
+        print " failed.\n";
+        &UI::MsgWait("Error logging in to LOC.");
+        return 1;
+    } else {
+        print " successful.\n";
+    }
+    
+    my $filename = &UI::Prompt("File to import: ", 'string');
+    
+    my $count = 0;
+    my $noisbn = "";
+    my $noloc = "";
+    my $noadd = "";
+    open BOOKLIST, "<" . $filename;
+    while (my $line = <BOOKLIST>) {
+        chomp $line;
+        my $isbn; my $field;
+        if ($line =~ /^[0-9]{13}$/) { # Barcode
+            $isbn = &Books::GetISBNFromBarcode($line);
+            $field = "isbn";
+        } elsif ($line =~ /^[0-9]{9}[0-9X]$/) { # ISBN
+            $isbn = $line;
+            $field = "isbn";
+        } elsif ($line =~ /^[0-9]{8}/) { # LCCN
+            $isbn = $line;
+            $field = "lccn";
+        } else {
+            $noisbn .= $line . "\n";
+            next;
+        }
+
+        my $oldbook = &Books::GetByISBN($isbn);
+        if (defined $oldbook) {
+            print "\"" . $oldbook->{'title'}
+                . " is already in the library\n";
+            next;
+        }
+        my %book;
+        %book = &BookQuery::LookupBook(\%session, $isbn, $field);
+        if ($book{success} != 1) {
+            $noloc .= $isbn . "\n";
+            next;
+        }
+        $book{'count'} = 1;
+        if (&Books::Add(\%book) == 0) {
+            print "Error cataloguing " . $book{'title'} . "\n";
+            $noadd .= "$isbn (" . $book{'title'} . ")\n";
+        } else {
+            print "Catalogued " . $book{'title'} . "\n";
+            $count++;
+        }
+    }
+    close BOOKLIST;
+    
+    my $page = "";
+    if ($noisbn ne "") {
+        $page .= "The following lines could not be read as ISBN numbers:\n"
+               . $noisbn;   
+    }
+    if ($noloc ne "") {
+        $page .= "The following ISBNs could not be retrieved from the LOC:\n"
+               . $noloc;
+    }
+    if ($noadd ne "") {
+        $page .= "The following ISBNs could not be added to the database:\n"
+               . $noadd;
+    }
+    if ($page ne "") {
+        &UI::Page($page);
+    }
+    
+    &UI::MsgWait("Imported $count books from \"$filename\".");
+    return 1;
+}
+
+$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin";
+&Common::DBConnect();
+menu_ceo;
+
+print "Good bye.\n";
diff --git a/ceoquery.pl.in b/ceoquery.pl.in
new file mode 100644 (file)
index 0000000..8ee0e54
--- /dev/null
@@ -0,0 +1,79 @@
+#!/usr/bin/perl -w
+
+use lib 'MODULE_PATH';
+use strict;
+
+require Common;
+require Members;
+require Books;
+require Terms;
+
+sub usage {
+    print "Usage: ceoquery memberlist|booklist|allmembers|allusers|termusers\n";
+}
+
+$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin";
+&Common::DBConnect();
+
+if ($#ARGV != 0) {
+    usage();
+    exit 1;
+}
+
+if ($ARGV[0] eq "memberlist") {
+    my @list = &Members::GetByTerm(&Common::CurrentTerm(),
+                                   "members.name");
+
+    my $line;
+    while ($line = shift @list) {
+        printf("%d|%s|%s|%s\n", $$line{'memberid'}, $$line{'name'},
+               $$line{'program'}, ($$line{'userid'} || ""));
+    }
+} elsif ($ARGV[0] eq "allmembers") {
+    my @list = &Members::GetAll();
+    my $line;
+    while ($line = shift @list) {
+        my @terms = &Terms::GetByMember($$line{'memberid'});
+        my $i;
+        printf("%d|%s|%s|", $$line{'memberid'}, $$line{'name'},
+               $$line{'program'});
+        for ($i = 0; $i < $#terms; $i++) {
+            print $terms[$i];
+            if ($i < $#terms - 1) {
+                print ",";
+            }
+        }
+        print "\n";
+    }
+} elsif ($ARGV[0] eq "booklist") {
+    my @list = &Books::GetAll();
+    my $line;
+    while ($line = shift @list) {
+        my $title = $$line{'title'};
+        $title =~ s/\s/ /g;
+        my $author = $$line{'author'};
+        $author =~ s/\s/ /g;
+        my $edition = $$line{'edition'};
+        if (not defined $edition) { $edition = ""; }
+        my $published = $$line{'published'};
+        $published =~ s/\s/ /g;
+        if (not defined $published) { $published = ""; }
+        print $$line{'isbn'} . "|$title|$author|$edition|$published\n";
+    }
+} elsif ($ARGV[0] eq "allusers") {
+    my @list = &Members::GetAll();
+    my $line;
+    while ($line = shift @list) {
+        if (defined($$line{'userid'})) { print $$line{'userid'} . "\n"; }
+    }
+} elsif ($ARGV[0] eq "termusers") {
+    my @list = &Members::GetByTerm(&Common::CurrentTerm(),
+                                   "members.name");
+    my $line;
+    while ($line = shift @list) {
+        if (defined($$line{'userid'})) { print $$line{'userid'} . "\n"; }
+    }
+} else {
+    usage();
+    exit 1;
+}
diff --git a/db/import.sh b/db/import.sh
new file mode 100755 (executable)
index 0000000..5d435db
--- /dev/null
@@ -0,0 +1,5 @@
+#!/bin/bash
+
+((cat $1 | gunzip | sed 's/:/;/' | sed 's/^\([^;]*;[^;]*;[^;]*;[^;]*;\).*/\1user/') && echo '\.') | psql -c "COPY members FROM stdin DELIMITERS ';'" ceo
+
+((cat $2 | gunzip | sed 's/:/,/' | awk -F , '/^[fws]/ { term = substr($1, 1, 1) (substr($1, 2, 1) == "9" ? "19" : "20") substr($1, 2); for (i = 2; i < NF; ++i) { printf "%s;%s\n", $i, term; } }') && echo '\.') | psql -c "COPY terms FROM stdin DELIMITERS ';'" ceo
diff --git a/db/makedb.sh b/db/makedb.sh
new file mode 100755 (executable)
index 0000000..0d63081
--- /dev/null
@@ -0,0 +1,12 @@
+#!/bin/sh
+
+dropdb ceo
+createdb ceo
+if [ $? -ne 0 ]; then
+       echo Could not create database
+       exit 1
+fi
+
+psql ceo < tables
+./import.sh mem_db.txt.gz term_db.txt.gz
+echo Done creating database.
diff --git a/db/mem_db.txt.gz b/db/mem_db.txt.gz
new file mode 100644 (file)
index 0000000..773d848
Binary files /dev/null and b/db/mem_db.txt.gz differ
diff --git a/db/tables b/db/tables
new file mode 100644 (file)
index 0000000..08985e4
--- /dev/null
+++ b/db/tables
@@ -0,0 +1,46 @@
+CREATE TABLE logs (
+       time            timestamp NOT NULL DEFAULT timestamp('now'),
+       urgency         int4 NOT NULL,
+       who             varchar(50) NOT NULL,
+       message         text NOT NULL,
+       about           varchar(50) NOT NULL
+);
+
+CREATE SEQUENCE memberid_seq INCREMENT 1 START 3000 MINVALUE 1;
+
+CREATE TABLE members (
+       memberid        int4 PRIMARY KEY DEFAULT NEXTVAL('memberid_seq'),
+       name            varchar(50) NOT NULL,
+       studentid       varchar(50),
+       program         varchar(50),
+       type            varchar(10),
+       userid          varchar(32) UNIQUE
+);
+
+CREATE TABLE terms (
+       memberid        int4 NOT NULL REFERENCES members(memberid),
+       term            char(5) NOT NULL,
+       UNIQUE(memberid, term)
+);
+
+CREATE SEQUENCE bookid_seq INCREMENT 1 START 1 MINVALUE 1;
+
+CREATE TABLE books (
+       bookid          int4 PRIMARY KEY DEFAULT NEXTVAL('seq_bookid'),
+       isbn            char(10) UNIQUE NOT NULL,
+       title           varchar(200) NOT NULL,
+       author          varchar(200) NOT NULL,
+       published       varchar(200),
+       edition         varchar(80),
+       price           varchar(80),
+       class           char,
+       count           int NOT NULL
+);
+
+CREATE TABLE members_books (
+       bookid          int4 NOT NULL REFERENCES books(bookid),
+       memberid        int4 NOT NULL REFERENCES members(memberid),
+       date_out        timestamp NOT NULL DEFAULT timestamp('now'),
+       UNIQUE(bookid, memberid),
+       UNIQUE(bookid)
+);
diff --git a/db/term_db.txt.gz b/db/term_db.txt.gz
new file mode 100644 (file)
index 0000000..fb7c130
Binary files /dev/null and b/db/term_db.txt.gz differ
diff --git a/getbooks.pl b/getbooks.pl
new file mode 100755 (executable)
index 0000000..c008bc5
--- /dev/null
@@ -0,0 +1,16 @@
+#!/usr/bin/perl -w
+
+use lib './modules';
+use strict;
+
+require Books;
+
+open BOOKLIST, ">>booklist" or die "Cannot open book list\n";
+
+while (my $code = <STDIN>) {
+    if (!($code =~ /[0-9]{13}/) || !&Books::CheckBarcode($code)) {
+        print "Invalid bar code!\a\n";
+    } else {
+        print BOOKLIST $code;
+    }
+}
diff --git a/manual-0429 b/manual-0429
new file mode 100644 (file)
index 0000000..b8bd553
--- /dev/null
@@ -0,0 +1,54 @@
+0471121487
+0201379279
+0120790629
+1895033152
+0201121107
+0070431523
+0262022753
+0937175706
+0937175706
+0937175706
+0937175870
+0937175889
+0937175838
+9781565920286
+0136405258
+1555580513
+0201144689
+0122861655
+0120644800
+0070463387
+0201144689
+9780124096738
+0123361567
+0830693599
+0201144565
+9780134722429
+0132199084
+0136379508
+0136374069
+0134685059
+1400524806
+0201634953
+0201563339
+0596000022
+3930419467
+0596001606
+1556150490
+0471491101
+047132776X
+67029207
+0201000229
+013165506X
+0471130885
+0262631113
+0262580977
+1558600698
+0201182416
+0471064904
+69013220
+75109245
+0131629263
+0135839149
+0024154911
+0138545057
diff --git a/manual.isbn b/manual.isbn
new file mode 100644 (file)
index 0000000..d53772e
--- /dev/null
@@ -0,0 +1,100 @@
+0312041233
+0525671439
+026268053X
+0887307876
+0716781549
+0669093254
+0816261660
+0716718561
+0700224998
+047195117X
+0672224712
+0810462885
+0521291011
+0205067263
+0131098020
+0876925964
+0919884229
+020107981X
+0131100734
+0471300209
+0805306005
+0201137992
+3728117684
+0121680304
+0830628126
+3889630618
+0201600196
+0860207412
+0201103311
+0201118890
+0262631105
+0312061315
+0314934049
+0387501509
+0135964040
+0835931633
+020115790X
+0471025429
+0393954455
+0919884571
+0201045753
+0919884555
+013937681X
+0921598068
+0471885827
+0716704633
+0394745027
+0911537066
+0918790026
+0671660632
+0262680793
+0134804198
+0201175355
+0345334809
+CNQA76B51C4
+0201112590
+0201066734
+052135465X
+1558512160
+0071127798
+092084300X
+0136542948
+0897910176
+0897910265
+0897911032
+0897912977
+0387976221
+020103803X
+0201038226
+0314632433
+0070651744
+0884053040
+0716711958
+0201103427
+0471851043
+0138545057
+0070357781
+0521563224
+0446393088
+0553342797
+0716721449
+0138803692
+0201006502
+0137299397
+013709759X
+013709759X
+0471104205
+0201038099
+0201038099
+0387975926
+0131101634
+1895033160
+0716704633
+088284265X
+042611244X
+0426103726
+0426112601
+0426103807
+042620042X
+0426112520
diff --git a/manual.loc b/manual.loc
new file mode 100644 (file)
index 0000000..a927a1a
--- /dev/null
@@ -0,0 +1,12 @@
+73164612
+67018915
+66029754
+70131996
+68028110
+78076038
+79164649
+65019235
+72093122
+73020165
+67012342
+68019355
diff --git a/mkaccounts.pl b/mkaccounts.pl
new file mode 100644 (file)
index 0000000..e551ff0
--- /dev/null
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+use strict;
+
+require Common;
+require Settings;
+
+# lock the new account file
+my $status = &Common::LockFile($Settings::NewAccountsFile);
+if(!$status) {
+       &Common::Log(
+               10,
+               "mkaccounts.pl",
+               "file $Settings::NewAccountsFile",
+               "cannot lock file");
+       exit 1;
+}
+
+# open it
+if( ! open(NEW_ACCOUNTS, $Settings::NewAccountsFile) ) {
+       &Common::Log(
+               10,
+               "mkaccounts.pl",
+               "file $Settings::NewAccountsFile",
+               "cannot open file");
+       exit 1;
+}
+
+# read all the data
+my @lines = <NEW_ACCOUNTS>;
+
+# close the file
+close NEW_ACCOUNTS;
+
+# grab the current time and make a rename-suffix out of it
+my ($x,$x,$x,$mday,$mon,$year,$x,$x,$x) = localtime(time);
+$year += 1900;
+$mon += 1;
+$mday += 1;
+my $suffix = sprintf "%d.%02d.%02d", $year, $mon, $mday, $$;
+
+# rename the file to something new
+system("mv -f $Settings::NewAccountsFile $Settings::NewAccountsFile.$suffix");
+
+# unlock the file
+&Common::UnlockFile($Settings::NewAccountsFile);
+
+# for each line, add an account
+my $line;
+foreach $line (@lines) {
+       chomp $line;
+       # TODO parse line and create the account here
+       print "ACCOUNT: $line\n";
+}
+
+#all done
diff --git a/modules/Accounts.pm b/modules/Accounts.pm
new file mode 100644 (file)
index 0000000..3a5ace3
--- /dev/null
@@ -0,0 +1,149 @@
+
+# Accounts.pm
+#
+# Defines methods for retrieving and modifying account entries
+
+# the common representation for an account is a reference to a hash
+# with the appropriate key-value pairs defined
+
+package Accounts;
+
+use strict;
+use Net::LDAP;
+use User::pwent;
+use English;
+
+require Common;
+
+# function: Add($memberid, $userid)
+#           adds an account to the system
+#
+#      arg: $account - the account hashref
+#
+#  returns: truth on success, false on failure
+sub Add($) {
+       my ($memberid, $userid) = @_;
+
+        # * Check that the member doesn't already have an account
+        # * Check that that account name isn't already taken
+        # * If not, add the account to LDAP and add the appropriate
+        #   account name to the member entry
+        # * Change the password
+
+        my $shell = "/bin/bash";
+
+        my $member = Members::Get($memberid);
+        if (!$member) {
+            # No such member!
+            return 0;
+        }
+        my $currentid = $member->{"userid"};
+        if ($currentid) {
+            UI::MsgWait("Member $memberid already has an account: $currentid\n"
+                        . "Contact the sysadmin if there are still problems.");
+              return 0;
+        }
+       # TODO: Check that member is a member this term
+        # TODO: Check format of userid (alphanumeric, etc.)
+        
+        my $realname = $member->{"name"};
+
+        # Determine what UID number to assign
+        my $maxid = 0;
+        my $uidnum;
+        while (1) {
+            my $pw = getpwent() || last;
+            my $idnum = $pw->uid;
+            if ($idnum > $maxid && $idnum < 50000) {
+                $maxid = $idnum;
+            }
+        }
+        $uidnum = $maxid + 1;
+
+        open LDAPSECRET, "</etc/ldap.ceo";
+
+        my $secret = <LDAPSECRET>;
+        chomp $secret;
+        close LDAPSECRET;
+        
+        my $ldap = Net::LDAP->new('localhost');
+        if (!$ldap) {
+            # TODO: Print error in $@
+            return 0;
+        }
+
+        my $result = $ldap->bind('cn=ceo,dc=csclub,dc=uwaterloo,dc=ca',
+                      password => $secret);
+
+        if ($result->code) {
+            # TODO: Print $result->error
+            return 0;
+        }
+
+        my $userpass;
+        my $repeat;
+        # TODO: Use some UI Password prompting function
+        do {
+            $userpass = &UI::Prompt("User password: ", 'custom', \&prompt_password, 1);
+            $repeat = &UI::Prompt("Enter the password again: ", 'custom', \&prompt_password, 1);
+        } while ($userpass ne $repeat);
+        
+        $result =
+            $ldap->add("uid=$userid,ou=People,dc=csclub,dc=uwaterloo,dc=ca",
+                       attr => ['uid' => "$userid",
+                                'cn'  => "$realname",
+                                'objectClass' => ['account',
+                                                  'posixAccount',
+                                                  'top'],
+                                'userPassword' => "$userpass",
+                                'loginShell'   => "$shell",
+                                'uidNumber'    => "$uidnum",
+                                'gidNumber'    => "1",
+                                'homeDirectory'=> "/u/$userid",
+                                'gecos'        => "$realname"]
+               );
+
+        if ($result->code) {
+            # TODO: Print $result->error
+            return 0;
+        }
+
+        $ldap->unbind();
+
+       # Make the home directory
+       #system("/usr/local/bin/addhomedir_ceo", "$userid");
+        
+        # Add userid to database
+        my $statement = $Common::CEODB->prepare("UPDATE members " .
+                                                "SET userid = ? WHERE memberid = ?");
+
+        $result = $statement->execute($userid, $memberid);
+
+        if (!$result) {
+               &Common::Log(
+                       10,
+                       "Accounts::Add",
+                       "members table",
+                       sprintf("Error: set account for member %s uid %s failed",
+                               $memberid,
+                                $userid));
+               $statement->finish();
+                &UI::MsgWait("The user was created but adding the user ID to the database failed. Please contact the sysadmin.");
+                return 0;
+        }
+
+       &UI::MsgWait("Please run \'addhomedir $userid\'.");
+
+#      MailSysadmin("Account $userid created", "For member $memberid.");
+       return 1;
+}
+
+sub prompt_password($) {
+    (my $pw) = @_;
+
+    # TODO: Password constraints
+    
+    return (1, $pw);
+}
+
+1;
diff --git a/modules/BookQuery.pm b/modules/BookQuery.pm
new file mode 100644 (file)
index 0000000..bccd5aa
--- /dev/null
@@ -0,0 +1,111 @@
+
+# BookQuery.pm
+#
+# automated book queries at the Library of Congress and other Z3950
+# servers.
+
+package BookQuery;
+
+use strict;
+
+use LWP::UserAgent;
+
+my $agent = "University of Waterloo Computer Science Club BookQuery/0.0";
+
+# function: InitiateSession($server, $port, $dbname)
+#
+#  returns: A session hash. $retval{success} == 1 iff request was
+#  successful.
+
+sub InitiateSession($$$) {
+    my %session;
+    ($session{'server'}, $session{'port'}, $session{'dbname'}) = @_;
+
+    my $ua = LWP::UserAgent->new;
+    $ua->agent($agent . " " . $ua->agent);
+
+    my $req = HTTP::Request->new( GET =>
+                               "http://lcweb.loc.gov/cgi-bin/zgate?ACTION=INIT&FORM_HOST_PORT=/prod/www/data/z3950/locils.html,"
+                               . $session{'server'} . "," . $session{'port'});
+
+    my $res = $ua->request($req);
+    $session{'success'} = 0;
+    if ($res->is_success) {
+        if ($res->content =~ /SESSION_ID\" VALUE=\"([0-9]*)\"/) {
+            $session{'id'} = $1;
+            $session{'success'} = 1;
+        } else {
+            $session{'error'} = "Could not get session ID. Contents:\n" . $res->content;
+        }
+    } else {
+        $session{'error'} = "Could not retrieve data from server";
+    }
+    return %session;
+}
+
+# function: LookupBook(\%session, $search[, $searchfield])
+#
+#  returns: A hash with information on the book. If the book was found
+#           $retval{success} == 1, otherwise $retval{success} == 0.
+#      arg: $field - either "isbn" or "lccn". defaults to isbn.
+sub LookupBook(\%$$) {
+    (my $session, my $isbn, my $field) = @_;
+    if (defined($field) && $field eq "lccn") {
+        $field = "9";
+    } else {
+        $field = "8";
+    }
+    my %bookinfo;
+    my $ua = LWP::UserAgent->new;
+    $ua->agent($agent . " " . $ua->agent);
+
+    my $req = HTTP::Request->new( GET =>
+                                  "http://lcweb.loc.gov/cgi-bin/zgate?ACTION=SEARCH&DBNAME="
+                                  . $session->{'dbname'}
+                                  . "&MAXRECORDS=20&RECSYNTAX=1.2.840.10003.5.10&TERM_1=" . $isbn
+                                  . "&USE_1=" . $field . "&STRUCT_1=1&SESSION_ID="
+                                  . $session->{'id'} . "&ESNAME=F");
+    
+    my $res = $ua->request($req);
+    $bookinfo{'success'} = 0;
+    if ($res->is_success) {
+        $bookinfo{'content'} = $res->content;
+        if ($bookinfo{'content'} =~ /No records matched/) {
+            $bookinfo{'error'} = "No matching records";
+        } else {
+            if ($bookinfo{'content'} =~ /\<PRE\>([^<]*)\<\/PRE\>/s) {
+                my $parsetext = $1;
+                while ($parsetext =~ s/^([^:\n]+): ([^\n]*)\n(( [^\n]*\n)*)//ms) {
+                    my $key = lc($1);
+                    my $value = $2 . $3;
+                    chomp $value;
+                    $value =~ s/  */ /msg;
+                    $value =~ s/^ //mg;
+                    $bookinfo{$key} = $value;
+                }
+                if (defined $bookinfo{'isbn'}) {
+                    if ($bookinfo{'isbn'} =~ /$isbn( \(([^)]*)\))?( : ([^]*( \([^)]*\))?)?/) {
+                    $bookinfo{'edition'} = $2;
+                    if (defined $bookinfo{'edition'}) {
+                        $bookinfo{'edition'} =~ s/v\./Volume/;
+                    }
+                    $bookinfo{'price'} = $4;
+                }
+            }
+
+                $bookinfo{'isbn'} = $isbn;
+            if ($bookinfo{'title'} =~ /^([^\/]+)\s\/\s(.*)$/s) {
+                $bookinfo{'title'} = $1;
+                $bookinfo{'author'} = $2;
+            }
+                $bookinfo{'success'} = 1;
+            } else {
+                $bookinfo{'error'} = "Could not parse output.";
+            }
+        }
+    } else {
+        $bookinfo{'error'} = "Error accessing server.";
+    }
+    return %bookinfo;
+}
+
diff --git a/modules/Books.pm b/modules/Books.pm
new file mode 100644 (file)
index 0000000..0499b67
--- /dev/null
@@ -0,0 +1,273 @@
+
+# Books.pm
+#
+# defines functions for manipulating books and related information
+#
+# Format of a book hash:
+# ISBN - the ISBN number of the book
+# title - title as on book's cover/inlay
+# class - one character, /[NBR]/.
+#         N: default restrictions (max 2 weeks) on loan
+#         B: one-day loan (B for blue)
+#         R: NO LOAN (R for red)
+# count - number of copies of this book owned by the CSC
+
+package Books;
+
+use strict;
+
+require Common;
+
+# function: Get($bookid)
+#           retrieves a book by book id (not ISBN).
+#
+sub Get($) {
+    my ($bookid) = @_;
+
+    my $statement = $Common::CEODB->prepare("SELECT * FROM books WHERE
+    bookid = ?");
+
+    my $result = $statement->execute($bookid);
+
+    if (!$result) {
+        &Common::Log(10, "Books::Get", "books table",
+                     "Error: select for bookid=$bookid failed");
+        $statement->finish();
+        return undef();
+    }
+
+    my $hashref = $statement->fetchrow_hashref();
+    $statement->finish();
+
+    return $hashref;
+}
+
+# function: GetByISBN($isbn)
+#           retrieves a book by ISBN.
+#
+sub GetByISBN($) {
+    my ($isbn) = @_;
+
+    my $statement = $Common::CEODB->prepare("SELECT * FROM books WHERE isbn = ?");
+
+    my $result = $statement->execute($isbn);
+
+    if (!$result) {
+        &Common::Log(10, "Books::GetByISBN", "books table",
+                     "Error: select for isbn=$isbn failed");
+        $statement->finish();
+        return undef();
+    }
+
+    my $hashref = $statement->fetchrow_hashref();
+    $statement->finish();
+
+    return $hashref;    
+}
+
+# function: GetAll()
+#           retrieves all books. Returns it as an array.
+#
+sub GetAll() {
+    my $statement = $Common::CEODB->prepare("SELECT * FROM books ORDER by title, author;");
+
+    my $result = $statement->execute();
+
+    if (!$result) {
+        &Common::Log(10, "Books::GetAll", "books table",
+                     "Error: select failed");
+        $statement->finish();
+        return undef();
+    }
+
+    my @list = ();
+    while ( my $hashref = $statement->fetchrow_hashref() ) {
+        push @list, $hashref;
+    }
+
+    $statement->finish();
+
+    return @list;    
+}
+
+# function: CheckBarcode($barcode)
+#           This works for EAN-13 barcodes.
+#           Returns 1 if $barcode's checksum is correct, 0 otherwise
+sub CheckBarcode($) {
+    (my $barcode) = @_;
+    my $checksum = 0;
+    for (my $i = 0; $i < 6; ++$i) {
+        $checksum += substr($barcode, $i * 2 + 1, 1);
+    }
+    $checksum *= 3;
+    for (my $i = 0; $i < 6; ++$i) {
+        $checksum += substr($barcode, $i * 2, 1);
+    }
+    $checksum %= 10;
+    $checksum = 10 - $checksum;
+    if ($checksum == substr($barcode, 12)) {
+        return 1;
+    } else {
+        return 0;
+    }
+}
+
+# function: GetISBNFromBarcode($barcode)
+#           returns the ISBN corresponding to a book's barcode.
+sub GetISBNFromBarcode($) {
+    (my $barcode) = @_;
+
+    my $checksum = 0;
+    for (my $i = 0; $i < 9; ++$i) {
+        $checksum += substr($barcode, $i + 3, 1) * ($i + 1);
+    }
+    $checksum %= 11;
+    if ($checksum == 10) { $checksum = "x"; }
+    my $isbn = substr($barcode, 3, 9) . $checksum;
+
+    return $isbn;
+}
+
+# function: GetBorrower($bookid)
+#           returns the member id of the member who is borrowing this
+#           book. Undef if the book doesn't exist or isn't out.
+sub GetBorrower($) {
+    my ($bookid) = @_;
+    my $statement = $Common::CEODB->prepare("SELECT memberid FROM members_books WHERE bookid = ?;");
+
+    my $result = $statement->execute($bookid);
+
+    if (!$result) {
+        &Common::Log(10, "Books::Get", "books table",
+                     "Error: select failed");
+        $statement->finish();
+        return undef();
+    }
+
+    my $hashref = $statement->fetchrow_hashref();
+    if ($hashref) {
+        $statement->finish;
+        return $hashref->{'memberid'};
+    } else {
+        $statement->finish;
+        return undef();
+    }
+}
+
+# function: GetOnLoan()
+#           retrieves a list of books currently on loan, with the
+#           members who have borrowed them.
+sub GetOnLoan() {
+    my $statement = $Common::CEODB->prepare("SELECT books.*, memberid, date_out FROM books, members_books WHERE books.bookid = members_books.bookid ORDER by title, author;");
+
+    my $result = $statement->execute();
+
+    if (!$result) {
+        &Common::Log(10, "Books::GetOnLoan", "books table",
+                     "Error: select failed");
+        $statement->finish();
+        return undef();
+    }
+
+    my @list = ();
+    while ( my $hashref = $statement->fetchrow_hashref() ) {
+        push @list, $hashref;
+    }
+
+    $statement->finish();
+
+    return @list;    
+}
+
+# function: TakeOutBook($bookid, $memberid)
+#           gives a book on loan to a member if possible.
+#           returns 1 if successful.
+sub TakeOutBook($$) {
+    my ($bookid, $memberid) = @_;
+    if (GetBorrower($bookid)) {
+        return 0;
+    }
+    my $statement = $Common::CEODB->prepare(
+             "INSERT INTO members_books (memberid, bookid) VALUES (?,?)");
+
+    my $result = $statement->execute($memberid, $bookid);
+
+    if (!$result) {
+        &Common::Log(10, "Books::TakeOutbook", "members_books table",
+                     "could not add memberid/bookid to table");
+        $statement->finish();
+        return 0;
+    }
+    
+    $statement->finish();
+
+    return 1;
+}
+
+# function: ReturnBook($bookid, $memberid)
+#           returns a book taken on loan by memberid.
+sub ReturnBook($$) {
+    my ($bookid, $memberid) = @_;
+    if (GetBorrower($bookid) != $memberid) {
+        return 0;
+    }
+
+    my $statement = $Common::CEODB->prepare(
+             "DELETE FROM members_books WHERE memberid = ? AND bookid = ?");
+
+    my $result = $statement->execute($memberid, $bookid);
+
+    if (!$result) {
+        &Common::Log(10, "Books::ReturnBook", "members_books table",
+                     "could not remove memberid/bookid from table");
+        $statement->finish();
+        return 0;
+    }
+    
+    $statement->finish();
+
+    return 1;
+}
+
+# function: Add(\%book)
+#           adds a book to the database
+sub Add(\%) {
+    my ($book_ref) = @_;
+
+    my $statement = $Common::CEODB->prepare("SELECT NEXTVAL('bookid_seq')");
+    my $result = $statement->execute();
+    
+    if (!$result) {
+        &Common::Log(10, "Books::Add", "books table",
+                     "Error: failed to retrieve next bookid from sequence");
+        $statement->finish();
+        return 0;
+    }
+
+    my $bookid = $statement->fetchrow_hashref()->{'nextval'};
+
+    $statement->finish();
+    
+    $statement = $Common::CEODB->prepare(
+             "INSERT INTO books (bookid,isbn,title,author,published,edition,price,class,count) VALUES (?,?,?,?,?,?,?,?,?)");
+
+    $result = $statement->execute($bookid, $book_ref->{'isbn'},
+                                  $book_ref->{'title'},
+                                  $book_ref->{'author'},
+                                  $book_ref->{'published'},
+                                  $book_ref->{'edition'},
+                                  $book_ref->{'price'},
+                                  $book_ref->{'class'},
+                                  $book_ref->{'count'});
+
+    if (!$result) {
+        &Common::Log(10, "Books::Add", "books table", "could not add
+                                  book to table");
+        $statement->finish();
+    return 0;
+    }
+    
+    $statement->finish();
+
+    return $bookid;
+}
diff --git a/modules/Common.pm b/modules/Common.pm
new file mode 100644 (file)
index 0000000..348c0c0
--- /dev/null
@@ -0,0 +1,277 @@
+# Common.pm
+#
+# This module defines common variables and such used thoughout CEO
+# It provides one place where administrators can change CEO variables
+#
+# This module also provides commonly used functions, and functions
+# which all other code need to use consistently (like FileLock and
+# FileUnlock)
+
+package Common;
+
+use strict;
+
+use IO::Handle; 
+use IO::File; 
+use DBI;
+use POSIX;
+
+# The name of the database
+$Common::DBName = 'ceo';
+
+# a lockfile for exclusive DB access (yes, I know it's cheezy, sue me)
+$Common::DBLockFileName = 'ceo.db.lock';
+
+# a db-reference that will be filled in by DBConnect
+$Common::CEODB = undef();
+
+# function: DBConnect()
+#           connects to the CEO database. Sets $Common::CEODB
+#
+#  returns: nothing.
+sub DBConnect() {
+       my $db_ref = DBI->connect("dbi:Pg:dbname=$Common::DBName", "", "",
+                                {RaiseError => 0});
+
+       if(!$db_ref) {
+               # connection failed, this is a fatal error
+               &Common::MailSysadmin("CEO database failing",
+<<EOF
+This message is being sent because the database is failing.
+
+CEO\'s Common::DBConnect cannot connect to the database.
+
+Mail sent to you from CEO script: Common::DBConnect.
+Database error:
+EOF
+               );
+               exit 1;
+       }
+
+       $Common::CEODB = $db_ref; # keep a local copy of the db reference
+}
+
+# function: Log($urgency, $who, $about, $msg)
+#           adds a warning or error message to the ceo log table
+#
+#      arg: $funcname - the name of the function doing the logging
+#      arg: $message - the message to send
+#
+#  returns: nothing
+sub Log($$$$) {
+       my ($urgency, $who, $about, $msg) = @_;
+
+       my $statement = $Common::CEODB->prepare(
+               "INSERT INTO logs (urgency, who, about, message) VALUES (?,?,?,?);");
+
+       my $result = $statement->execute($urgency, $who, $about, $msg);
+
+       # if the query failed, mail the sysadmin
+       if(!$result) {
+               &Common::MailSysadmin("CEO database failing",
+<<EOF
+This message is being sent because the database is failing.
+The following log insert attempt failed:
+
+Urgency: $urgency
+    Who: $who
+  About: $about
+
+$msg
+
+Mail sent to you from CEO script: Common::Log.
+Database error:
+EOF
+                                      . $result->errstr
+               );
+       }
+
+       $statement->finish();
+}
+
+# function: MailSysadmin($subject, $message)
+#           mail the sysadmin
+#
+#      arg: $subject - the subject of the mail message
+#      arg: $message - the message to send
+#
+#  returns: nothing
+sub MailSysadmin($$) {
+       my ($subject, $message) = @_;
+
+        open MAILPROG, '|mail sysadmin';
+        print MAILPROG "Subject: $subject\n";
+        print MAILPROG "\n";
+        print MAILPROG "$message\n";
+        close MAILPROG;
+}
+
+# function: LockFile($filename)
+#           places an advisory lock on a file
+#
+#      arg: $filename - the name of the file to lock
+#
+#  returns: 1 if file was locked successfully, 0 otherwise
+sub LockFile($) {
+       my ($filename) = @_;
+       my $lockfilename = "$filename.lock";
+
+       # try 3 times to create the file .lock.FILENAME
+       my $tries_left = 3;
+       TRY: while($tries_left > 0) {
+               sysopen(HANDLE, $lockfilename, O_RDWR|O_CREAT|O_EXCL)
+                       and last TRY; # if sysopen was successful, break the loop
+               $tries_left--; # otherwise decrement tries left
+               sleep 1 if($tries_left > 0); # only sleep if there are still tries left
+       }
+
+       if($tries_left) {
+               # sysopen was successful
+               close HANDLE;
+               return 1;
+       } else {
+               # sysopen failed 3 times
+               return 0;
+       }
+}
+
+# function: UnlockFile($filename)
+#           removes an advisory lock on a file
+#
+#      arg: $filename - the name of the file to unlock
+#
+#  returns: nothing
+sub UnlockFile($) {
+       my ($filename) = @_;
+       my $lockfilename = "$filename.lock";
+
+       # just unlink the lock file
+       unlink $lockfilename;
+}
+
+# function: SafelyAppendToFile($file, $text)
+#           locks a file and appends $text to the file.
+#
+#      arg: $file - the file to append to
+#      arg: $text - the text to append
+#
+#  returns: true on success, false on failure
+sub SafelyAppendToFile($$) {
+       my ($file, $text) = @_;
+
+       # lock the file
+       my $status = &Common::LockFile($file);
+       return 0 if(!$status);
+
+       # open the file for append
+       if( !open(FILE, ">>$file") ) {
+               &Common::UnlockFile($file);
+               return 0;
+       }
+
+       # append data to the file
+       print FILE "$text";
+
+       # close, unlock the file, and return success
+       close FILE;
+       &Common::UnlockFile($file);
+       return 1;
+}
+
+# function: PrintHashRef(\%hashref)
+#           prints a hash in a pretty way
+#
+#      arg: \%hashref - a reference to the hash to print
+#
+#  returns: nothing
+sub PrintHashRef(\%) {
+       my ($hashref) = @_;
+
+       my %hash = %$hashref;
+
+       my ($key,$value);
+       while ( ($key, $value) = each %hash) {
+               print "$key = $value\n";
+       }
+}
+
+# function: PrintHash(%hash)
+#           prints a hash in a pretty way
+#
+#      arg: %hash - the hash to print
+#
+#  returns: nothing
+sub PrintHash(%) {
+       my %hash = @_;
+
+       my ($key, $value);
+       while ( ($key, $value) = each %hash ) {
+               print "$key = $value\n";
+       }
+}
+
+# function: WhichTerm($year, $month)
+#           returns the term represtentation for the month and year
+#
+#      arg: $year - which year (i.e., 2001)
+#      arg: $month - month as a number (0 => january, 11 => december)
+#
+#  returns: a string representation of the term for that month/year
+#           e.g.  f2001 or s2003 or w1999
+sub WhichTerm($$) {
+       my ($year, $month) = @_;
+
+       my $term;
+
+       if($month <= 3)    { $term = 'w'; }
+       elsif($month <= 7) { $term = 's'; }
+       else               { $term = 'f'; }
+
+       return sprintf("%s%4d", $term, $year);
+}
+
+# function: CurrentTerm()
+#           like calling WhichTerm with the current year and month
+#
+#  returns: a string representation of the curent month/year
+sub CurrentTerm() {
+       my @time = localtime;
+
+       return WhichTerm(1900 + $time[5], $time[4]);
+}
+
+# function: NumericToStringTerm($n)
+#           converts a term $n from yyyy * 3 + t to [fws]yyyy
+#
+# returns: a string representation of the given term
+sub NumericToStringTerm($) {
+    my ($n) = @_;
+    my @t = ("w", "s", "f");
+    return $t[$n % 3] . POSIX::floor($n / 3);
+}
+
+# function: StringToNumericTerm($t)
+#           converts a term $n from [fws]yyyy to yyyy * 3 + t
+#
+# returns: a numeric representation of the given term
+sub StringToNumericTerm($) {
+    my ($t) = @_;
+    my $s = 3 * substr($t, 1, 4);
+    if (substr($t, 0, 1) eq "s") { $s += 1; }
+    if (substr($t, 0, 1) eq "f") { $s += 2; }
+    return $s;
+}
+
+# function: ValidTermFormat($term)
+#           tells wether the $term variable is formatted correctly
+#
+#      arg: $term - the term variable to check
+#
+#  returns: 1 if $term is formatted correctly, 0 otherwise
+sub ValidTermFormat($) {
+       my ($term) = @_;
+
+       return ( $term =~ /^[swf]\d{4}$/ ? 1 : 0 );
+}
+
+1;
diff --git a/modules/Format.pm b/modules/Format.pm
new file mode 100644 (file)
index 0000000..b85d685
--- /dev/null
@@ -0,0 +1,24 @@
+package Format;
+
+# A package that contains functions to format ceo output
+
+use strict;
+
+# function: format_member_list(@list)
+#           makes nice output of a list of members
+#      arg: @list - a list of member hash references to be output
+#  returns: the formatted output
+sub format_member_list(@) { 
+    my (@list, $line, $output, $value ) = @_;
+
+    while ( $line = shift @list ) { 
+       $output .= sprintf "%4d %50s %10s %10s \n%55s %10s\n\n",
+       $$line{'memberid'}, $$line{'name'}, $$line{'studentid'},
+       $$line{'type'}, $$line{'program'}, ($$line{'userid'} || "");
+    }
+    return $output;
+}
+
+
+1;
+
diff --git a/modules/Members.pm b/modules/Members.pm
new file mode 100644 (file)
index 0000000..b1e9550
--- /dev/null
@@ -0,0 +1,331 @@
+
+# Members.pm
+#
+# defines functions for manipulating the member table
+
+# The common representation of the member (how it's going to be
+# returned from functions, passed into functions, etc.), is a reference to
+# a hash with the elements: memberid, name, studentid, program, and type
+
+package Members;
+
+use strict;
+
+require Common;
+
+# function: Get($memberid)
+#           finds the member with the specified memberid
+#
+#      arg: $memberid - the memberid to search for (an integer)
+#
+#  returns: if member is found, a reference to a member hash, otherwise undef()
+sub Get($) {
+       my ($memberid) = @_;
+
+       # the query
+       my $statement = $Common::CEODB->prepare(
+               "SELECT * FROM members WHERE memberid = ?");
+
+       # execute the query with the argument
+       my $result = $statement->execute($memberid);
+
+       if(!$result) {
+               # query failed, report that
+               &Common::Log(
+                       10,
+                       "Members::Get",
+                       "members table",
+                       "Error: select for memberid=$memberid failed");
+               $statement->finish();
+               return undef();
+       }
+
+       # query succeeded, return the result
+       my $hashref = $statement->fetchrow_hashref();
+
+       $statement->finish();
+
+       return $hashref;
+
+}
+
+# function: GetByUserId($memberid)
+#           finds the member with the specified userid
+#
+#      arg: $userid - the userid to search for
+#
+#  returns: if member is found, a reference to a member hash, otherwise undef()
+sub GetByUserId($) {
+       my ($userid) = @_;
+
+       # the query
+       my $statement = $Common::CEODB->prepare(
+               "SELECT * FROM members WHERE userid = ?");
+
+       # execute the query with the argument
+       my $result = $statement->execute($userid);
+
+       if(!$result) {
+               # query failed, report that
+               &Common::Log(
+                       10,
+                       "Members::GetByUserId",
+                       "members table",
+                       "Error: select for userid=$userid failed");
+               $statement->finish();
+               return undef();
+       }
+
+       # query succeeded, return the result
+       my $hashref = $statement->fetchrow_hashref();
+
+       $statement->finish();
+
+       return $hashref;
+
+}
+
+# function: GetByTerm($term, [$sortby])
+#           finds all members registered for $term
+#      arg: $term - the term [fws]20nn to list
+#      arg: $sortby - a string to sort the list by
+# returns: a list of references to member hashes
+sub GetByTerm($;$) {
+    my ($term, $sortby) = @_;
+
+    $sortby = "members.name" unless ( $sortby );
+
+    my $statement = $Common::CEODB->prepare("SELECT * FROM members,
+    terms WHERE term = ? AND members.memberid = terms.memberid ORDER
+    BY $sortby");
+
+    my $result = $statement->execute($term);
+    if (!$result) {
+        # query failed, report that
+        &Common::Log(
+                     10,
+                     "Members::GetByTerm",
+                     "members",
+                     "Error: select for term=$term failed - ");
+        $statement->finish();
+        return ();
+    }
+
+    my @list = ();
+    while ( my $hashref = $statement->fetchrow_hashref() ) {
+        push @list, $hashref;
+    }
+
+    $statement->finish();
+    
+    return @list;
+}
+
+# function: GetByTerm($term, [$sortby])
+#           finds all members registered for $term
+#      arg: $sortby - a string to sort the list by
+# returns: a list of references to member hashes
+sub GetAll(;$) {
+    my ($sortby) = @_;
+
+    $sortby = "members.name" unless ( $sortby );
+
+    my $statement = $Common::CEODB->prepare("SELECT * FROM members ORDER
+    BY $sortby");
+
+    my $result = $statement->execute();
+    if (!$result) {
+        # query failed, report that
+        &Common::Log(
+                     10,
+                     "Members::GetAll",
+                     "members",
+                     "Error: select failed - ");
+        $statement->finish();
+        return ();
+    }
+
+    my @list = ();
+    while ( my $hashref = $statement->fetchrow_hashref() ) {
+        push @list, $hashref;
+    }
+
+    $statement->finish();
+    
+    return @list;
+}
+
+# function: GetByName($str, [$exact])
+#           finds all members with 'str' in their name
+#
+#      arg: $str - the string to search for in the members' names
+#      arg: $exact - forces query to search for exact mach, not
+#           a substring match.
+#
+#  returns: a list of references to member hashes
+sub GetByName($;$) {
+       my ($str, $exact) = @_;
+
+       # the query
+       my $statement = $Common::CEODB->prepare(
+               "SELECT * FROM members WHERE name ~* ? ORDER BY name");
+
+       # execute the query with the argument
+       my $result = $statement->execute( $str );
+
+       if(!$result) {
+               # query failed, report that
+               &Common::Log(
+                       10,
+                       "Members::GetByName",
+                       "members",
+                       "Error: select for name=$str failed");
+               $statement->finish();
+               return ();
+       }
+
+       my @list = ();
+        while ( my $hashref = $statement->fetchrow_hashref() ) {
+            push @list, $hashref;
+        }
+
+       $statement->finish();
+
+       return @list;
+}
+
+# function: GetByStudentID($str, [$exact])
+#           finds all members matching the student id
+#
+#      arg: $str - the string to search for in the members' ids
+#      arg: $exact - forces query to search for exact mach, not
+#           a substring match.
+#
+#  returns: a list of references to member hashes
+sub GetByStudentID($;$) {
+       my ($str, $exact) = @_;
+
+       # the query
+       my $statement = $Common::CEODB->prepare(
+               "SELECT * FROM members WHERE studentid LIKE ?");
+
+       # execute the query with the argument
+       my $result = $statement->execute( $exact ? $str : "\%$str\%" );
+
+       if(!$result) {
+               # query failed, report that
+               &Common::Log(
+                       10,
+                       "Members::GetByStudentID",
+                       "members table",
+                       "Error: select for studentid=$str failed");
+               $statement->finish();
+               return ();
+       }
+
+       my @list = ();
+        while ( my $hashref = $statement->fetchrow_hashref() ) {
+            push @list, $hashref;
+        }
+
+       $statement->finish();
+
+       return @list;
+}
+
+# function: Add(\%member)
+#           adds a member to the database
+#
+#      arg: \%member - a reference to the member hash
+#
+#  returns: The memberid if member was added successfully, 0 otherwise
+sub Add(\%) {
+       my ($member_ref) = @_;
+
+       # get the next member id value
+       my $statement = $Common::CEODB->prepare(
+               "SELECT NEXTVAL('memberid_seq')");
+       my $result = $statement->execute();
+       if(!$result) {
+               # this failed
+               &Common::Log(
+                       10,
+                       "Members::Add",
+                       "members table",
+                       "Error: failed to retrieve next memberid from sequence");
+               $statement->finish();
+               return 0;
+       }
+       my $memberid = $statement->fetchrow_hashref()->{'nextval'};
+
+       # prepare the statement
+       $statement = $Common::CEODB->prepare(
+               "INSERT INTO members (memberid,name,studentid,program,type) " .
+               " VALUES (?,?,?,?,?)");
+
+       # execute
+       $result = $statement->execute(
+               $memberid,
+               $member_ref->{'name'},
+               $member_ref->{'studentid'},
+               $member_ref->{'program'},
+               $member_ref->{'type'});
+       if(!$result) {
+               # query failed, report that
+               &Common::Log(
+                       10,
+                       "Members::Add",
+                       "members table",
+                       sprintf("Error: add for member (%s %s %s %s %s) failed",
+                               $memberid,
+                               $member_ref->{'name'},
+                               $member_ref->{'studentid'},
+                               $member_ref->{'program'},
+                               $member_ref->{'type'}));
+               $statement->finish();
+               return 0;
+       }
+
+       $statement->finish();
+
+       return $memberid;
+}
+
+# function: Print(\%member)
+#           prints out a member
+#
+#      arg: \%member - the member to print
+#
+#  returns: nothing
+sub Print(\%) {
+       my ($member_ref) = @_;
+        my $printout;
+
+       if($member_ref->{'type'} eq 'club') {
+               $printout = sprintf "   Club: %-20s        ID: %-10d\n",
+                       $member_ref->{'name'},
+                       $member_ref->{'memberid'},
+       } else {
+            $printout = sprintf("   Name: %-20s        ID: %-10d (%s)\n",
+                   $member_ref->{'name'},
+                   $member_ref->{'memberid'},
+                   $member_ref->{'type'});
+            $printout .= sprintf("Program: %-20s StudentID: %-10s\n",
+                   $member_ref->{'program'},
+                   $member_ref->{'studentid'});
+            if ($member_ref->{'userid'}) {
+                $printout .= sprintf("User ID: %s\n", $member_ref->{'userid'});
+            } else {
+                $printout .= sprintf("No user ID.\n");
+            }
+            $printout .= sprintf("Terms: ");
+            my @terms = &Terms::GetByMember($member_ref->{'memberid'});
+            foreach my $term (sort {&Terms::Compare($a, $b)} @terms) {
+                $printout .= sprintf($term . " ");
+            }
+            $printout .= "\n";
+       }
+        &UI::MsgWait($printout);
+}
+
+1;
diff --git a/modules/Quotas.pm b/modules/Quotas.pm
new file mode 100644 (file)
index 0000000..e96a322
--- /dev/null
@@ -0,0 +1,115 @@
+
+# Quotas.pm
+#
+# Handles account quotas
+
+# an account has quota for a term if there is an entry in the quotas table
+# with that account userid, the given term, and the amount of quota allocated
+
+package Quotas;
+
+use strict;
+
+require Common;
+
+# function: BuyQuota($userid, $term, $quota)
+#           buys $quota more quota for account $accountid for term $term
+#
+#      arg: $userid - the user to buy quota for
+#      arg: $term - the term to buy quota for
+#      arg: $quota - the amount of quota to buy
+#
+#  returns: true on success, false on failure
+sub BuyQuota($$$) {
+       my ($userid, $term, $quota) = @_;
+       my ($statement, $result);
+
+       # get the account id belonging to $userid
+       $statement = $Common::CEODB->prepare(
+                       "SELECT accountid FROM accounts WHERE userid = ?;");
+       my $accountid = $statement->execute($userid);
+       if ($accountid == -1) {
+         return 0;
+       }
+
+       # get the current quota
+       my $currquota = &Quotas::GetQuota($accountid, $term);
+
+       if($currquota == -1) {
+               # no quota has been allocated yet.  Do an insert
+               $statement = $Common::CEODB->prepare(
+                       "INSERT INTO quotas (accountid, term, quota) VALUES (?, ?, ?)");
+               # execute
+               $result = $statement->execute($accountid, $term, $quota);
+       } else {
+               # some quota has been allocated.  Do an update
+               $statement = $Common::CEODB->prepare(
+                       "UPDATE quotas SET quota = ? WHERE (accountid = ? AND term = ?)");
+               $quota += $currquota;
+               # execute
+               $result = $statement->execute($quota, $accountid, $term);
+       }
+
+       if(!$result) {
+               # query failed, report that
+               &Common::Log(
+                       10,
+                       "Quotas::BuyQuota",
+                       "quotas table",
+                       "Error: update quota+=$quota accountid=$accountid term=$term failed");
+               $statement->finish();
+               return 0;
+       }
+
+       # finish the statement
+       $statement->finish();
+
+       # since we cannot be sure about the result of "UPDATE" queries, recheck
+       # the values
+       $currquota = &Quotas::GetQuota($accountid, $term);
+       if($currquota != $quota) {
+               return 0;
+       }
+
+       return 1;
+}
+
+# function: GetQuota($accountid, $term)
+#           gets the quota for an account for a particular term
+#
+#      arg: $accountid - the account to get quota for
+#      arg: $term - the term to get the quota for
+#
+#  returns: on success, the amount of quota allocated for that account for
+#           that term.
+#           on failure, -1
+sub GetQuota($$) {
+       my ($accountid, $term) = @_;
+
+       # the query
+       my $statement = $Common::CEODB->prepare(
+               "SELECT quota FROM quotas WHERE accountid = ? AND term = ?");
+
+       # execute
+       my $result = $statement->execute($accountid, $term);
+       if(!$result) {
+               # query failed, report that
+               &Common::Log(
+                       10,
+                       "Quotas::GetQuota",
+                       "quotas table",
+                       "Error: select quota where accountid=$accountid term=$term failed");
+               $statement->finish();
+               return -1;
+       }
+
+       # grab the result
+       my $row = $statement->fetchrow_hashref();
+       $statement->finish();
+       if(!$row) {
+               return -1;
+       }
+       return $row->{'quota'};
+}
+
+1;
diff --git a/modules/Scripts.pm b/modules/Scripts.pm
new file mode 100644 (file)
index 0000000..af8dfda
--- /dev/null
@@ -0,0 +1,53 @@
+
+# Scripts.pm
+#
+# functions to write out to logfiles that are parsed by system scripts
+
+# in addition to keeping the database synced, CEO must issue commands to
+# the cronjobs that maintain the system.  This module provides a set of
+# functions to abstract that.
+
+package Scripts;
+
+use strict;
+
+require Common;
+require Settings;
+
+# function: CreateAccount($userid, $password)
+#           makes an entry in the logfiles to create a new account
+#
+#      arg: $userid - the userid of the account to create
+#      arg: $password - the account password
+#
+#  returns: true on success, false on failure
+sub CreateAccount($$) {
+       my ($userid, $password) = @_;
+
+       # add the line to the new accounts file
+       my $status = &Common::SafelyAppendToFile(
+               $Settings::NewAccountsFile,
+               "userid=$userid password=$password\n");
+
+       return ($status ? 1 : 0);
+}
+
+# function: SetQuota($userid, $quota)
+#           makes entry in logfiles to change $userid's quota to $quota
+#
+#      arg: $userid - the userid to change the quota for
+#      arg: $quota - the quota to change it to
+#
+#  returns: true on success, false on failure
+sub SetQuota($$) {
+       my ($userid, $quota) = @_;
+
+       # add the line to the quota file
+       my $status = &Common::SafelyAppendToFile(
+               $Settings::SetQuotaFile,
+               "userid=$userid quota=$quota\n");
+
+       return ($status ? 1 : 0);
+}
+
+1;
diff --git a/modules/Settings.pm b/modules/Settings.pm
new file mode 100644 (file)
index 0000000..9d222f7
--- /dev/null
@@ -0,0 +1,15 @@
+
+# Settings.pm
+#
+# settings used by the CEO system
+
+package Settings;
+
+use strict;
+
+$Settings::NewAccountsFile = "todo/new_accounts";
+$Settings::SetQuotaFile = "todo/set_quota";
+
+$Settings::ScriptLogFile = "logs/script_log";
+
+1;
diff --git a/modules/Terms.pm b/modules/Terms.pm
new file mode 100644 (file)
index 0000000..d95be73
--- /dev/null
@@ -0,0 +1,169 @@
+
+# Terms.pm
+#
+# Handles member registration
+
+# a member is registered for a term if there is an entry with that memberid
+# and term.
+
+package Terms;
+
+use strict;
+
+require Common;
+
+# function: IsRegistered($memberid, $term)
+#           checks if a member is registered for a term
+#
+#      arg: $memberid - the memberid of member to check for
+#      arg: $term - the term to check for
+#
+#  returns: 1 if member is registered
+#           0 if member is not registered
+#          -1 if check failed
+sub IsRegistered($$) {
+       my ($memberid, $term) = @_;
+
+       # verify the term format
+       return -1 if(!&Common::ValidTermFormat($term));
+
+       # the query
+       my $statement = $Common::CEODB->prepare(
+               "SELECT * FROM terms WHERE memberid = ? AND term = ?");
+
+       # execute
+       my $result = $statement->execute( $memberid, $term );
+       if(!$result) {
+               # query failed, report that
+               &Common::Log(
+                       10,
+                       "Terms::IsRegistered",
+                       "terms table",
+                       "Error: select for member=$memberid term=$term failed");
+               $statement->finish();
+               return -1;
+       }
+
+       # we got a valid response
+       my $row = $statement->fetchrow_hashref();
+
+       $statement->finish();
+
+       return ($row ? 1 : 0);
+}
+
+# function: Register($memberid, $term)
+#           registers a member for a particular term
+#
+#      arg: $memberid - the id of the member to register
+#      arg: $term - the term to register her for
+#
+#  returns: true if successful, false if failed
+sub Register($$) {
+       my ($memberid, $term) = @_;
+
+       # if member is already registered for that term, return true
+       my $already = &Terms::IsRegistered($memberid, $term);
+       return 0 if($already == -1); # IsRegistered failed
+       return 1 if($already == 1);  # IsRegistered returned true
+
+       # make sure the 'term' variable is formatted correctly
+       return 0 if(!&Common::ValidTermFormat($term));
+
+       # the query
+       my $statement = $Common::CEODB->prepare(
+               "INSERT INTO terms (memberid, term) VALUES (?, ?)");
+
+       # execute
+       my $result = $statement->execute($memberid, $term);
+       if(!$result) {
+               # query failed, report that
+               &Common::Log(
+                       10,
+                       "Terms::Register",
+                       "terms table",
+                       "Error: insert for member=$memberid term=$term failed");
+               $statement->finish();
+               return undef();
+       }
+
+       # query succeeded
+       $statement->finish();
+
+       return 1;
+}
+
+# function: RegisterMultiple($memberid, $start, $num)
+#           registers a member for multiple consecutive terms
+#
+#      arg: $memberid - the id of the member to register
+#      arg: $start - the first term to register her for ([fws]nnnn)
+#      arg: $num - the number of terms to register her for
+#
+#  returns: (1, 0) on (success, failure)
+sub RegisterMultiple($$$) {
+    my ($memberid, $start, $num) = @_;
+
+    my $start_num = &Common::StringToNumericTerm($start);
+
+    my $actual_terms = 0;
+    # BEGIN TRANSACTION
+    for (my $i = $start_num; $i < $start_num + $num; $i++) {
+        if (Register($memberid, &Common::NumericToStringTerm($i))) {
+               $actual_terms++;
+        }
+    }
+
+    &UI::MsgWait("Registered Member $memberid for $actual_terms terms.");
+    # COMMIT
+    return 1;
+}
+
+# TODO: docs
+sub GetByMember($) {
+    my ($memberid) = @_;
+
+    my $statement = $Common::CEODB->prepare("SELECT term FROM terms
+    WHERE memberid = ? ORDER BY term");
+
+    # execute the query with the argument
+    my $result = $statement->execute($memberid);
+    
+    if(!$result) {
+        # query failed, report that
+        &Common::Log(
+                     10,
+                     "Terms::GetByMember",
+                     "terms",
+                     "Error: select for memberid=$memberid failed");
+        $statement->finish();
+        return ();
+    }
+    
+    my @list = ();
+    while (my $hashref = $statement->fetchrow_hashref() ) {
+        push @list, $hashref->{'term'};
+    }
+
+    return @list;
+}
+
+sub Compare($$) {
+    my ($a, $b) = @_;
+
+    my $a_year = substr($a, 1);
+    my $b_year = substr($b, 1);
+    
+    if ($a_year <=> $b_year) {
+        return $a_year <=> $b_year;
+    }
+    
+    my $a_term = substr($a, 0, 1);
+    my $b_term = substr($b, 0, 1);
+    $a_term =~ tr/wsf/012/;
+    $b_term =~ tr/wsf/012/;
+
+    return $a_term <=> $b_term;
+}
+
+1;
diff --git a/modules/UI-curses.pm b/modules/UI-curses.pm
new file mode 100644 (file)
index 0000000..f4f4c39
--- /dev/null
@@ -0,0 +1,223 @@
+
+# UI.pm
+#
+# Defines subroutines for easy user interface stuff like displaying menus
+# and stuff
+
+package UI;
+
+use strict;
+use Curses;
+use Curses::Widgets;
+
+my $window = new Curses;
+
+# function: Menu($name, \@menumap)
+#           displays a menu on the screen and executes callback functions
+#           for a particular choice
+#
+#      arg: $name - the menu's toplevel name
+#      arg: \@menumap - a list of references to 3-tuples.  Each 3-tuples
+#           should be an integer, a string, and a callback function.
+#           The integer is what the menu item will be numbered (NOT the
+#           order it will be displayed).  The string is the menu string that
+#           will be printed.  The callback function is the function that
+#           will be called when that menu option is chosen.  If the callback
+#           function returns true, then &Menu exits.  The menu items will
+#           be displayed in the order they are received.
+#
+#           If the integer number is a -1, then that menu entry is discarded,
+#           and blank line is printed in that location of the menu.
+#
+#  returns: nothing
+sub Menu($\@) {
+       my ($name, $menulist) = @_;
+
+       my @callbacks = ();
+        my %list = ();
+
+       my $menuitem;
+       my $i = 0;
+       foreach $menuitem (@$menulist) {
+               if($menuitem->[0] eq 'nil') {
+               } else {
+                       push @callbacks, $menuitem->[2];
+                        $list{$i} = $menuitem->[1];
+                       $i++;
+               }
+       }
+
+       TOP: for(;;) { # do this forever
+               
+               # first, clear the screen
+            &UI::ClearScreen();
+           $window->addstr(0, 1, $name);
+           $window->refresh();
+            my $input;
+            my $selected;
+            ($input, $selected) = list_box('window' => $window,
+                                           'xpos' => 0,
+                                           'ypos' => 1,
+                                           'lines' => 20,
+                                           'cols' => 70,
+                                           'list' => \%list,
+                                           'border' => 'red',
+                                          'regex' => "\n",
+                                           'sort' => 'numeric');
+
+            # verify it is valid
+            next TOP if(!$callbacks[$selected]);
+            
+            # execute the appropriate function (after clearing screen)
+            &UI::ClearScreen();
+            # execute it in an eval to support people dropping out
+            # UI::Prompt subroutines by typing in 'exit', but not exiting
+            # the program
+            eval {
+                my $result = $callbacks[$selected]->();
+                die ($result ? 1 : 0);
+            };
+            # parse out the "return" value from the $@ variable
+               my ($result) = split ' ', $@, 2;
+            if ($result =~ "[^01]") {
+                &UI::MsgWait("Error: " . $@);
+            }
+            last TOP if(!$result);
+       }
+}
+
+# function: MsgWait($msg)
+#           prints the specified message and waits for a carriage return
+#
+#      arg: $msg - the message to print
+#
+#  returns: nothing
+sub MsgWait($) {
+    my ($msg) = @_;
+    
+    if ($msg) {
+        msg_box('window' => $window,
+                'title' => 'Message',
+                'message' => "$msg");
+    }
+}
+
+# fucntion: Prompt($msg, [$type], [$custom])
+#           prompts the user for an entry and returns it, potentially
+#           does typechecking
+#
+#      arg: $msg - the message to prompt with
+#      arg: $type - the type to check for.  This should be one of the
+#           following:
+#             the strings 'int', 'yesno', 'string', 'regex', 'custom'
+#      arg: $custom - if $type is 'regex', then this should be a regular
+#           expression.  if the string matches, it will be returned.
+#           if $type is 'custom', then this should be a reference to a
+#           subroutine that checks the passed-in string for validity,
+#           and reutrns a 2-tuple.  If the match failed, the first element
+#           of the tuple should be false, otherwise, the first element
+#           should be true, and the second element should be what to
+#           return
+#      arg: $password - if this is 1, shadow what's being read
+#
+#  returns: in the case of 'int', an integer is returned.
+#           in the case of 'yesno', an integer 1 or 0 is returned
+#           in the case of 'string', the entire string is returned
+#           in the case of 'regex', the entire string is returned
+#           in the case of 'custom', the return value of $custom is returned
+sub Prompt($;$$$) {
+       my ($msg, $type, $custom, $password) = @_;
+        if (!$password) { $password = 0;}
+        
+       TOP: for(;;) {
+            my $retval;
+            my $button;
+            
+            ($retval, $button)
+                = input_box('window' => $window,
+                            'title' => "Prompt",
+                            'cols' => 50,
+                            'prompt' => $msg,
+                            'password' => $password,
+                            'content' => "",
+                            'regex' => "\n");
+            my $input = $retval;
+            # if we receive 'exit', die with 1.  This is caught by any
+            # UI::Menu subroutine running above this routine
+            die 1 if($input eq 'exit' || $button == 0);
+            
+            # check against potential input type
+            if($type eq 'int') {
+                next TOP if($input !~ /^\d+$/);
+                return int($input);
+            } elsif($type eq 'yesno') {
+                $input =~ tr/A-Z/a-z/;
+                next TOP if($input !~ /^(y|yes|n|no)$/);
+                return ($input =~ /^(y|yes)$/ ? 1 : 0);
+            } elsif($type eq 'string') {
+                next TOP if($input eq '');
+                return $input;
+            } elsif($type eq 'regex') {
+                next TOP if($input !~ /$custom/);
+                return $input;
+            } elsif($type eq 'custom') {
+                my ($success, $value) = $custom->($input);
+                next TOP if(!$success);
+                return $value;
+            } else {
+                # default case, just grab the string and return it
+                return $input;
+            }
+       }
+    }
+
+
+# function: Page($text)
+#           prints text on the screen for the user to page through
+#      arg: $text - the text to be printed on the screen
+#
+#  returns: nothing
+sub Page($) {
+    my ($text) = @_;
+    my $pager;
+
+    $SIG{PIPE} = 'IGNORE';
+    $pager = "/usr/bin/less" ;#unless $pager = $ENV{'PAGER'};
+    if (open LESS, "|$pager") {
+        print LESS $text;
+        close LESS; # this will wait for less to close
+    } else {
+       MsgWait($text);
+    }
+}
+
+# function: EchoOff()
+#           sends the no echo command to the screen (for password purposes)
+#
+#  returns: nothing
+sub EchoOff() {
+#    system("/usr/bin/stty -echo");
+}
+
+# function: EchoOn()
+#           sends the echo command to the screen (after password purposes)
+#
+#  returns: nothing
+sub EchoOn() {
+#    system("/usr/bin/stty echo");
+}
+
+# function: ClearScreen()
+#           clears the screen
+#
+#  returns: nothing
+sub ClearScreen() {
+    $window->clear();
+    $window->refresh();
+}
+
+END {
+    endwin;
+}
+
+1;
diff --git a/modules/UI-text.pm b/modules/UI-text.pm
new file mode 100644 (file)
index 0000000..db7511c
--- /dev/null
@@ -0,0 +1,216 @@
+
+# UI.pm
+#
+# Defines subroutines for easy user interface stuff like displaying menus
+# and stuff
+
+package UI;
+
+use strict;
+
+# function: Menu($name, \@menumap)
+#           displays a menu on the screen and executes callback functions
+#           for a particular choice
+#
+#      arg: $name - the menu's toplevel name
+#      arg: \@menumap - a list of references to 3-tuples.  Each 3-tuples
+#           should be an integer, a string, and a callback function.
+#           The integer is what the menu item will be numbered (NOT the
+#           order it will be displayed).  The string is the menu string that
+#           will be printed.  The callback function is the function that
+#           will be called when that menu option is chosen.  If the callback
+#           function returns true, then &Menu exits.  The menu items will
+#           be displayed in the order they are received.
+#
+#           If the integer number is a -1, then that menu entry is discarded,
+#           and blank line is printed in that location of the menu.
+#
+#  returns: nothing
+sub Menu($\@) {
+       my ($name, $menulist) = @_;
+
+       my %key_2_callback = ();
+       my @display_list = ();
+
+       my $menuitem;
+       foreach $menuitem (@$menulist) {
+               if($menuitem->[0] eq 'nil') {
+                       push @display_list, "";
+               } else {
+                       $key_2_callback{$menuitem->[0]} = $menuitem->[2];
+                       push @display_list, "[" . $menuitem->[0] . "] " . $menuitem->[1];
+               }
+       }
+
+       TOP: for(;;) { # do this forever
+               
+               # first, clear the screen
+               &UI::ClearScreen();
+
+               # print the menu name with a line of '-'s below it
+               print "\n\n";
+               print "$name\n";
+               print '-' x length $name, "\n";
+               print "\n";
+
+               # print each menu item and number it
+               my $display_item;
+               foreach $display_item (@display_list) {
+                       printf "$display_item\n";
+               }
+               print "\n";
+
+               # print a question mark, read an input line
+               print "? ";
+               my $input = <STDIN>;
+               chomp $input;
+
+               # verify it is valid
+               next TOP if(!$key_2_callback{$input});
+
+               # execute the appropriate function (after clearing screen)
+               &UI::ClearScreen();
+               # execute it in an eval to support people dropping out
+               # UI::Prompt subroutines by typing in 'exit', but not exiting
+               # the program
+               eval {
+                       my $result = $key_2_callback{$input}->();
+                       die ($result ? 1 : 0);
+               };
+               # parse out the "return" value from the $@ variable
+               my ($result) = split ' ', $@, 2;
+                if ($result =~ "[^01]") {
+                    &UI::MsgWait("Error: " . $@);
+                }
+               last TOP if(!$result);
+       }
+}
+
+# function: MsgWait($msg)
+#           prints the specified message and waits for a carriage return
+#
+#      arg: $msg - the message to print
+#
+#  returns: nothing
+sub MsgWait($) {
+       my ($msg) = @_;
+
+       print "\n$msg" if($msg ne '');
+       print "\nPlease press <ENTER> to continue\n";
+       <STDIN>;
+}
+
+# fucntion: Prompt($msg, [$type], [$custom])
+#           prompts the user for an entry and returns it, potentially
+#           does typechecking
+#
+#      arg: $msg - the message to prompt with
+#      arg: $type - the type to check for.  This should be one of the
+#           following:
+#             the strings 'int', 'yesno', 'string', 'regex', 'custom'
+#      arg: $custom - if $type is 'regex', then this should be a regular
+#           expression.  if the string matches, it will be returned.
+#           if $type is 'custom', then this should be a reference to a
+#           subroutine that checks the passed-in string for validity,
+#           and reutrns a 2-tuple.  If the match failed, the first element
+#           of the tuple should be false, otherwise, the first element
+#           should be true, and the second element should be what to return
+#      arg: $password - if this is 1, hide the input
+#
+#  returns: in the case of 'int', an integer is returned.
+#           in the case of 'yesno', an integer 1 or 0 is returned
+#           in the case of 'string', the entire string is returned
+#           in the case of 'regex', the entire string is returned
+#           in the case of 'custom', the return value of $custom is returned
+sub Prompt($;$$$) {
+       my ($msg, $type, $custom, $password) = @_;
+
+       TOP: for(;;) {
+               # print the message
+               print $msg;
+
+               if ($password) {
+                       EchoOff();
+               }
+               # grab input
+               my $input = <STDIN>;
+               chomp $input;
+               if ($password) {
+                       print "\n";
+                       EchoOn();
+               }
+
+               # if we receive 'exit', die with 1.  This is caught by any
+               # UI::Menu subroutine running above this routine
+               die 1 if($input eq 'exit');
+
+               # check against potential input type
+               if($type eq 'int') {
+                       next TOP if($input !~ /^\d+$/);
+                       return int($input);
+               } elsif($type eq 'yesno') {
+                       $input =~ tr/A-Z/a-z/;
+                       next TOP if($input !~ /^(y|yes|n|no)$/);
+                       return ($input =~ /^(y|yes)$/ ? 1 : 0);
+               } elsif($type eq 'string') {
+                       next TOP if($input eq '');
+                       return $input;
+               } elsif($type eq 'regex') {
+                       next TOP if($input !~ /$custom/);
+                       return $input;
+               } elsif($type eq 'custom') {
+                       my ($success, $value) = $custom->($input);
+                       next TOP if(!$success);
+                       return $value;
+               } else {
+                       # default case, just grab the string and return it
+                       return $input;
+               }
+       }
+}
+
+
+# function: Page($text)
+#           prints text on the screen for the user to page through
+#      arg: $text - the text to be printed on the screen
+#
+#  returns: nothing
+sub Page($) {
+    my ($text) = @_;
+    my $pager;
+
+    $SIG{PIPE} = 'IGNORE';
+    $pager = "/usr/bin/less" ;#unless $pager = $ENV{'PAGER'};
+    if (open LESS, "|$pager") { 
+       print LESS $text;
+       close LESS; # this will wait for less to close
+    } else {
+       print $text;
+    }
+}
+
+# function: EchoOff()
+#           sends the no echo command to the screen (for password purposes)
+#
+#  returns: nothing
+sub EchoOff() {
+       system("/bin/stty -echo");
+}
+
+# function: EchoOn()
+#           sends the echo command to the screen (after password purposes)
+#
+#  returns: nothing
+sub EchoOn() {
+       system("/bin/stty echo");
+}
+
+# function: ClearScreen()
+#           clears the screen
+#
+#  returns: nothing
+sub ClearScreen() {
+       system('/usr/bin/clear');
+}
+
+1;
diff --git a/test.pl b/test.pl
new file mode 100644 (file)
index 0000000..d99668d
--- /dev/null
+++ b/test.pl
@@ -0,0 +1,13 @@
+#!/usr/bin/perl -Imodules
+
+require Common;
+require Books;
+
+&Common::DBConnect();
+$foo = &Books::GetByISBN("0312041233");
+if (defined $foo) {
+    print "Already there\n";
+} else {
+    print "Nonono.\n";
+}
+
diff --git a/test_bookq.pl b/test_bookq.pl
new file mode 100755 (executable)
index 0000000..7a966f1
--- /dev/null
@@ -0,0 +1,97 @@
+#!/usr/bin/perl -Imodules
+
+require BookQuery;
+
+# function: GetISBNFromBarcode($barcode)
+#           returns the ISBN corresponding to a book's barcode.
+sub GetISBNFromBarcode($) {
+    (my $barcode) = @_;
+
+    my $checksum = 0;
+    for (my $i = 0; $i < 9; ++$i) {
+        $checksum += substr($barcode, $i + 3, 1) * ($i + 1);
+    }
+    $checksum %= 11;
+    if ($checksum == 10) { $checksum = "x"; }
+    my $isbn = substr($barcode, 3, 9) . $checksum;
+
+    return $isbn;
+}
+
+
+%session = &BookQuery::InitiateSession("z3950.loc.gov", 7090,
+                                       "VOYAGER");
+
+my $isbn = <STDIN>;
+chomp $isbn;
+
+print "Looking for book $isbn\n";
+
+if ($session{'success'}) {
+    print "Successful!\n";
+    print "Session ID " . $session{'id'} . "\n";
+    %bookinfo = &BookQuery::LookupBook(\%session, GetISBNFromBarcode($isbn));
+    if ($bookinfo{'success'}) {
+        print "Looked up book!\n";
+        foreach $key (keys %bookinfo) {
+            if ($key eq "content") { next; }
+            print $key . ": " . $bookinfo{$key} . "\n";
+        }
+    } else {
+        print "Error looking up book: " . $bookinfo{'error'} . "\n";
+    }
+} else {
+    print "Unsuccessful: " . $session{'error'} . "\n";
+    print %session . "\n";
+}
+
+# $content = '<HTML>
+# <HEAD>
+# <TITLE>VOYAGER[1565921496[1,7,4,1]]</TITLE>
+# </HEAD>
+# <BODY bgcolor=#FFFFFF>
+# <H1>Query Results</H1>
+# <I>Records 1 through 1 of 1 returned.</I><HR><PRE>Author:        Wall, Larry.
+# Title:         Programming Perl / Larry Wall, Tom Christiansen,
+#                   and Randal L. Schwartz, with Stephen Potter.
+# Edition:       2nd ed.
+# Published:     Sebastopol, CA : O\'Reilly & Associates, c1996.
+# Description:   xxi, 645 p. ; 23 cm.
+# Series:        A Nutshell handbook
+# LC Call No.:   QA76.73.P22W35 1996
+# Dewey No.:     005.13/3 21
+# ISBN:          1565921496
+# Notes:         "Programming"--Cover.
+#                Includes index.
+#                An overview of Perl -- The gory details --
+#                   Functions -- References and nested data structures --
+#                   Packages, modules, and object classes -- Social engineering
+#                   -- The standard Perl library -- Other oddments -- Diagnositic
+#                   messages -- Glossary -- Index.
+# Subjects:      Perl (Computer program language)
+#                Programming Languages.
+# Other authors: Schwartz, Randal L.
+#                Christiansen, Tom.
+# Control No.:   134169
+# </PRE><A HREF="/cgi-bin/zgate?present+184152+Default+1+1+M+1.2.840.10003.5.10+1+/z3950/gateway.html">Tagged display</A>
+# | <A HREF="/cgi-bin/zgate?present+184152+Default+1+1+B+1.2.840.10003.5.10+1+/z3950/gateway.html">Brief Record Display</A>
+# | <A HREF="/cgi-bin/zgate?srchagain+184152+/prod/www/data/z3950/locils.html+1">New Search</A>
+# <HR><P><I>This display was generated by the CNIDR Web-Z39.50 gateway, version 1.08, with Library of Congress Modifications.</I><P>
+# </body>
+# </html>
+# ';
+
+# if ($content =~ /\<PRE\>([^<]*)\<\/PRE\>/s) {
+#     my $parsetext = $1;
+#     print "Parse text: " . $parsetext . "\n";
+#     print "=-=-=-=-=-\n";
+#     while ($parsetext =~ s/^([^:\n]+): ([^\n]*)\n(( [^\n]*\n)*)//ms) {
+#         $section = $1;
+#         $value = $2 . $3;
+#         chomp $value;
+#         $value =~ s/  */ /msg;
+#         $value =~ s/^ //mg;
+#         print "Parsed: $section = $value\n";
+#     }
+# }
+
diff --git a/test_db.pl b/test_db.pl
new file mode 100755 (executable)
index 0000000..477b303
--- /dev/null
@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+
+use DBI;
+
+$db_ref = DBI->connect("dbi:Pg:dbname=ceo");
+
+$st_handle = $db_ref->prepare("SELECT * FROM members");
+$result = $st_handle->execute();
+
+LOOP: for(;;) {
+       $hashref = $st_handle->fetchrow_hashref();
+       last LOOP if(!$hashref);
+       print $hashref->{'memberid'}, "\n";
+}
+
+$st_handle->finish();
+
+$db_ref->disconnect();
diff --git a/test_fr.pl b/test_fr.pl
new file mode 100644 (file)
index 0000000..d76807c
--- /dev/null
@@ -0,0 +1,24 @@
+
+require FrontEnd;
+
+&FrontEnd::Menu("BoxBox", {
+       cow => sub {
+               print "cow";
+               &FrontEnd::MsgWait("Cow Done");
+               return 1;
+       },
+       box => sub {
+               print "box";
+               &FrontEnd::MsgWait("Box Done");
+               return 1;
+       },
+       exi => sub {
+               return 0;
+       }
+});
+
+print &FrontEnd::Prompt("Custom: ", 'custom', sub { (1, 'zing') }), "\n\n";
+print &FrontEnd::Prompt("Regex: ", 'regex', q/^[a-z]\\d{3}[A-Z]$/), "\n\n";
+print &FrontEnd::Prompt("String: ", 'string'), "\n\n";
+print &FrontEnd::Prompt("Yesno: ", 'yesno'), "\n\n";
+print &FrontEnd::Prompt("Int: ", 'int'), "\n\n";
diff --git a/todo/.cvsignore b/todo/.cvsignore
new file mode 100644 (file)
index 0000000..6317ec6
--- /dev/null
@@ -0,0 +1 @@
+new_accounts*