# Web application for accessing Pam's book database. # Bruno Wolff III # Started June 23, 2001 # Last updated August 25, 2001 package Book; use base 'CGI::Application::Plus'; use Pg; use strict; # Escape a variable for use in a query sub escape ($) { my $var = $_[0]; if ($var eq '') { $var = 'NULL'; } else { $var =~ s/(['\\])/\\$1/g; $var = "'$var'"; } return $var; } sub setup { $CGI::POST_MAX = 1024 * 100; $CGI::DISABLE_UPLOADS = 1; my $self = shift; $self->tmpl_path('./'); $self->start_mode('menu'); $self->mode_param('rm'); $self->run_modes( 'nodb' => 'nodb', 'menu' => 'menu', 'listtitl' => 'listtitl', 'listauth' => 'listauth', 'listillu' => 'listillu', 'listgenr' => 'listgenr', 'listtopi' => 'listtopi', 'listlang' => 'listlang', 'listmedi' => 'listmedi', 'listacce' => 'listacce', 'listcolo' => 'listcolo', 'listcopy' => 'listcopy', 'listedit' => 'listedit', 'listbook' => 'listbook', 'detcopy' => 'detcopy', 'detauth' => 'detauth', 'detillu' => 'detillu', 'detgenr' => 'detgenr', 'dettopi' => 'dettopi', 'detmedi' => 'detmedi', 'detlang' => 'detlang', 'detacce' => 'detacce', 'detcolo' => 'detcolo', 'detedit' => 'detedit', 'detbook' => 'detbook', 'dettitl' => 'dettitl', 'addcopy' => 'addcopy', 'source' => 'source', 'dump' => 'dump', 'vacuum' => 'vacuum' ); # $self->param('selfurl' => $self->query->url(-relative => 1)); $self->param('selfurl' => './'); $self->param('menu' => [ {label => 'Menu', link => $self->param('selfurl')}, {label => 'Add book copy', link => $self->param('selfurl') . '?rm=addcopy#start'}, {label => 'List book copies', link => $self->param('selfurl') . '?rm=listcopy#start'}, {label => 'List titles', link => $self->param('selfurl') . '?rm=listtitl#start'}, {label => 'List authors', link => $self->param('selfurl') . '?rm=listauth#start'}, {label => 'List illustrators', link => $self->param('selfurl') . '?rm=listillu#start'}, {label => 'List genre', link => $self->param('selfurl') . '?rm=listgenr#start'}, {label => 'List topics', link => $self->param('selfurl') . '?rm=listtopi#start'}, {label => 'List languages', link => $self->param('selfurl') . '?rm=listlang#start'}, {label => 'List accerated reader ratings', link => $self->param('selfurl') . '?rm=listacce#start'}, {label => 'List accerated reader colors', link => $self->param('selfurl') . '?rm=listcolo#start'}, {label => 'List editions', link => $self->param('selfurl') . '?rm=listedit#start'}, {label => 'List books / stories', link => $self->param('selfurl') . '?rm=listbook#start'}, {label => 'List media / book styles', link => $self->param('selfurl') . '?rm=listmedi#start'}, {label => 'Source listings', link => $self->param('selfurl') . '?rm=source#start'}, {label => 'Dump database', link => $self->param('selfurl') . '?rm=dump'}, {label => 'Vacuum (analyze) database', link => $self->param('selfurl') . '?rm=vacuum#start'} ]); # Postgres writes notification messages to STDERR and these should just # go away. close(STDERR); open(STDERR, '>/dev/null'); $self->param('dbh' => Pg::connectdb('dbname=book')); if ($self->param('dbh')->status != PGRES_CONNECTION_OK) { $self->param('rm' => 'nodb'); } } sub nodb { my $self = shift; my $tmpl = $self->load_tmpl('nobd.tmpl'); $tmpl->param('title' => 'The book database is not available.'); return $tmpl->output; } sub menu { my $self = shift; my $tmpl = $self->load_tmpl('menu.tmpl'); $tmpl->param('menu' => $self->param('menu'), 'title' => 'Book database menu'); return $tmpl->output; } sub listtitl { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select titlcode, titldesc from titl order by titldesc, titlcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; next if !defined($row[1]) || $row[0] eq ''; push @list,{'item1' => "$row[1] ($row[0])", 'link' => $self->param('selfurl') . '?rm=dettitl&code=' . $row[0] . '#start'}; } $error = 'There are not any titles in the database.' if $#list < 0; } else { $error = 'There was an error retrieving titles from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of book / story titles', 'list' => \@list); return $tmpl->output; } sub listauth { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select authcode, authfirs, authlast from auth order by authlast, authfirs, authcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; next if !defined($row[2]) || $row[2] eq ''; $row[2] = $row[2] . ', ' . $row[1] unless !defined($row[1]) || $row[1] eq ''; push @list,{'item1' => "$row[2] ($row[0])", 'link' => $self->param('selfurl') . '?rm=detauth&code=' . $row[0] . '#start'}; } $error = 'There are not any authors in the database.' if $#list < 0; } else { $error = 'There was an error retrieving authors from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of authors', 'list' => \@list); return $tmpl->output; } sub listillu { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select illucode, illufirs, illulast from illu order by illulast, illufirs, illucode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; next if !defined($row[2]) || $row[2] eq ''; $row[2] = $row[2] . ', ' . $row[1] unless !defined($row[1]) || $row[1] eq ''; push @list,{'item1' => "$row[2] ($row[0])", 'link' => $self->param('selfurl') . '?rm=detillu&code=' . $row[0] . '#start'}; } $error = 'There are not any illustrators in the database.' if $#list < 0; } else { $error = 'There was an error retrieving illustrators from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of illustrators', 'list' => \@list); return $tmpl->output; } sub listgenr { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select genrcode, genrdesc from genr order by genrdesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; next if !defined($row[1]) || $row[1] eq ''; push @list,{'item1' => "$row[1] ($row[0])", 'link' => $self->param('selfurl') . '?rm=detgenr&code=' . $row[0] . '#start'}; } $error = 'There are not any genre in the database.' if $#list < 0; } else { $error = 'There was an error retrieving genre from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of titles', 'list' => \@list); return $tmpl->output; } sub listtopi { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select topicode, topidesc from topi order by topidesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; next if !defined($row[1]) || $row[1] eq ''; push @list,{'item1' => "$row[1] ($row[0])", 'link' => $self->param('selfurl') . '?rm=dettopi&code=' . $row[0] . '#start'}; } $error = 'There are not any topics in the database.' if $#list < 0; } else { $error = 'There was an error retrieving topics from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of topics', 'list' => \@list); return $tmpl->output; } sub listmedi { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select medicode, medidesc from medi order by medidesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; next if !defined($row[1]) || $row[1] eq ''; push @list,{'item1' => "$row[1] ($row[0])", 'link' => $self->param('selfurl') . '?rm=detmedi&code=' . $row[0] . '#start'}; } $error = 'There are not any media / book styles in the database.' if $#list < 0; } else { $error = 'There was an error retrieving media / book styles from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of media / book styles', 'list' => \@list); return $tmpl->output; } sub listlang { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select langcode, langdesc from lang order by langdesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; next if !defined($row[1]) || $row[1] eq ''; push @list,{'item1' => "$row[1] ($row[0])", 'link' => $self->param('selfurl') . '?rm=detlang&code=' . $row[0] . '#start'}; } $error = 'There are not any languages in the database.' if $#list < 0; } else { $error = 'There was an error retrieving languages from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of languages', 'list' => \@list); return $tmpl->output; } sub listacce { my $self = shift; my $tmpl = $self->load_tmpl('list2.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select accecode, accerate, colodesc from acce natural join colo order by accerate' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; next if !defined($row[1]) || $row[1] eq ''; next if !defined($row[2]) || $row[2] eq ''; push @list,{'item1' => "$row[1] ($row[0])", 'item2' => $row[2], 'link' => $self->param('selfurl') . '?rm=detacce&code=' . $row[0] . '#start'}; } $error = 'There are not any accelerated reader ratings in the database.' if $#list < 0; } else { $error = 'There was an error retrieving accelerated reader ratings from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of accelerated reader ratings', 'list' => \@list); return $tmpl->output; } sub listcolo { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select colocode, colodesc, min(accerate), max(accerate) from colo natural left join acce group by colocode, colodesc order by min(accerate), colodesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 4) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; next if !defined($row[1]) || $row[1] eq ''; $row[2] = '0' if $row[2] <= 0; $row[3] = '0' if $row[3] <= 0; push @list,{'item1' => "$row[1] ($row[0]) ($row[2] - $row[3])", 'link' => $self->param('selfurl') . '?rm=detcolo&code=' . $row[0] . '#start'}; } $error = 'There are not any accelerated reader colors in the database.' if $#list < 0; } else { $error = 'There was an error retrieving accelerated reader colors from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of accelerated reader colors', 'list' => \@list); return $tmpl->output; } sub listcopy { my $self = shift; my $tmpl = $self->load_tmpl('list2.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select itemcode, titldesc, itemlabl from (item natural join edit) natural join titl order by titldesc, itemlabl, itemcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; push @list,{'item1' => "$row[1] ($row[0])", 'item2' => $row[2], 'link' => $self->param('selfurl') . '?rm=detcopy&code=' . $row[0] . '#start'}; } $error = 'There are not any book copies in the database.' if $#list < 0; } else { $error = 'There was an error retrieving book copies from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of book copies', 'list' => \@list); return $tmpl->output; } sub listedit { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( 'select editcode, titldesc from edit natural join titl order by titldesc, editcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; push @list,{'item1' => "$row[1] ($row[0])", 'link' => $self->param('selfurl') . '?rm=detedit&code=' . $row[0] . '#start'}; } $error = 'There are not any editions in the database.' if $#list < 0; } else { $error = 'There was an error retrieving editions from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of editions', 'list' => \@list); return $tmpl->output; } sub listbook { my $self = shift; my $tmpl = $self->load_tmpl('list1.tmpl'); my @row; my @list = (); my $error = ''; my $result = $self->param('dbh')->exec( "select bookcode, coalesce(titldesc, 'No titles for this book / story') from book natural left join titl order by bookcode, titldesc" ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; push @list,{'item1' => "$row[1] ($row[0])", 'link' => $self->param('selfurl') . '?rm=detbook&code=' . $row[0] . '#start'}; } $error = 'There are not any books / stories in the database.' if $#list < 0; } else { $error = 'There was an error retrieving books / stories from the database.'; } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'List of books / stories', 'list' => \@list); return $tmpl->output; } sub addcopy { my $self = shift; my $tmpl = $self->load_tmpl('addcopy.tmpl'); my $i; my @row; my $flag; my %set; my $set; my $result; my $status = ''; my @editlist = ({'desc' => 'NEW', 'code' => 'NEW'}); my @medilist = ({'desc' => 'NEW', 'code' => 'NEW'}); my @authlist = (); my @illulist = (); my @cololist = ({'desc' => 'NEW', 'code' => 'NEW'}); my @accelist = ({'desc' => 'NONE', 'code' => 'NONE'}, {'desc' => 'NEW', 'code' => 'NEW'}); my @genrlist = (); my @topilist = (); my @titllist = ({'desc' => 'NEW', 'code' => 'NEW'}); my @booklist = ({'desc' => 'NEW', 'code' => 'NEW'}); my @langlist = ({'desc' => 'NEW', 'code' => 'NEW'}); my $error = ''; # If the clear button was pressed dump all query data. $self->query->delete_all if defined($self->query->param('clear')); # If the process button was pressed, try to update the database. # This should set a status string. if (defined($self->query->param('process'))) { my $langcode; my $langdesc; my $langnote; my $authcode; my $authfirs; my $authlast; my $authnote; my $illucode; my $illufirs; my $illulast; my $illunote; my $medicode; my $medidesc; my $medinote; my $genrcode; my $genrdesc; my $genrnote; my $topicode; my $topidesc; my $topinote; my $bookcode; my $booknote; my $titlcode; my $titldesc; my $colocode; my $colodesc; my $colonote; my $accecode; my $accerate; my $accenote; my $editcode; my $editnote; my $itemcode; my $itemlabl; my $itemchec; my $itempage; my $itemnote; $flag = 0; %set = (); load: while (1) { if (-e 'readonly') { $status = 'Updates of the database copy are not allowed.'; last load; } $result = $self->param('dbh')->exec('begin'); if ($result->resultStatus != PGRES_COMMAND_OK) { $status = $self->param('dbh')->errorMessage; last load; } $editcode = join(' ', $self->query->param('editcode')); $editcode =~ s/\s+/ /g; $editcode =~ s/^ +//; $editcode =~ s/ +$//; if ($editcode =~ m/[^ -\176]/) { $status = 'Invalid character in editcode.'; last load; } if ($editcode eq 'NEW') { $set{'editnote'} = ''; $set{'authfirs1'} = ''; $set{'authlast1'} = ''; $set{'authnote1'} = ''; $set{'authfirs2'} = ''; $set{'authlast2'} = ''; $set{'authnote2'} = ''; $set{'illufirs1'} = ''; $set{'illulast1'} = ''; $set{'illunote1'} = ''; $set{'illufirs2'} = ''; $set{'illulast2'} = ''; $set{'illunote2'} = ''; $editnote = join(' ', $self->query->param('editnote')); $editnote =~ s/\s+/ /g; $editnote =~ s/^ +//; $editnote =~ s/ +$//; if ($editnote =~ m/[^ -\176]/) { $status = 'Invalid character in editnote.'; last load; } $titlcode = join(' ', $self->query->param('titlcode')); $titlcode =~ s/\s+/ /g; $titlcode =~ s/^ +//; $titlcode =~ s/ +$//; if ($titlcode =~ m/[^ -\176]/) { $status = 'Invalid character in titlcode.'; last load; } if ($titlcode eq 'NEW') { $set{'titldesc'} = ''; $titldesc = join(' ', $self->query->param('titldesc')); $titldesc =~ s/\s+/ /g; $titldesc =~ s/^ +//; $titldesc =~ s/ +$//; if ($titldesc =~ m/[^ -\176]/) { $status = 'Invalid character in titldesc.'; last load; } $bookcode = join(' ', $self->query->param('bookcode')); $bookcode =~ s/\s+/ /g; $bookcode =~ s/^ +//; $bookcode =~ s/ +$//; if ($bookcode =~ m/[^ -\176]/) { $status = 'Invalid character in bookcode.'; last load; } if ($bookcode eq 'NEW') { $set{'booknote'} = ''; $set{'topidesc1'} = ''; $set{'topinote1'} = ''; $set{'topidesc2'} = ''; $set{'topinote2'} = ''; $set{'topidesc3'} = ''; $set{'topinote3'} = ''; $set{'genrdesc1'} = ''; $set{'genrnote1'} = ''; $set{'genrdesc2'} = ''; $set{'genrnote2'} = ''; $booknote = join(' ', $self->query->param('booknote')); $booknote =~ s/\s+/ /g; $booknote =~ s/^ +//; $booknote =~ s/ +$//; if ($booknote =~ m/[^ -\176]/) { $status = 'Invalid character in booknote.'; last load; } $result = $self->param('dbh')->exec( "insert into book (booknote) values (" . escape($booknote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('book_bookcode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = 'Unable to find bookcode after insert.'; last load; } @row = $result->fetchrow; $bookcode = $row[0]; for ($i = 1; $i <= 3; $i++) { $topidesc = join(' ', $self->query->param("topidesc$i")); $topidesc =~ s/\s+/ /g; $topidesc =~ s/^ +//; $topidesc =~ s/ +$//; if ($topidesc =~ m/[^ -\176]/) { $status = "Invalid character in topidesc$i."; last load; } $topinote = join(' ', $self->query->param("topinote$i")); $topinote =~ s/\s+/ /g; $topinote =~ s/^ +//; $topinote =~ s/ +$//; if ($topinote =~ m/[^ -\176]/) { $status = "Invalid character in topinote$i."; last load; } if ($topidesc ne '' || $topinote ne '') { $result = $self->param('dbh')->exec( "insert into topi (topidesc, topinote) values (" . escape($topidesc) .", " . escape($topinote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('topi_topicode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = "Unable to find topicode after insert of topic$i."; last load; } @row = $result->fetchrow; $topicode = $row[0]; $result = $self->param('dbh')->exec( "insert into booktopi (bookcode, topicode) values (" . escape($bookcode) .", " . escape($topicode) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } } } foreach $topicode ($self->query->param('topicode')) { $result = $self->param('dbh')->exec( "insert into booktopi (bookcode, topicode) values (" . escape($bookcode) .", " . escape($topicode) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } } for ($i = 1; $i <= 2; $i++) { $genrdesc = join(' ', $self->query->param("genrdesc$i")); $genrdesc =~ s/\s+/ /g; $genrdesc =~ s/^ +//; $genrdesc =~ s/ +$//; if ($genrdesc =~ m/[^ -\176]/) { $status = "Invalid character in genrdesc$i."; last load; } $genrnote = join(' ', $self->query->param("genrnote$i")); $genrnote =~ s/\s+/ /g; $genrnote =~ s/^ +//; $genrnote =~ s/ +$//; if ($genrnote =~ m/[^ -\176]/) { $status = "Invalid character in genrnote$i."; last load; } if ($genrdesc ne '' || $genrnote ne '') { $result = $self->param('dbh')->exec( "insert into genr (genrdesc, genrnote) values (" . escape($genrdesc) .", " . escape($genrnote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('genr_genrcode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = "Unable to find genrcode after insert of genre$i."; last load; } @row = $result->fetchrow; $genrcode = $row[0]; $result = $self->param('dbh')->exec( "insert into bookgenr (bookcode, genrcode) values (" . escape($bookcode) .", " . escape($genrcode) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } } } foreach $genrcode ($self->query->param('genrcode')) { $result = $self->param('dbh')->exec( "insert into bookgenr (bookcode, genrcode) values (" . escape($bookcode) .", " . escape($genrcode) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } } } $result = $self->param('dbh')->exec( "insert into titl (bookcode, titldesc) values (" . escape($bookcode) .", " . escape($titldesc) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('titl_titlcode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = 'Unable to find titlcode after insert.'; last load; } @row = $result->fetchrow; $titlcode = $row[0]; } $langcode = join(' ', $self->query->param('langcode')); $langcode =~ s/\s+/ /g; $langcode =~ s/^ +//; $langcode =~ s/ +$//; if ($langcode =~ m/[^ -\176]/) { $status = 'Invalid character in langcode.'; last load; } if ($langcode eq 'NEW') { $set{'langdesc'} = ''; $set{'langnote'} = ''; $langdesc = join(' ', $self->query->param('langdesc')); $langdesc =~ s/\s+/ /g; $langdesc =~ s/^ +//; $langdesc =~ s/ +$//; if ($langdesc =~ m/[^ -\176]/) { $status = 'Invalid character in langdesc.'; last load; } $langnote = join(' ', $self->query->param('langnote')); $langnote =~ s/\s+/ /g; $langnote =~ s/^ +//; $langnote =~ s/ +$//; if ($langnote =~ m/[^ -\176]/) { $status = 'Invalid character in langnote.'; last load; } $result = $self->param('dbh')->exec( "insert into lang (langdesc, langnote) values (" . escape($langdesc) .", " . escape($langnote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('lang_langcode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = 'Unable to find langcode after insert.'; last load; } @row = $result->fetchrow; $langcode = $row[0]; } $accecode = join(' ', $self->query->param('accecode')); $accecode =~ s/\s+/ /g; $accecode =~ s/^ +//; $accecode =~ s/ +$//; if ($accecode =~ m/[^ -\176]/) { $status = 'Invalid character in accecode.'; last load; } if ($accecode eq 'NEW') { $set{'accerate'} = ''; $set{'accenote'} = ''; $accerate = join(' ', $self->query->param('accerate')); $accerate =~ s/\s+/ /g; $accerate =~ s/^ +//; $accerate =~ s/ +$//; if ($accerate =~ m/[^ -\176]/) { $status = 'Invalid character in accerate.'; last load; } $accenote = join(' ', $self->query->param('accenote')); $accenote =~ s/\s+/ /g; $accenote =~ s/^ +//; $accenote =~ s/ +$//; if ($accenote =~ m/[^ -\176]/) { $status = 'Invalid character in accenote.'; last load; } $colocode = join(' ', $self->query->param('colocode')); $colocode =~ s/\s+/ /g; $colocode =~ s/^ +//; $colocode =~ s/ +$//; if ($colocode =~ m/[^ -\176]/) { $status = 'Invalid character in colocode.'; last load; } if ($colocode eq 'NEW') { $set{'colodesc'} = ''; $set{'colonote'} = ''; $colodesc = join(' ', $self->query->param('colodesc')); $colodesc =~ s/\s+/ /g; $colodesc =~ s/^ +//; $colodesc =~ s/ +$//; if ($colodesc =~ m/[^ -\176]/) { $status = 'Invalid character in colodesc.'; last load; } $colonote = join(' ', $self->query->param('colonote')); $colonote =~ s/\s+/ /g; $colonote =~ s/^ +//; $colonote =~ s/ +$//; if ($colonote =~ m/[^ -\176]/) { $status = 'Invalid character in colonote.'; last load; } $result = $self->param('dbh')->exec( "insert into colo (colodesc, colonote) values (" . escape($colodesc) .", " . escape($colonote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('colo_colocode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = 'Unable to find colocode after insert.'; last load; } @row = $result->fetchrow; $colocode = $row[0]; } $result = $self->param('dbh')->exec( "insert into acce (accerate, colocode, accenote) values (" . escape($accerate) .", " . escape($colocode) . ", " . escape($accenote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('acce_accecode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = 'Unable to find accecode after insert.'; last load; } @row = $result->fetchrow; $accecode = $row[0]; } elsif ($accecode eq 'NONE') { $accecode = ''; } $result = $self->param('dbh')->exec( "insert into edit (editnote, titlcode, langcode, accecode) values (" . escape($editnote) .", " . escape($titlcode) . ", " . escape($langcode) . ", " . escape($accecode) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('edit_editcode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = 'Unable to find editcode after insert.'; last load; } @row = $result->fetchrow; $editcode = $row[0]; for ($i = 1; $i <= 2; $i++) { $authfirs = join(' ', $self->query->param("authfirs$i")); $authfirs =~ s/\s+/ /g; $authfirs =~ s/^ +//; $authfirs =~ s/ +$//; if ($authfirs =~ m/[^ -\176]/) { $status = "Invalid character in authfirs$1."; last load; } $authlast = join(' ', $self->query->param("authlast$i")); $authlast =~ s/\s+/ /g; $authlast =~ s/^ +//; $authlast =~ s/ +$//; if ($authlast =~ m/[^ -\176]/) { $status = "Invalid character in authlast$i."; last load; } $authnote = join(' ', $self->query->param("authnote$i")); $authnote =~ s/\s+/ /g; $authnote =~ s/^ +//; $authnote =~ s/ +$//; if ($authnote =~ m/[^ -\176]/) { $status = "Invalid character in authnote$i."; last load; } if ($authnote ne '' || $authlast ne '' || $authfirs ne '') { $result = $self->param('dbh')->exec( "insert into auth (authfirs, authlast, authnote) values (" . escape($authfirs) .", " . escape($authlast) . ", " . escape($authnote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('auth_authcode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = "Unable to find authcode after insert of author$i."; last load; } @row = $result->fetchrow; $authcode = $row[0]; $result = $self->param('dbh')->exec( "insert into editauth (editcode, authcode) values (" . escape($editcode) .", " . escape($authcode) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } } } foreach $authcode ($self->query->param('authcode')) { $result = $self->param('dbh')->exec( "insert into editauth (editcode, authcode) values (" . escape($editcode) .", " . escape($authcode) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } } for ($i = 1; $i <= 2; $i++) { $illufirs = join(' ', $self->query->param("illufirs$i")); $illufirs =~ s/\s+/ /g; $illufirs =~ s/^ +//; $illufirs =~ s/ +$//; if ($illufirs =~ m/[^ -\176]/) { $status = "Invalid character in illufirs$1."; last load; } $illulast = join(' ', $self->query->param("illulast$i")); $illulast =~ s/\s+/ /g; $illulast =~ s/^ +//; $illulast =~ s/ +$//; if ($illulast =~ m/[^ -\176]/) { $status = "Invalid character in illulast$i."; last load; } $illunote = join(' ', $self->query->param("illunote$i")); $illunote =~ s/\s+/ /g; $illunote =~ s/^ +//; $illunote =~ s/ +$//; if ($illunote =~ m/[^ -\176]/) { $status = "Invalid character in illunote$i."; last load; } if ($illunote ne '' || $illulast ne '' || $illufirs ne '') { $result = $self->param('dbh')->exec( "insert into illu (illufirs, illulast, illunote) values (" . escape($illufirs) .", " . escape($illulast) . ", " . escape($illunote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('illu_illucode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = "Unable to find illucode after insert of illustrator$i."; last load; } @row = $result->fetchrow; $illucode = $row[0]; $result = $self->param('dbh')->exec( "insert into editillu (editcode, illucode) values (" . escape($editcode) .", " . escape($illucode) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } } } foreach $illucode ($self->query->param('illucode')) { $result = $self->param('dbh')->exec( "insert into editillu (editcode, illucode) values (" . escape($editcode) .", " . escape($illucode) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } } } $medicode = join(' ', $self->query->param('medicode')); $medicode =~ s/\s+/ /g; $medicode =~ s/^ +//; $medicode =~ s/ +$//; if ($medicode =~ m/[^ -\176]/) { $status = 'Invalid character in medicode.'; last load; } if ($medicode eq 'NEW') { $set{'medidesc'} = ''; $set{'medinote'} = ''; $medidesc = join(' ', $self->query->param('medidesc')); $medidesc =~ s/\s+/ /g; $medidesc =~ s/^ +//; $medidesc =~ s/ +$//; if ($medidesc =~ m/[^ -\176]/) { $status = 'Invalid character in medidesc.'; last load; } $medinote = join(' ', $self->query->param('medinote')); $medinote =~ s/\s+/ /g; $medinote =~ s/^ +//; $medinote =~ s/ +$//; if ($medinote =~ m/[^ -\176]/) { $status = 'Invalid character in medinote.'; last load; } $result = $self->param('dbh')->exec( "insert into medi (medidesc, medinote) values (" . escape($medidesc) .", " . escape($medinote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } $result = $self->param('dbh')->exec( "select currval('medi_medicode_seq')" ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1 || $result->ntuples != 1) { $status = 'Unable to find medicode after insert.'; last load; } @row = $result->fetchrow; $medicode = $row[0]; } $itemlabl = join(' ', $self->query->param('itemlabl')); $itemlabl =~ s/\s+/ /g; $itemlabl =~ s/^ +//; $itemlabl =~ s/ +$//; if ($itemlabl =~ m/[^ -\176]/) { $status = 'Invalid character in itemlabl.'; last load; } $itemchec = join(' ', $self->query->param('itemchec')); $itemchec =~ s/\s+/ /g; $itemchec =~ s/^ +//; $itemchec =~ s/ +$//; if ($itemchec =~ m/[^ -\176]/) { $status = 'Invalid character in itemchec.'; last load; } $itempage = join(' ', $self->query->param('itempage')); $itempage =~ s/\s+/ /g; $itempage =~ s/^ +//; $itempage =~ s/ +$//; if ($itempage =~ m/[^ -\176]/) { $status = 'Invalid character in itempage.'; last load; } $itemnote = join(' ', $self->query->param('itemnote')); $itemnote =~ s/\s+/ /g; $itemnote =~ s/^ +//; $itemnote =~ s/ +$//; if ($itemnote =~ m/[^ -\176]/) { $status = 'Invalid character in itemnote.'; last load; } $result = $self->param('dbh')->exec( "insert into item (editcode, medicode, itemlabl, itemchec, itempage, itemnote) values (" . escape($editcode) .", " . escape($medicode) . ", " . escape($itemlabl) . ", " . escape($itemchec) . ", " . escape($itempage) . ", " . escape($itemnote) . ")" ); if ($result->resultStatus != PGRES_COMMAND_OK || $result->cmdTuples != 1) { $status = $self->param('dbh')->errorMessage; last load; } # Check for additions (other than from menus) that aren't being used. foreach $set ('editnote', 'titldesc', 'booknote', 'authnote1', 'authfirs1', 'authlast1', 'authnote2', 'authfirs2', 'authlast2', 'illunote1', 'illufirs1', 'illulast1', 'illunote2', 'illufirs2', 'illulast2', 'topidesc1', 'topinote1', 'topidesc2', 'topinote2', 'topidesc3', 'topinote3', 'genrdesc1', 'genrnote1', 'genrdesc2', 'genrnote2', 'langdesc', 'langnote', 'medidesc', 'medinote', 'accerate', 'accenote', 'colodesc', 'colonote') { if (!defined($set{$set}) && join(' ', $self->query->param($set)) !~ m/^\s*$/) { $status = $set . ' was defined, but not used.'; last load; } } $result = $self->param('dbh')->exec('commit'); if ($result->resultStatus != PGRES_COMMAND_OK) { $status = $self->param('dbh')->errorMessage; last load; } $status = 'Book copy successfully added.'; $self->query->delete_all; $flag = 1; last load; } if ($flag == 0) { $result = $self->param('dbh')->exec('rollback'); if ($result->resultStatus != PGRES_COMMAND_OK) { $status = $self->param('dbh')->errorMessage; } if ($status =~ m/^\s*$/) { $status = 'Unable to add book copy.'; } } } # Then try to fetch all of the database information used for drop # down prompts. %set=(); foreach $set ($self->query->param('editcode')) { $set{$set} = ''; } $flag = 0; $result = $self->param('dbh')->exec( 'select editcode, titldesc from edit natural join titl order by titldesc, editcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @editlist, {'desc' => $row[1], 'code' => $row[0], 'select' => 'selected'}; %set = (); $flag = 1; } else { push @editlist, {'desc' => $row[1], 'code' => $row[0]}; } } ${$editlist[0]}{'select'} = 'selected' unless $flag; } else { $error = 'There was an error retrieving edition information from the database.'; } %set=(); foreach $set ($self->query->param('titlcode')) { $set{$set} = ''; } $flag = 0; $result = $self->param('dbh')->exec( 'select titlcode, bookcode, titldesc from titl order by titldesc, bookcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @titllist, {'desc' => "$row[2] (book $row[1])", 'code' => $row[0], 'select' => 'selected'}; %set = (); $flag = 1; } else { push @titllist, {'desc' => "$row[2] (book $row[1])", 'code' => $row[0]}; } } ${$titllist[0]}{'select'} = 'selected' unless $flag; } else { $error = 'There was an error retrieving title information from the database.'; } %set=(); foreach $set ($self->query->param('langcode')) { $set{$set} = ''; } $flag = 0; $result = $self->param('dbh')->exec( 'select langcode, langdesc from lang order by langdesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]}) || ($row[1] eq 'English' && scalar(keys(%set)) == 0)) { push @langlist, {'desc' => $row[1], 'code' => $row[0], 'select' => 'selected'}; %set = (); $flag = 1; } else { push @langlist, {'desc' => $row[1], 'code' => $row[0]}; } } ${@langlist[0]}{'select'} = 'selected' unless $flag; } else { $error = 'There was an error retrieving language information from the database.'; } %set=(); foreach $set ($self->query->param('authcode')) { $set{$set} = ''; } $result = $self->param('dbh')->exec( 'select authcode, authfirs, authlast from auth order by authlast, authfirs, authcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @authlist, {'desc' => "$row[2], $row[1]", 'code' => $row[0], 'select' => 'selected'}; } else { push @authlist, {'desc' => "$row[2], $row[1]", 'code' => $row[0]}; } } } else { $error = 'There was an error retrieving author information from the database.'; } %set=(); foreach $set ($self->query->param('illucode')) { $set{$set} = ''; } $result = $self->param('dbh')->exec( 'select illucode, illufirs, illulast from illu order by illulast, illufirs, illucode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @illulist, {'desc' => "$row[2], $row[1]", 'code' => $row[0], 'select' => 'selected'}; } else { push @illulist, {'desc' => "$row[2], $row[1]", 'code' => $row[0]}; } } } else { $error = 'There was an error retrieving illustrator information from the database.'; } %set=(); foreach $set ($self->query->param('colocode')) { $set{$set} = ''; } $flag = 0; $result = $self->param('dbh')->exec( 'select colocode, colodesc from colo order by colodesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @cololist, {'desc' => "$row[1]", 'code' => $row[0], 'select' => 'selected'}; %set = (); $flag = 1; } else { push @cololist, {'desc' => "$row[1]", 'code' => $row[0]}; } } ${@cololist[0]}{'select'} = 'selected' unless $flag; } else { $error = 'There was an error retrieving accelerated reader color information from the database.'; } %set=(); foreach $set ($self->query->param('medicode')) { $set{$set} = ''; } $flag = 0; $result = $self->param('dbh')->exec( 'select medicode, medidesc from medi order by medidesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @medilist, {'desc' => "$row[1]", 'code' => $row[0], 'select' => 'selected'}; %set = (); $flag = 1; } else { push @medilist, {'desc' => "$row[1]", 'code' => $row[0]}; } } ${@medilist[0]}{'select'} = 'selected' unless $flag; } else { $error = 'There was an error retrieving accelerated reader color information from the database.'; } %set=(); foreach $set ($self->query->param('topicode')) { $set{$set} = ''; } $result = $self->param('dbh')->exec( 'select topicode, topidesc from topi order by topidesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @topilist, {'desc' => "$row[1]", 'code' => $row[0], 'select' => 'selected'}; } else { push @topilist, {'desc' => "$row[1]", 'code' => $row[0]}; } } } else { $error = 'There was an error retrieving accelerated reader color information from the database.'; } %set=(); foreach $set ($self->query->param('genrcode')) { $set{$set} = ''; } $result = $self->param('dbh')->exec( 'select genrcode, genrdesc from genr order by genrdesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @genrlist, {'desc' => "$row[1]", 'code' => $row[0], 'select' => 'selected'}; } else { push @genrlist, {'desc' => "$row[1]", 'code' => $row[0]}; } } } else { $error = 'There was an error retrieving accelerated reader color information from the database.'; } %set=(); foreach $set ($self->query->param('accecode')) { $set{$set} = ''; } $flag = 0; if (defined($set{'NEW'})) { ${@accelist[1]}{'select'} = 'selected' unless $flag; %set = (); $flag = 1; } $result = $self->param('dbh')->exec( 'select accecode, accerate, colodesc from acce natural join colo order by accerate' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @accelist, {'desc' => "$row[1] ($row[2])", 'code' => $row[0], 'select' => 'selected'}; %set = (); $flag = 1; } else { push @accelist, {'desc' => "$row[1] ($row[2])", 'code' => $row[0]}; } } ${@accelist[0]}{'select'} = 'selected' unless $flag; } else { $error = 'There was an error retrieving accelerated reader rating information from the database.'; } %set=(); foreach $set ($self->query->param('bookcode')) { $set{$set} = ''; } $flag = 0; $result = $self->param('dbh')->exec( "select bookcode, coalesce(titldesc, 'No titles for this book') from book natural left join titl order by bookcode, titldesc" ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { next if !defined($row[0]) || $row[0] eq ''; if (defined($set{$row[0]})) { push @booklist, {'desc' => "$row[1] ($row[0])", 'code' => $row[0], 'select' => 'selected'}; %set = (); $flag = 1; } else { push @booklist, {'desc' => "$row[1] ($row[0])", 'code' => $row[0]}; } } ${@booklist[0]}{'select'} = 'selected' unless $flag; } else { $error = 'There was an error retrieving book / story information from the database.'; } $error = 'Updates of the database copy are not allowed.' if -e 'readonly'; # Only the last error above is displayed. If there is one, then the form # shouldn't really be displayed. $tmpl->param('menu' => $self->param('menu'), 'link' => $self->param('selfurl') . '#start', 'error' => $error, 'status' => $status, 'title' => 'Add a book copy to the database.', 'itemlabl' => join(' ', $self->query->param('itemlabl')), 'itemchec' => join(' ', $self->query->param('itemchec')), 'itempage' => join(' ', $self->query->param('itempage')), 'itemnote' => join(' ', $self->query->param('itemnote')), 'editnote' => join(' ', $self->query->param('editnote')), 'titldesc' => join(' ', $self->query->param('titldesc')), 'booknote' => join(' ', $self->query->param('booknote')), 'authnote1' => join(' ', $self->query->param('authnote1')), 'authfirs1' => join(' ', $self->query->param('authfirs1')), 'authlast1' => join(' ', $self->query->param('authlast1')), 'authnote2' => join(' ', $self->query->param('authnote2')), 'authfirs2' => join(' ', $self->query->param('authfirs2')), 'authlast2' => join(' ', $self->query->param('authlast2')), 'illunote1' => join(' ', $self->query->param('illunote1')), 'illufirs1' => join(' ', $self->query->param('illufirs1')), 'illulast1' => join(' ', $self->query->param('illulast1')), 'illunote2' => join(' ', $self->query->param('illunote2')), 'illufirs2' => join(' ', $self->query->param('illufirs2')), 'illulast2' => join(' ', $self->query->param('illulast2')), 'topidesc1' => join(' ', $self->query->param('topidesc1')), 'topinote1' => join(' ', $self->query->param('topinote1')), 'topidesc2' => join(' ', $self->query->param('topidesc2')), 'topinote2' => join(' ', $self->query->param('topinote2')), 'topidesc3' => join(' ', $self->query->param('topidesc3')), 'topinote3' => join(' ', $self->query->param('topinote3')), 'genrdesc1' => join(' ', $self->query->param('genrdesc1')), 'genrnote1' => join(' ', $self->query->param('genrnote1')), 'genrdesc2' => join(' ', $self->query->param('genrdesc2')), 'genrnote2' => join(' ', $self->query->param('genrnote2')), 'langdesc' => join(' ', $self->query->param('langdesc')), 'langnote' => join(' ', $self->query->param('langnote')), 'medidesc' => join(' ', $self->query->param('medidesc')), 'medinote' => join(' ', $self->query->param('medinote')), 'accerate' => join(' ', $self->query->param('accerate')), 'accenote' => join(' ', $self->query->param('accenote')), 'colodesc' => join(' ', $self->query->param('colodesc')), 'colonote' => join(' ', $self->query->param('colonote')), 'medilist' => \@medilist, 'authlist' => \@authlist, 'authsize' => (scalar(@authlist)<10?scalar(@authlist):10), 'illulist' => \@illulist, 'illusize' => (scalar(@illulist)<10?scalar(@illulist):10), 'cololist' => \@cololist, 'accelist' => \@accelist, 'genrlist' => \@genrlist, 'genrsize' => (scalar(@genrlist)<10?scalar(@genrlist):10), 'topilist' => \@topilist, 'topisize' => (scalar(@topilist)<10?scalar(@topilist):10), 'booklist' => \@booklist, 'titllist' => \@titllist, 'langlist' => \@langlist, 'editlist' => \@editlist); return $tmpl->output; } sub detacce { my $self = shift; my $tmpl = $self->load_tmpl('detacce.tmpl'); my @row; my @editlist = (); my $error = ''; my $accecode = join(' ', $self->query->param('code')); my $accerate; my $accenote; my $colocode; my $colodesc; my $result = $self->param('dbh')->exec( "select accerate, accenote, colocode, colodesc from acce natural join colo where accecode = " . escape($accecode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 4) { $error = 'There was an error retrieving the accelerated reader rating from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the accelerated reader rating code '$accecode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $accerate = "$row[0]"; $accenote = "$row[1]"; $colocode = "$row[2]"; $colodesc = "$row[3]"; my $result = $self->param('dbh')->exec( 'select editcode, titldesc from edit natural join titl where accecode = ' . escape($accecode) . ' order by titldesc, editcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @editlist, {'editcode' => "$row[0]", 'titldesc' => "$row[1]", 'link' => $self->param('selfurl') . '?rm=detedit&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'accecode' => $accecode, 'accerate' => $accerate, 'accenote' => $accenote, 'colodesc' => $colodesc, 'cololink' => $self->param('selfurl') . '?rm=detcolo&code=' . $colocode . '#start', 'anyedit' => scalar(@editlist), 'editlist' => \@editlist, 'title' => "Detail for accelerated reader rating: $accerate" ); return $tmpl->output; } sub detcolo { my $self = shift; my $tmpl = $self->load_tmpl('detcolo.tmpl'); my @row; my $first; my $old; my @editlist = (); my $error = ''; my $colocode = join(' ', $self->query->param('code')); my $colodesc; my $colonote; my $result = $self->param('dbh')->exec( 'select colodesc, colonote from colo where colocode = ' . escape($colocode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 2) { $error = 'There was an error retrieving the accelerated reader color from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the accelerated reader color code '$colocode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $colodesc = "$row[0]"; $colonote = "$row[1]"; my $result = $self->param('dbh')->exec( 'select accecode, accerate, editcode, titldesc from (edit natural right join acce) natural join titl where colocode = ' . escape($colocode) . ' order by accerate, titldesc, editcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 4) { $first = '1'; $old = ''; while (@row = $result->fetchrow) { push @editlist, { 'first' => $first, 'accecode' => "$row[0]", 'accerate' => "$row[1]", 'editcode' => "$row[2]", 'titldesc' => "$row[3]", 'accelink' => $old eq $row[0] ? '' : $self->param('selfurl') . '?rm=detacce&code=' . $row[0] . '#start', 'editlink' => defined($row[2]) ? $self->param('selfurl') . '?rm=detedit&code=' . $row[2] . '#start' : ''}; $first = ''; $old = $row[0]; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'colocode' => $colocode, 'colodesc' => $colodesc, 'colonote' => $colonote, 'anyedit' => scalar(@editlist), 'editlist' => \@editlist, 'title' => "Detail for accelerated reader color: $colodesc" ); return $tmpl->output; } sub detauth { my $self = shift; my $tmpl = $self->load_tmpl('detauth.tmpl'); my @row; my $first; my $old; my @editlist = (); my $error = ''; my $authcode = join(' ', $self->query->param('code')); my $authfirs; my $authlast; my $authnote; my $result = $self->param('dbh')->exec( 'select authfirs, authlast, authnote from auth where authcode = ' . escape($authcode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 3) { $error = 'There was an error retrieving the author from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the author code '$authcode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $authfirs = "$row[0]"; $authlast = "$row[1]"; $authnote = "$row[2]"; my $result = $self->param('dbh')->exec( 'select editcode, titldesc from (edit natural join editauth) natural join titl where authcode = ' . escape($authcode) . ' order by titldesc, editcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @editlist, { 'editcode' => "$row[0]", 'titldesc' => "$row[1]", 'editlink' => $self->param('selfurl') . '?rm=detedit&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'authcode' => $authcode, 'authfirs' => $authfirs, 'authlast' => $authlast, 'authnote' => $authnote, 'anyedit' => scalar(@editlist), 'editlist' => \@editlist, 'title' => "Detail for author: $authlast, $authfirs" ); return $tmpl->output; } sub detillu { my $self = shift; my $tmpl = $self->load_tmpl('detillu.tmpl'); my @row; my $first; my $old; my @editlist = (); my $error = ''; my $illucode = join(' ', $self->query->param('code')); my $illufirs; my $illulast; my $illunote; my $result = $self->param('dbh')->exec( 'select illufirs, illulast, illunote from illu where illucode = ' . escape($illucode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 3) { $error = 'There was an error retrieving the illustrator from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the illustrator code '$illucode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $illufirs = "$row[0]"; $illulast = "$row[1]"; $illunote = "$row[2]"; my $result = $self->param('dbh')->exec( 'select editcode, titldesc from (edit natural join editillu) natural join titl where illucode = ' . escape($illucode) . ' order by titldesc, editcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @editlist, { 'editcode' => "$row[0]", 'titldesc' => "$row[1]", 'editlink' => $self->param('selfurl') . '?rm=detedit&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'illucode' => $illucode, 'illufirs' => $illufirs, 'illulast' => $illulast, 'illunote' => $illunote, 'anyedit' => scalar(@editlist), 'editlist' => \@editlist, 'title' => "Detail for illustrator: $illulast, $illufirs" ); return $tmpl->output; } sub dettopi { my $self = shift; my $tmpl = $self->load_tmpl('dettopi.tmpl'); my @row; my $first; my $old; my @booklist = (); my $error = ''; my $topicode = join(' ', $self->query->param('code')); my $topidesc; my $topinote; my $result = $self->param('dbh')->exec( 'select topidesc, topinote from topi where topicode = ' . escape($topicode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 2) { $error = 'There was an error retrieving the topic from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the topic code '$topicode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $topidesc = "$row[0]"; $topinote = "$row[1]"; my $result = $self->param('dbh')->exec( 'select bookcode, titldesc from (book natural join booktopi) natural join titl where topicode = ' . escape($topicode) . ' order by titldesc, bookcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @booklist, { 'bookcode' => "$row[0]", 'titldesc' => "$row[1]", 'booklink' => $self->param('selfurl') . '?rm=detbook&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'topicode' => $topicode, 'topidesc' => $topidesc, 'topinote' => $topinote, 'anybook' => scalar(@booklist), 'booklist' => \@booklist, 'title' => "Detail for topic: $topidesc" ); return $tmpl->output; } sub detgenr { my $self = shift; my $tmpl = $self->load_tmpl('detgenr.tmpl'); my @row; my $first; my $old; my @booklist = (); my $error = ''; my $genrcode = join(' ', $self->query->param('code')); my $genrdesc; my $genrnote; my $result = $self->param('dbh')->exec( 'select genrdesc, genrnote from genr where genrcode = ' . escape($genrcode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 2) { $error = 'There was an error retrieving the genre from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the genre code '$genrcode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $genrdesc = "$row[0]"; $genrnote = "$row[1]"; my $result = $self->param('dbh')->exec( 'select bookcode, titldesc from (book natural join bookgenr) natural join titl where genrcode = ' . escape($genrcode) . ' order by titldesc, bookcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @booklist, { 'bookcode' => "$row[0]", 'titldesc' => "$row[1]", 'booklink' => $self->param('selfurl') . '?rm=detbook&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'genrcode' => $genrcode, 'genrdesc' => $genrdesc, 'genrnote' => $genrnote, 'anybook' => scalar(@booklist), 'booklist' => \@booklist, 'title' => "Detail for genre: $genrdesc" ); return $tmpl->output; } sub detlang { my $self = shift; my $tmpl = $self->load_tmpl('detlang.tmpl'); my @row; my @editlist = (); my $error = ''; my $langcode = join(' ', $self->query->param('code')); my $langdesc; my $langnote; my $result = $self->param('dbh')->exec( 'select langdesc, langnote from lang where langcode = ' . escape($langcode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 2) { $error = 'There was an error retrieving the language from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the language code '$langcode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $langdesc = "$row[0]"; $langnote = "$row[1]"; my $result = $self->param('dbh')->exec( 'select editcode, titldesc from edit natural join titl where langcode = ' . escape($langcode) . ' order by titldesc, editcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @editlist, { 'editcode' => "$row[0]", 'titldesc' => "$row[1]", 'editlink' => $self->param('selfurl') . '?rm=detedit&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'langcode' => $langcode, 'langdesc' => $langdesc, 'langnote' => $langnote, 'anyedit' => scalar(@editlist), 'editlist' => \@editlist, 'title' => "Detail for language: $langdesc" ); return $tmpl->output; } sub dettitl { my $self = shift; my $tmpl = $self->load_tmpl('dettitl.tmpl'); my @row; my @editlist = (); my $error = ''; my $titlcode = join(' ', $self->query->param('code')); my $titldesc; my $bookcode; my $booklink; my $result = $self->param('dbh')->exec( 'select titldesc, bookcode from titl where titlcode = ' . escape($titlcode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 2) { $error = 'There was an error retrieving the title from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the title code '$titlcode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $titldesc = "$row[0]"; $bookcode = "$row[1]"; $booklink = $self->param('selfurl') . '?rm=detbook&code=' . $row[1] . '#start'; my $result = $self->param('dbh')->exec( 'select editcode from edit where titlcode = ' . escape($titlcode) . ' order by editcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 1) { while (@row = $result->fetchrow) { push @editlist, { 'editcode' => "$row[0]", 'editlink' => $self->param('selfurl') . '?rm=detedit&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'titlcode' => $titlcode, 'titldesc' => $titldesc, 'bookcode' => $bookcode, 'booklink' => $booklink, 'anyedit' => scalar(@editlist), 'editlist' => \@editlist, 'title' => "Detail for title: $titldesc" ); return $tmpl->output; } sub detcopy { my $self = shift; my $tmpl = $self->load_tmpl('detcopy.tmpl'); my @row; my $error = ''; my $itemcode = join(' ', $self->query->param('code')); my $itemlabl; my $itemchec; my $itempage; my $itemnote; my $editcode; my $editlink; my $editnote; my $titlcode; my $titllink; my $titldesc; my $bookcode; my $booklink; my $booknote; my $langcode; my $langlink; my $langdesc; my $medicode; my $medilink; my $medidesc; my $accecode; my $accelink; my $accerate; my $colocode; my $cololink; my $colodesc; my @authlist = (); my @illulist = (); my @topilist = (); my @genrlist = (); my $result = $self->param('dbh')->exec( 'select itemlabl, itemchec, itempage, itemnote, editcode, editnote, titlcode, titldesc, bookcode, booknote, langcode, langdesc, medicode, medidesc, accecode, accerate, colocode, colodesc from (((((((item natural join edit) natural join titl) natural join book) natural join lang) natural join medi) natural left join acce) natural left join colo) where itemcode = ' . escape($itemcode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 18) { $error = 'There was an error retrieving the book copy from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the book copy code '$itemcode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $itemlabl = "$row[0]"; $itemchec = "$row[1]"; $itempage = "$row[2]"; $itemnote = "$row[3]"; $editcode = "$row[4]"; $editlink = $self->param('selfurl') . '?rm=detedit&code=' . $row[4] . '#start'; $editnote = "$row[5]"; $titlcode = "$row[6]"; $titllink = $self->param('selfurl') . '?rm=dettitl&code=' . $row[6] . '#start'; $titldesc = "$row[7]"; $bookcode = "$row[8]"; $booklink = $self->param('selfurl') . '?rm=detbook&code=' . $row[8] . '#start'; $booknote = "$row[9]"; $langcode = "$row[10]"; $langlink = $self->param('selfurl') . '?rm=detlang&code=' . $row[10] . '#start'; $langdesc = "$row[11]"; $medicode = "$row[12]"; $medilink = $self->param('selfurl') . '?rm=detmedi&code=' . $row[12] . '#start'; $medidesc = "$row[13]"; $accecode = "$row[14]"; $accelink = $accecode ? $self->param('selfurl') . '?rm=detacce&code=' . $row[14] . '#start' : ''; $accerate = "$row[15]"; $colocode = "$row[16]"; $cololink = $colocode ? $self->param('selfurl') . '?rm=detcolo&code=' . $row[16] . '#start' : ''; $colodesc = "$row[17]"; my $result = $self->param('dbh')->exec( 'select authcode, authfirs, authlast from (((item natural join edit) natural join editauth) natural join auth) where itemcode = ' . escape($itemcode) . ' order by authlast, authfirs, authcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { push @authlist, { 'authfirs' => "$row[1]", 'authlast' => "$row[2]", 'authlink' => $self->param('selfurl') . '?rm=detauth&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select illucode, illufirs, illulast from (((item natural join edit) natural join editillu) natural join illu) where itemcode = ' . escape($itemcode) . ' order by illulast, illufirs, illucode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { push @illulist, { 'illufirs' => "$row[1]", 'illulast' => "$row[2]", 'illulink' => $self->param('selfurl') . '?rm=detillu&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select topicode, topidesc from (((((item natural join edit) natural join titl) natural join book) natural join booktopi) natural join topi) where itemcode = ' . escape($itemcode) . ' order by topidesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @topilist, { 'topidesc' => "$row[1]", 'topilink' => $self->param('selfurl') . '?rm=dettopi&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select genrcode, genrdesc from (((((item natural join edit) natural join titl) natural join book) natural join bookgenr) natural join genr) where itemcode = ' . escape($itemcode) . ' order by genrdesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @genrlist, { 'genrdesc' => "$row[1]", 'genrlink' => $self->param('selfurl') . '?rm=detgenr&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'itemcode' => $itemcode, 'itemlabl' => $itemlabl, 'itemchec' => $itemchec, 'itempage' => $itempage, 'itemnote' => $itemnote, 'editcode' => $editcode, 'editlink' => $editlink, 'editnote' => $editnote, 'titllink' => $titllink, 'titldesc' => $titldesc, 'bookcode' => $bookcode, 'booklink' => $booklink, 'booknote' => $booknote, 'langlink' => $langlink, 'langdesc' => $langdesc, 'medilink' => $medilink, 'medidesc' => $medidesc, 'accelink' => $accelink, 'accerate' => $accerate, 'cololink' => $cololink, 'colodesc' => $colodesc, 'anyauth' => scalar(@authlist), 'authlist' => \@authlist, 'anyillu' => scalar(@illulist), 'illulist' => \@illulist, 'anytopi' => scalar(@topilist), 'topilist' => \@topilist, 'anygenr' => scalar(@genrlist), 'genrlist' => \@genrlist, 'title' => "Detail for book copy: $titldesc ($itemcode)" ); return $tmpl->output; } sub detedit { my $self = shift; my $tmpl = $self->load_tmpl('detedit.tmpl'); my @row; my $error = ''; my $editcode = join(' ', $self->query->param('code')); my $editnote; my $titlcode; my $titllink; my $titldesc; my $bookcode; my $booklink; my $booknote; my $langcode; my $langlink; my $langdesc; my $accecode; my $accelink; my $accerate; my $colocode; my $cololink; my $colodesc; my @authlist = (); my @illulist = (); my @topilist = (); my @genrlist = (); my @itemlist = (); my $result = $self->param('dbh')->exec( 'select editnote, titlcode, titldesc, bookcode, booknote, langcode, langdesc, accecode, accerate, colocode, colodesc from (((((edit natural join titl) natural join book) natural join lang) natural left join acce) natural left join colo) where editcode = ' . escape($editcode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 11) { $error = 'There was an error retrieving the edition from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the edition code '$editcode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $editnote = "$row[0]"; $titlcode = "$row[1]"; $titllink = $self->param('selfurl') . '?rm=dettitl&code=' . $row[1] . '#start'; $titldesc = "$row[2]"; $bookcode = "$row[3]"; $booklink = $self->param('selfurl') . '?rm=detbook&code=' . $row[3] . '#start'; $booknote = "$row[4]"; $langcode = "$row[5]"; $langlink = $self->param('selfurl') . '?rm=detlang&code=' . $row[5] . '#start'; $langdesc = "$row[6]"; $accecode = "$row[7]"; $accelink = $accecode ? $self->param('selfurl') . '?rm=detacce&code=' . $row[7] . '#start' : ''; $accerate = "$row[8]"; $colocode = "$row[9]"; $cololink = $colocode ? $self->param('selfurl') . '?rm=detcolo&code=' . $row[9] . '#start' : ''; $colodesc = "$row[10]"; my $result = $self->param('dbh')->exec( 'select authcode, authfirs, authlast from ((edit natural join editauth) natural join auth) where editcode = ' . escape($editcode) . ' order by authlast, authfirs, authcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { push @authlist, { 'authfirs' => "$row[1]", 'authlast' => "$row[2]", 'authlink' => $self->param('selfurl') . '?rm=detauth&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select illucode, illufirs, illulast from ((edit natural join editillu) natural join illu) where editcode = ' . escape($editcode) . ' order by illulast, illufirs, illucode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { push @illulist, { 'illufirs' => "$row[1]", 'illulast' => "$row[2]", 'illulink' => $self->param('selfurl') . '?rm=detillu&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select topicode, topidesc from ((((edit natural join titl) natural join book) natural join booktopi) natural join topi) where editcode = ' . escape($editcode) . ' order by topidesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @topilist, { 'topidesc' => "$row[1]", 'topilink' => $self->param('selfurl') . '?rm=dettopi&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select genrcode, genrdesc from ((((edit natural join titl) natural join book) natural join bookgenr) natural join genr) where editcode = ' . escape($editcode) . ' order by genrdesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @genrlist, { 'genrdesc' => "$row[1]", 'genrlink' => $self->param('selfurl') . '?rm=detgenr&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select itemcode, itemlabl from item where editcode = ' . escape($editcode) . ' order by itemlabl, itemcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @itemlist, { 'itemlabl' => "$row[1] ($row[0])", 'itemlink' => $self->param('selfurl') . '?rm=detcopy&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'editcode' => $editcode, 'editnote' => $editnote, 'titllink' => $titllink, 'titldesc' => $titldesc, 'bookcode' => $bookcode, 'booklink' => $booklink, 'booknote' => $booknote, 'langlink' => $langlink, 'langdesc' => $langdesc, 'accelink' => $accelink, 'accerate' => $accerate, 'cololink' => $cololink, 'colodesc' => $colodesc, 'anyauth' => scalar(@authlist), 'authlist' => \@authlist, 'anyillu' => scalar(@illulist), 'illulist' => \@illulist, 'anytopi' => scalar(@topilist), 'topilist' => \@topilist, 'anygenr' => scalar(@genrlist), 'genrlist' => \@genrlist, 'anyitem' => scalar(@itemlist), 'itemlist' => \@itemlist, 'title' => "Detail for edition: $titldesc ($editcode)" ); return $tmpl->output; } sub detbook { my $self = shift; my $tmpl = $self->load_tmpl('detbook.tmpl'); my @row; my $error = ''; my $bookcode = join(' ', $self->query->param('code')); my $booknote; my @topilist = (); my @genrlist = (); my @editlist = (); my @itemlist = (); my $result = $self->param('dbh')->exec( 'select booknote from book where bookcode = ' . escape($bookcode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 1) { $error = 'There was an error retrieving the book / story from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the book / story code '$bookcode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $booknote = "$row[0]"; my $result = $self->param('dbh')->exec( 'select topicode, topidesc from ((book natural join booktopi) natural join topi) where bookcode = ' . escape($bookcode) . ' order by topidesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @topilist, { 'topidesc' => "$row[1]", 'topilink' => $self->param('selfurl') . '?rm=dettopi&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select genrcode, genrdesc from ((book natural join bookgenr) natural join genr) where bookcode = ' . escape($bookcode) . ' order by genrdesc' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @genrlist, { 'genrdesc' => "$row[1]", 'genrlink' => $self->param('selfurl') . '?rm=detgenr&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select editcode, titldesc from (edit natural join titl) where bookcode = ' . escape($bookcode) . ' order by titldesc, editcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 2) { while (@row = $result->fetchrow) { push @editlist, { 'titldesc' => "$row[1] ($row[0])", 'editlink' => $self->param('selfurl') . '?rm=detedit&code=' . $row[0] . '#start'}; } } my $result = $self->param('dbh')->exec( 'select itemcode, itemlabl, titldesc from ((item natural join edit) natural join titl) where bookcode = ' . escape($bookcode) . ' order by titldesc, itemlabl, itemcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { push @itemlist, { 'titldesc' => "$row[2] ($row[1]) ($row[0])", 'itemlink' => $self->param('selfurl') . '?rm=detcopy&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'bookcode' => $bookcode, 'booknote' => $booknote, 'anytopi' => scalar(@topilist), 'topilist' => \@topilist, 'anygenr' => scalar(@genrlist), 'genrlist' => \@genrlist, 'anyedit' => scalar(@editlist), 'editlist' => \@editlist, 'anyitem' => scalar(@itemlist), 'itemlist' => \@itemlist, 'title' => "Detail for book / story: $bookcode" ); return $tmpl->output; } sub detmedi { my $self = shift; my $tmpl = $self->load_tmpl('detmedi.tmpl'); my @row; my @itemlist = (); my $error = ''; my $medicode = join(' ', $self->query->param('code')); my $medidesc; my $medinote; my $result = $self->param('dbh')->exec( 'select medidesc, medinote from medi where medicode = ' . escape($medicode) ); if ($result->resultStatus != PGRES_TUPLES_OK || $result->nfields != 2) { $error = 'There was an error retrieving the media / book style from the database.'; } elsif ($result->ntuples != 1) { $error = "There was no unique record for the media / book style code '$medicode'."; } else { # Undefined values can be a problem in the template program param set up. @row = $result->fetchrow; $medidesc = "$row[0]"; $medinote = "$row[1]"; my $result = $self->param('dbh')->exec( 'select itemcode, itemlabl, titldesc from (item natural join edit) natural join titl where medicode = ' . escape($medicode) . ' order by titldesc, itemlabl, itemcode' ); if ($result->resultStatus == PGRES_TUPLES_OK && $result->nfields == 3) { while (@row = $result->fetchrow) { push @itemlist, { 'itemcode' => "$row[0]", 'itemlabl' => "$row[1]", 'titldesc' => "$row[2]", 'itemlink' => $self->param('selfurl') . '?rm=detcopy&code=' . $row[0] . '#start'}; } } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'medicode' => $medicode, 'medidesc' => $medidesc, 'medinote' => $medinote, 'anyitem' => scalar(@itemlist), 'itemlist' => \@itemlist, 'title' => "Detail for media / book style: $medidesc" ); return $tmpl->output; } sub source { my $self = shift; my $tmpl = $self->load_tmpl('source.tmpl'); my %list = (); my @srclist = (); my $file; my $type; my $error = ''; my @types = ('pm', 'pl', 'tmpl', 'sql'); foreach $type (@types) { $list{$type} = []; } if (opendir(DIR, '.')) { while ($file = readdir(DIR)) { if ($file =~ m/\.([^.]+)$/) { push (@{$list{$1}}, $file) if defined($list{$1}); } } closedir(DIR); } foreach $type (@types) { foreach $file (sort(@{$list{$type}})) { push @srclist, {'file' => $file}; } } $error = 'No source listings are available' if scalar(@srclist) <= 0; $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'srclist' => \@srclist, 'title' => 'List of available source listings' ); return $tmpl->output; } sub vacuum { my $self = shift; my $tmpl = $self->load_tmpl('vacuum.tmpl'); my $result; my $error = 'Vacuum analyze successfully completed.'; if (-e 'readonly') { $error = 'Vacuum analyze of the database copy is not allowed.'; } else { $result = $self->param('dbh')->exec('vacuum analyze'); if ($result->resultStatus != PGRES_COMMAND_OK) { $error = $self->param('dbh')->errorMessage; } } $tmpl->param('menu' => $self->param('menu'), 'error' => $error, 'title' => 'Status of vacuum analyze' ); return $tmpl->output; } sub dump { my $self = shift; my $dump; my $line; # Return results as text/plain $self->header_props(-type => 'text/plain'); if (open(DUMP, 'pg_dump -c book|')) { while ($line = ) { $dump .= $line; } } else { $dump = "Unable to run pg_dump.\n"; } return $dump; } return 1;