#!/usr/bin/perl -w

use strict;

use DBI;

print "Database password: ";
my $password = <STDIN>;
if (!defined $password) {
    print STDERR "You must provide a password.  If you were a workshop attendee,\n",
                 "You can get it from Paul Hoffman.\n";
    exit 1;
}

my $dbh = DBI->connect(
    'dbi:mysql:database=ceperl;host=localhost',
    'ceperl', $password,
    { 'RaiseError' => 1 },
);
my $sth = $dbh->prepare(
  "SELECT * FROM Users WHERE firstname = ? AND lastname = ?"
);

# These are the columns in the Users table that we're interested in.
# We're interested in the first and last names too, of course, but
# we'll already have them by the time we execute the query.

my %columns = map { $_ => 1 } qw(id category status email barcode);

# Hashes for translating from status code to status text (and back)
# and ditto for category

my %status2text = qw(
    A active
    I inactive
);
my %text2status = reverse %status2text;
my %category2text = qw(
    S student
    T teacher
);
my %text2category = reverse %category2text;

# We print a prompt only if standard input is coming from a terminal
# (i.e., if there's a human being typing it in)
print "Enter some names...\n" if -t STDIN;

# Main loop: read in names, parse them, look them up in the database
while (defined(my $name = <STDIN>)) {
    chomp $name;
    if (my ($first, $last) = parse_name($name)) {
        print "  ... searching for $first $last ... ";
        $sth->execute($first, $last);
        my $users = $sth->fetchall_arrayref(\%columns);
        if (scalar(@$users) == 1) {
            print "Found!\n", user_info($users->[0]), "\n";
        }
        elsif (scalar(@$users) > 1) {
            print "Uh-oh, there appears to be a duplicate record!\n";
        }
        else {
            print "Not in database\n";
        }
    }
    else {
        print "I don't recognize that as a name.\n";
    }
    print "\n";
}

sub parse_name {
    my ($name) = @_;
    return unless $name =~ /
        ^
        # First name -- capture
        (
           [A-Z]
           (?:
              \. | [a-z]+
           )
        )
        # Middle name(s) -- discard
        # We liberally match all white-space delimited words
        (?:
           \s+ \S+
        )*?
        # Last name -- capture
        \s+
        (
           # Watch out for McNamara, O'Brien, etc.
           (?:
              [A-Z][a-z']+
           )+
           (?:
              -\S+
           )*
        )
        $
    /x;
    return ($1, $2);
}

sub user_info {
    my ($user) = @_;
    return join("\n",
          "  Category: " . category2text($user->{'category'}),
          "  Status:   " . status2text($user->{'status'}),
          "  E-mail:   $user->{'email'}",
          "  Barcode:  $user->{'barcode'}",
    );
}

sub status2text {
    my ($status) = @_;
    return 'unknown' unless defined($status)
                        and exists $status2text{$status};
    return $status2text{$status};
}

sub category2text {
    my ($cat) = @_;
    return 'unknown' unless defined($cat)
                        and exists $category2text{$cat};
    return $category2text{$cat};
}