#!/usr/bin/perl # # $Id: ddl.pl,v 1.5 2006/12/07 19:43:14 ddoughty Exp $ # # Source File: ddl.pl # Get config require 'sitecfg.pl'; &app_initialize; print "Content-Type: text/html\n\n"; if (&get_session($FORM{'tid'})) { &LanguageSupportInit(); &log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "DDL $FORM{'dbfilepath'}"); print "\n"; print "\n"; if ($SESSION{'uac'} ne 'gadmin') { print "\n"; print "You do not have privileges to make Database Structure Changes.\n"; print "\n"; } else { if ($FORM{'editmode'} eq 'apply') { if ($FORM{'def0'}) { &apply_header_changes; } else { &apply_data_changes; } } else { if ($FORM{'floctn'} eq 'dataroot') { @frecs = &get_data($FORM{'dbfilepath'}); $tmpfile = join($pathsep, $dataroot, $FORM{'dbfilepath'}); } elsif ($FORM{'floctn'} eq 'questionroot') { ($fnm, $fxt) = split(/\./, $FORM{'dbfilepath'}); @frecs = &get_question_list($fnm, $fxt); $tmpfile = join($pathsep, $questionroot, $FORM{'dbfilepath'}); } else { @frecs = (); } if ($#frecs == -1) { if ($FORM{'create'} ne '') { $FORM{'create'} = "Y"; @flds = (); $nrows = 10; $ncols = 2; if ($FORM{'editmode'} eq 'structure') { &show_table; } else { print "\n"; print "$FORM{'dbfilepath'} does not exist.\n"; print "\n"; } } else { print "\n"; print "$FORM{'dbfilepath'} does not exist.\n"; print "\n"; } } else { @flds = split(/&/,$frecs[0]); $fields = $frecs[0]; chomp($fields); $nrows = $#flds + 10; $ncols = 2; if ($FORM{'editmode'} eq 'structure') { &show_table; } else { &show_data; } } } } print "\n"; print "\n"; } sub apply_header_changes { if ($FORM{'floctn'} eq 'dataroot') { @frecs = &get_data($FORM{'dbfilepath'}); $tmpfile = join($pathsep, $dataroot, $FORM{'dbfilepath'}); $froot = $dataroot; } elsif ($FORM{'floctn'} eq 'questionroot') { ($fnm, $fxt) = split(/\./, $FORM{'dbfilepath'}); @frecs = &get_question_list($fnm, $fxt); $tmpfile = join($pathsep, $questionroot, $FORM{'dbfilepath'}); $froot = $questionroot; } else { @frecs = (); } if ($#frecs == -1) { if($FORM{'create'} eq 'Y') { open (TMPFILE, ">$tmpfile"); print TMPFILE "\n"; close TMPFILE; $noldflds = 0; } else { print "\n"; print "$FORM{'dbfilepath'} does not exist.\n"; print "\n"; return; } } else { chop ($frec[0]); @flds = split(/&/,$frecs[0]); for (0 .. $#flds) { $DEFINED_FIELDS{$_} = $flds[$_];} $noldflds = $#flds; } $nnewflds = 0; for (keys %FORM) { if ($_ =~ /idx(.*)/ ) { ($trash, $idx) = split(/x/, $_); $defidx = "def$idx"; $DEFINED_FIELDS{$_} = $FORM{$_}; $DEFINED_DEFAULTS{$_} = $FORM{$defidx}; $nnewflds++; } } if ($nnewflds == 0) { print "No changes were made.
\n"; } else { $nnewflds--; $newrec = $DEFINED_FIELDS{'idx0'}; $newdef = ""; for (1 .. $nnewflds) { $idx = "idx$_"; if ( $DEFINED_FIELDS{$idx} ne '') { $newrec = join('&', $newrec, $DEFINED_FIELDS{$idx}); if($_ > $noldflds) { if ($DEFINED_DEFAULTS{$idx} eq "") { $newdef = join('&', $newdef, ""); } else { $newdef = join('&', $newdef, $DEFINED_DEFAULTS{$idx}); } } } } print "FILE HEADER:
\n"; print "$frecs[0]
\ \;
\n"; print "CHANGED TO:
\n"; print "$newrec
\ \;
\n"; print "WITH DEFAULT VALUES OF:
\n"; print "$newdef
\ \;
\n"; print "Files Affected:
\n"; &update_file_header($froot, $FORM{'dbfilepath'}, $newrec, $newdef); } if ($FORM{'dbrelated'} ne '') { opendir (TMPDIR, $froot); @dots = readdir(TMPDIR); closedir TMPDIR; if ($FORM{'dbrelated'} =~ /\*/ ) { ($segleft, $segright) = split(/\*/, $FORM{'dbrelated'}); foreach $dot (@dots) { if ($dot =~ m/$segleft(.*)$segright/ ) { if ($dot ne $FORM{'dbfilepath'}) { &update_file_header($froot, $dot, $newrec, $newdef); } } } } else { $dbrelated = join(';', "", $FORM{'dbrelated'}, ""); foreach $dot (@dots) { if ($dbrelated =~ /;$dot;/ ) { if ($dot ne $FORM{'dbfilepath'}) { &update_file_header($froot, $dot, $newrec, $newdef); } } } } } } sub apply_data_changes { if ($FORM{'floctn'} eq 'dataroot') { @frecs = &get_data($FORM{'dbfilepath'}); $tmpfile = join($pathsep, $dataroot, $FORM{'dbfilepath'}); $froot = $dataroot; } elsif ($FORM{'floctn'} eq 'questionroot') { ($fnm, $fxt) = split(/\./, $FORM{'dbfilepath'}); @frecs = &get_question_list($fnm, $fxt); $tmpfile = join($pathsep, $questionroot, $FORM{'dbfilepath'}); $froot = $questionroot; } else { @frecs = (); } if ($#frecs == -1) { if($FORM{'create'} eq 'Y') { open (TMPFILE, ">$tmpfile"); print TMPFILE "\n"; close TMPFILE; $noldflds = 0; } else { print "\n"; print "$FORM{'dbfilepath'} does not exist.\n"; print "\n"; return; } } else { chop ($frec[0]); @flds = split(/&/,$frecs[0]); } for (keys %FORM) { if ($_ =~ /\-/) { ($rowidx, $colidx) = split(/\-/, $_); $data[$rowidx][$colidx] = $FORM{$_}; } } open (TMPFILE, ">$tmpfile"); print "$FORM{'fields'}
\n"; print TMPFILE "$FORM{'fields'}\n"; for ($r=1; $r<= $FORM{'numrows'}+1; $r++) { if ($FORM{$r} eq "on") { next; } $rowdata = ""; for ($c=0; $c<=$FORM{'numcols'}; $c++) { $rowdata .= $data[$r][$c]."&"; } $rowdata = substr($rowdata, 0, -1); $rowdata =~ tr/+/ /; $tmprowdata = $rowdata; $tmprowdata =~ tr /&//d; if ($tmprowdata eq "") { next; } print "$rowdata
\n"; print TMPFILE "$rowdata\n"; } close TMPFILE; print "

Data written to $tmpfile.
\n"; } sub update_file_header { $updfile = join($pathsep, $_[0], $_[1]); open (TMPUPDFILE, "<$updfile"); @updlines = ; close TMPUPDFILE; $updline = $updlines[0]; chop($updline); if($updline ne $newrec) { open (TMPUPDFILE, ">$updfile"); $nLineNo = 0; foreach $updline (@updlines) { chop($updline); if ($nLineNo == 0) { print TMPUPDFILE "$_[2]\n"; } else { print TMPUPDFILE "$updline$_[3]\n"; } $nLineNo++; } close TMPUPDFILE; } print "$updfile
\n"; } sub show_table { print " File Structure: $tmpfile \n"; } sub show_data { $txamask = ""; print " File Structure: $tmpfile \n"; }

Column Name	New Name	Default Value
$fld
New Column $i

Del	$fld
	\n"; if ($data[$_] =~ /\;/ ) { print "$data[$_]\n"; $txamask = join('', $txamask, "<$_>"); } else { print "\n"; } print "
	\n"; if ($txamask =~ /<$_>/ ) { print "\n"; } else { print "\n"; } print "