# # # # # # ck_admin.pl # # CodeKit Universal Code Table Administration page. # # Copyright (C) 2003 John Gorman # http://www.webbysoft.com/codekit # use strict; use warnings; use vars qw( $action $code_set $code_code $self_url ); # # # # # # Main dispatch logic. # sub cka_admin_main { print $cgi->header; $self_url = $cgi->url(-absolute=>1); $action = $cgi->param('action') || ''; $code_set = $cgi->param('code_set') || ''; $code_code = $cgi->param('code_code') || ''; cka_admin_header(); if ($action eq 'New') { cka_form_display(); } elsif ($action eq '' && $code_code ne '') { cka_form_display($code_code); } elsif ($action ne '') { cka_form_aud(); } elsif ($code_set ne '') { cka_set_display(); } else { cka_administration(); } print " "; } # # # # # # Print the page header # sub cka_admin_header { my $title = "CodeKit Universal Code Administration"; $title .= " : $code_set" if ($code_set); if ($action eq 'New') { $title .= " : New"; } elsif ($code_code ne '') { $title .= " : $code_code"; } print " $title

$title

Main Admin Page - Help Docs - CodeKit Home

Select a code set

"; print $ckh->select('code_set', blank_prompt => 'All Codes', options => 'onchange="submit()"' ); print "

"; } # # # # # # Display the code administration page # sub cka_administration { print "Main CodeKit Administration Page\n"; print "

\n"; print " "; # Print the code sets. my $set_counts = cka_get_counts(); my $set_rows = $ckh->code_set('code_set'); my $bgcolor; my $total = 0; my $n = 0; for my $set_row ( @$set_rows ) { next if $set_row->[3] eq 'd'; my $set_cd = $set_row->[0]; my $set_desc = ucfirst($set_row->[1]); my $set_count = $set_counts->{$set_cd} || 0; $total += $set_count; $bgcolor = ($n % 2) ? "#6699CC" : "#6699FF"; $n++; print" "; } $bgcolor = ($n % 2) ? "#6699CC" : "#6699FF"; print"
 Code Set   Description   Count   Admin 
 $set_cd   $set_desc   $set_count    admin 
   $total   
"; } # # # # # # Display a code set # sub cka_set_display { my $set_desc = $ckh->ucwords('code_set', $code_set); print "$set_desc Code Administration\n"; print "

\n"; my $MD = ($code_set eq 'code_set') ? 'M' : 'D'; print " "; # Gather the codes in order and truncate the descriptions. my $base_set = $ckh->code_set($code_set); for my $row ( @$base_set ) { my $desc = $row->[1]; if (length($desc) > 50) { $desc = substr($desc, 0, 50) . '...'; } $row->[1] = DBIx::CodeKit::htmlspecialchars($desc); } my $n = 0; for my $row ( @$base_set ) { my ( $code_code, $code_desc, $code_order, $code_flag ) = @$row; my $bgcolor = ($n % 2) ? "#6699CC" : "#6699FF"; $n++; my $D = uc($code_flag); print" "; } print "
 $MD   O   Code   Description   Edit 
 $D   $code_order   $code_code   $code_desc    edit 
\n"; my $count = @$base_set; if ($count == 0) { print("

No records.\n\n"); } elsif ($count == 1) { printf("

%d record.\n\n", $count); } else { printf("

%d records.\n\n", $count); } if ($perm_add) { print "

Add new $set_desc code\n"; } } # # # # # # Display the code entry/update form. # sub cka_form_display { my $code_code = shift; $code_code = '' unless defined $code_code; # Check for a valid code set or exit. my ( $set_desc, $set_order, $set_flag ) = $ckh->get('code_set', $code_set); cka_error_exit("No Code set specified!") unless $set_desc; $set_desc = $ckh->ucwords('code_set', $code_set); print "$set_desc Code Administration\n"; print "

\n"; print "

"; my ( $code_desc, $code_order, $code_flag ) = $ckh->get($code_set, $code_code); $code_desc = '' unless defined $code_desc; $code_order = '' unless defined $code_order; $code_flag = '' unless defined $code_flag; if ($code_set eq 'code_set') { # Multiline? my $checked = ($code_flag eq 'm') ? 'checked' : ''; print " "; } else { # Deprecated? my $checked = ($code_flag eq 'd') ? "checked" : ""; print " "; } # Order number. print " "; # Description $code_desc = DBIx::CodeKit::htmlspecialchars($code_desc); print "\n"; print "\n"; if ($set_flag eq 'm') { my @n = split "\n", $code_desc; my $n = @n; $n = 3 if $n < 3; print "\n"; } else { print "\n"; } print "\n"; # Action items. print "
"; if ($code_code eq '') { print "Add $set_desc code\n"; } else { # Code navigation aids. my $set = $ckh->code_set($code_set); my ( $n_of, $of_n, $next_cd, $prev_cd, $first_cd, $last_cd ) = cka_place($set, $code_code); print "Edit $set_desc code \"$code_code\" (#$n_of of $of_n)
\n"; print "Next ($next_cd)\n"; print "Prev ($prev_cd)\n"; print "First ($first_cd)\n"; print "Last ($last_cd)\n"; } # Code code. print "
Code "; if ($code_code eq '') { if ($code_set eq 'code_set') { print "\n"; } else { print "\n"; } } else { print "$code_code\n"; print "\n"; } print "
Multiline Set [Paragraph mode]
Deprecated
Code Order
Description
Action "; if ($code_code eq '') { if ($perm_add) { print "\n"; } } else { if ($perm_upd) { print "\n"; } if ($perm_del) { print "\n"; } if ($perm_add) { print "Add new $set_desc code\n"; } } print "
"; } # # # # # # Add / Update / Delete a code. # sub cka_form_aud { my $code_desc = $cgi->param('code_desc') || ''; my $code_order = $cgi->param('code_order') || ''; my $code_flag = $cgi->param('code_flag') || ''; # Check for validity. if ( ! $ckh->get('code_set', $code_set) ) { cka_error_exit("No Code set specified!"); } if ( $action eq 'Add' && !$perm_add ) { cka_error_exit("No permission to add '$code_set'!"); } if ( $action eq 'Update' && !$perm_upd ) { cka_error_exit("No permission to update '$code_set'!"); } if ( $action eq 'Delete' && !$perm_del ) { cka_error_exit("No permission to delete '$code_set'!"); } if ( $code_code eq '' ) { cka_error_exit("No code specified!"); } unless ( $code_code =~ /^[a-zA-Z_0-9-]+$/ ) { cka_error_exit("Code must consist of [a-zA-Z_0-9-]!"); } unless ( $code_order =~ /^-?[0-9]*$/ ) { cka_error_exit("Code order must be numeric!"); } # Variable setup. my $code_exists = $ckh->get($code_set, $code_code); my ( $n_of, $of_n, $next_cd, $prev_cd, $first_cd, $last_cd ); if ($action eq 'Update' || $action eq 'Delete') { my $set = $ckh->code_set($code_set); ( $n_of, $of_n, $next_cd, $prev_cd, $first_cd, $last_cd ) = cka_place($set, $code_code); } if ($action eq 'Delete') { if (!$code_exists) { cka_error_exit("No such code '$code_code'!"); } $ckh->remove($code_set, $code_code); print "Record Deleted!

\n"; if ($next_cd eq $code_code) { cka_set_display(); } else { cka_form_display($next_cd); } } elsif ($action eq 'Add' || $action eq 'Update') { if ($action eq 'Add' && $code_exists) { cka_error_exit("Code '$code_code' already exists!"); } if ($action eq 'Update' && !$code_exists) { cka_error_exit("No such code '$code_code'!"); } # Pump in those fields. $code_desc =~ s/^\s+//; $code_desc =~ s/\s+$//; $ckh->put($code_set, $code_code, $code_desc, $code_order, $code_flag); # Whats next. if ($action eq 'Add') { print "Record Added!

\n"; cka_form_display(); } else { print "Record Updated!

\n"; cka_form_display($next_cd); } } else { cka_error_exit("Unknown form action '$action'"); } } # # # # # # Local Functions # # Get the code counts for all sets. sub cka_get_counts { my $sth = $dbh->prepare(" select code_set, count(*) code_count from $ckh->{table} group by code_set "); $sth->execute; my $rows = $sth->fetchall_arrayref; my $set_counts = {}; for my $row ( @$rows ) { $set_counts->{$row->[0]} = $row->[1]; } return $set_counts; } # Find a code's place in the set. sub cka_place { my $set = shift; my $code_code = shift; my $count = @$set; my $first = $set->[0][0]; my $last = $set->[$count - 1][0]; my $prev; my $next; my $n; for ($n = 0; $n < $count; $n++) { last if $set->[$n][0] eq $code_code; } if ($n == 0) { $prev = $last; if ($count > 1) { $next = $set->[$n + 1][0]; } else { $next = $last; } } elsif ($n == $count - 1) { $prev = $set->[$n - 1][0]; $next = $first; } else { $prev = $set->[$n - 1][0]; $next = $set->[$n + 1][0]; } return ( $n + 1, $count, $next, $prev, $first, $last ); } # Error exit. sub cka_error_exit { my $msg = shift; print "

Error: $msg"; print "\n\n"; exit(); } 1;