contrib/forms/formmaker/formscript.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use CGI qw(:standard);
   7
   8 #if -noxl command line option is used, xl function will not be put into form
   9 use Getopt::Long;
  10 my $noxl = '';
  11 GetOptions('noxl' => \$noxl);
  12
  13 #file templates here
  14
  15 #documentation
  16 my $documentation =<<'START';
  17
  18 *************************************
  19 *      Form Generating Script 2.0   *
  20 *************************************
  21
  22 To run at the shell command line, type:
  23
  24 Perl formscript.pl [filename]
  25
  26 where filename is a text file with data relating to your form.  If you run
  27 without a filename argument, a sample data file will be created in the same
  28 directory named 'sample.txt' that you can use to see how to create your own.
  29
  30 The first line you enter in your textfile is the name of the form.
  31 In the example this is "a1_preop_physical"
  32
  33 Basically you enter one database field item per line like this:
  34
  35 Social History::popup_menu::smoker::non-smoker
  36
  37 or
  38
  39 Social History::radio_group::smoker::non-smoker
  40
  41
  42 where the first item is the field name, the second item is the widget type, and Nth items are values.
  43 spaces within the name will convert to '_'
  44 for the sql database field name.  If you use a SQL reserved word, the form generation
  45 will fail and this program will notify you of the word(s) you used.
  46
  47 The '::' is the standard delimiter that I use between items.  The second item on the line
  48 is the form widget type.  You can choose from:
  49
  50 textfield
  51 textarea
  52 checkbox
  53 checkbox_group
  54 radio_group
  55 popup_menu
  56 scrolling_list
  57 scrolling_list_multiples
  58 date
  59
  60 Putting a '+' at the beginning of the field name will let the form know that you want to
  61 report negatives.  This means the following:
  62
  63 +cardiac_review::checkbox_group::chest pain::shortness of breath::palpitations
  64
  65 creates a group of checkboxes where if the user chooses the first two boxes, the database will
  66 have the following line entered:
  67
  68 chest pain, shortness of breath.  Negative for palpitations.
  69
  70 The remaining items after the fieldname and the widget type  are the names for
  71 checkboxes or radio buttons or default text
  72 for a textfield or text area.  You can also start a line with a '#' as the first character and this
  73 will be an ignored comment line.  If you put html tags on their own lines, they will be integrated
  74 into the form.  It will be most helpful to look at 'sample.txt' to see how this works.
  75
  76 By default now, the xl function which is for performing language translation is used.  To disable this feature in creating a form, use the commandline option -noxl as in:
  77
  78 ./formscript.pl -noxl sample.txt
  79
  80 Please send feedback to drleeds@gmail.com.
  81
  82
  83 START
  84
  85 #info.txt
  86 my $info_txt=<<'START';
  87 FORM_NAME
  88 START
  89
  90 #date header
  91 #if there is one or more date fields, this will need to be inserted into the body of new.php
  92 #for the popup javascript calendar
  93 my $date_field_exists = 0;
  94 my $date_header =<<'START';
  95 <style type="text/css">@import url(../../../library/dynarch_calendar.css);</style>
  96 <script type="text/javascript" src="../../../library/dialog.js"></script>
  97 <script type="text/javascript" src="../../../library/textformat.js"></script>
  98 <script type="text/javascript" src="../../../library/dynarch_calendar.js"></script>
  99 <script type="text/javascript" src="../../../library/dynarch_calendar_en.js"></script>
 100 <script type="text/javascript" src="../../../library/dynarch_calendar_setup.js"></script>
 101 <script language='JavaScript'> var mypcc = '1'; </script>
 102 START
 103
 104 #new.php
 105 my $new_php =<<'START';
 106 <?php
 107 include_once("../../globals.php");
 108 include_once("$srcdir/api.inc");
 109 formHeader("Form: FORM_NAME");
 110 ?>
 111 <html><head>
 112 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 113 </head>
 114 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 115 DATE_HEADER
 116 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="FORM_NAME" onsubmit="return top.restoreSession()">
 117 <hr>
 118 <h1>FORM_NAME</h1>
 119 <hr>
 120 DATABASEFIELDS
 121 </form>
 122 <?php
 123 formFooter();
 124 ?>
 125 START
 126
 127 #print.php
 128 my $print_php=<<'START';
 129 <?php
 130 include_once("../../globals.php");
 131 include_once("$srcdir/api.inc");
 132 formHeader("Form: FORM_NAME");
 133 ?>
 134 <html><head>
 135 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 136 </head>
 137 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 138 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="my_form" onsubmit="return top.restoreSession()">
 139 <h1> FORM_NAME </h1>
 140 <hr>
 141 DATABASEFIELDS
 142 </form>
 143 <?php
 144 formFooter();
 145 ?>
 146 START
 147
 148 #report.php
 149 #The variable $mykey and $myval are used by the xl_fix function for replacement purposes
 150 my $report_php=<<'START';
 151 <?php
 152 //------------report.php
 153 include_once("../../globals.php");
 154 include_once($GLOBALS["srcdir"]."/api.inc");
 155 function FORM_NAME_report( $pid, $encounter, $cols, $id) {
 156 $count = 0;
 157 $data = formFetch("form_FORM_NAME", $id);
 158 if ($data) {
 159 print "<hr><table><tr>";
 160 foreach($data as $key => $value) {
 161 if ($key == "id" || $key == "pid" || $key == "user" || $key == "groupname" || $key == "authorized" || $key == "activity" || $key == "date" || $value == "" || $value == "0000-00-00 00:00:00") {
 162         continue;
 163 }
 164 if ($value == "on") {
 165 $value = "yes";
 166 }
 167 $key=ucwords(str_replace("_"," ",$key));
 168 $mykey = $key.": ";
 169 $myval = stripslashes($value);
 170 print "<td><span class=bold>".$mykey."</span><span class=text>".$myval."</span></td>";
 171 $count++;
 172 if ($count == $cols) {
 173 $count = 0;
 174 print "</tr><tr>\n";
 175 }
 176 }
 177 }
 178 print "</tr></table><hr>";
 179 }
 180 ?>
 181 START
 182
 183 #save.php
 184 my $save_php=<<'START';
 185 <?php
 186 //------------This file inserts your field data into the MySQL database
 187 include_once("../../globals.php");
 188 include_once("$srcdir/api.inc");
 189 include_once("$srcdir/forms.inc");
 190
 191 //process form variables here
 192 //create an array of all of the existing field names
 193 $field_names = array(FIELDNAMES);
 194 $negatives = array(NEGATIVES);
 195 //process each field according to it's type
 196 foreach($field_names as $key=>$val)
 197 {
 198   $pos = '';
 199   $nev = '';
 200         if ($val == "checkbox")
 201         {
 202                 if ($_POST[$key]) {$field_names[$key] = "yes";}
 203                 else {$field_names[$key] = "negative";}
 204         }
 205         elseif (($val == "checkbox_group")||($val == "scrolling_list_multiples"))
 206         {
 207                 if (array_key_exists($key,$negatives)) #a field requests reporting of negatives
 208                 {
 209                   if ($_POST[$key])
 210                   {
 211                         foreach($_POST[$key] as $var) #check positives against list
 212                         {
 213                                 if (array_key_exists($var, $negatives[$key]))
 214                                 {       #remove positives from list, leaving negatives
 215                                         unset($negatives[$key][$var]);
 216                                 }
 217                         }
 218                   }
 219                         if ($negatives[$key]) {$neg = "Negative for ".implode(', ',$negatives[$key]);}
 220                 }
 221                 if ($_POST[$key]) {$pos = implode(', ',$_POST[$key]);}
 222                 if($pos) {$pos = 'Positive for '.$pos.'.  ';}
 223                 $field_names[$key] = $pos.$neg;
 224         }
 225         else
 226         {
 227                 $field_names[$key] = $_POST[$key];
 228         }
 229         if ($field_names[$key] != '')
 230         {
 231           $field_names[$key] .= '.';
 232           $field_names[$key] = preg_replace('/\s*,\s*([^,]+)\./',' and $1.',$field_names[$key]); // replace last comma with 'and' and ending period
 233         }
 234 }
 235
 236 //end special processing
 237
 238 foreach ($field_names as $k => $var) {
 239 $field_names[$k] = mysql_escape_string($var);
 240 echo "$var\n";
 241 }
 242 if ($encounter == "")
 243 $encounter = date("Ymd");
 244 if ($_GET["mode"] == "new"){
 245 $newid = formSubmit("form_FORM_NAME", $field_names, $_GET["id"], $userauthorized);
 246 addForm($encounter, "FORM_NAME", $newid, "FORM_NAME", $pid, $userauthorized);
 247 }elseif ($_GET["mode"] == "update") {
 248
 249
 250 sqlInsert("update form_FORM_NAME set pid = {$_SESSION["pid"]},groupname='".$_SESSION["authProvider"]."',user='".$_SESSION["authUser"]."',authorized=$userauthorized,activity=1, date = NOW(), FIELDS where id=$id");
 251 }
 252 $_SESSION["encounter"] = $encounter;
 253 formHeader("Redirecting....");
 254 formJump();
 255 formFooter();
 256 ?>
 257 START
 258
 259 #table.sql
 260 my $table_sql=<<'START';
 261 CREATE TABLE IF NOT EXISTS `form_FORM_NAME` (
 262 id bigint(20) NOT NULL auto_increment,
 263 date datetime default NULL,
 264 pid bigint(20) default NULL,
 265 user varchar(255) default NULL,
 266 groupname varchar(255) default NULL,
 267 authorized tinyint(4) default NULL,
 268 activity tinyint(4) default NULL,
 269 DATABASEFIELDS
 270 PRIMARY KEY (id)
 271 ) TYPE=MyISAM;
 272 START
 273
 274 #view.php
 275 my $view_php =<<'START';
 276 <!-- view.php -->
 277 <?php
 278 include_once("../../globals.php");
 279 include_once("$srcdir/api.inc");
 280 formHeader("Form: FORM_NAME");
 281 $obj = formFetch("form_FORM_NAME", $_GET["id"]);  #Use the formFetch function from api.inc to get values for existing form.
 282
 283 function chkdata_Txt(&$obj, $var)
 284     {
 285         $result = stripslashes($obj{"$var"});
 286         return $result;
 287     }
 288  function chkdata_CB(&$obj, $nam, $var)
 289     {
 290         $objarr = explode(',',$obj{$nam});
 291         foreach ($objarr as $a)
 292                 {
 293                         if ($a == "$var")
 294                                 {
 295                                         $result = "\"checked\"";
 296                                         }
 297                 }
 298         return $result;
 299     }
 300  function chkdata_Radio(&$obj, $nam, $var)
 301     {
 302         if ($obj{$nam}== "$var")
 303                 {
 304                         $result = "\"checked\"";
 305                         }
 306         return $result;
 307     }
 308  function chkdata_PopOrScroll(&$obj, $nam, $var)
 309     {
 310         $objarr = explode(',',$obj{$nam});
 311         foreach ($objarr as $a)
 312                 {
 313                         if ($a == "$var")
 314                                 {
 315                                         $result = "\"selected\"";
 316                                         }
 317                 }
 318         return $result;
 319     }
 320
 321 ?>
 322 <html><head>
 323 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 324 </head>
 325 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 326 <form method=post action="<?echo $rootdir?>/forms/FORM_NAME/save.php?mode=update&id=<?echo $_GET["id"];?>" name="my_form" onsubmit="return top.restoreSession()">
 327 <h1> FORM_NAME </h1>
 328 <hr>
 329 DATABASEFIELDS
 330
 331 </form>
 332 <?php
 333 formFooter();
 334 ?>
 335 START
 336
 337 #preview.html
 338 my $preview_html =<<'START';
 339 <html><head>
 340 </head>
 341 <body>
 342 <form>
 343 <hr>
 344 <h1> FORM_NAME </h1>
 345 <hr>
 346 DATABASEFIELDS
 347 </form>
 348 </body>
 349 </html>
 350 START
 351
 352 #sample.txt
 353 my $sample_txt =<<'START';
 354 physical_sample
 355
 356 chief_complaints::textarea
 357
 358 <h3>past surgical history</h3>
 359 +surgical history::checkbox_group::cholecystectomy::tonsillectomy::apendectomy::hernia
 360 <h4>other</h4>
 361 surgical history other::textfield
 362
 363 <h3>past medical history</h3>
 364 +medical history::scrolling_list_multiples::asthma::diabetes::hypertension::GERD
 365 <h4>other</h4>
 366 medical history other::textfield
 367
 368 <h2>Allergies</h2>
 369 +allergies::checkbox_group::penicillin::sulfa::iodine
 370 <h4>other</h4>
 371 allergies other::textfield
 372
 373 <h2>Social History</h2>
 374 <h3>smoking</h3>
 375 smoke history::radio_group::non-smoker::smoker
 376 <h3>alcohol</h3>
 377 etoh history::scrolling_list::none::occasional::daily::heavy use
 378 <h3>last mammogram</h3>
 379 last mammogram::date
 380 START
 381
 382 my @reserved = ('ADD','ALL','ALTER','ANALYZE','AND','AS','ASC','ASENSITIVE','BEFORE','BETWEEN','BIGINT','BINARY','BLOB','BOTH','BY','CALL','CASCADE','CASE','CHANGE','CHAR','CHARACTER','CHECK','COLLATE','COLUMN','CONDITION','CONNECTION','CONSTRAINT','CONTINUE','CONVERT','CREATE','CROSS','CURRENT_DATE','CURRENT_TIME','CURRENT_TIMESTAMP','CURRENT_USER','CURSOR','DATABASE','DATABASES','DAY_HOUR','DAY_MICROSECOND','DAY_MINUTE','DAY_SECOND','DEC','DECIMAL','DECLARE','DEFAULT','DELAYED','DELETE','DESC','DESCRIBE','DETERMINISTIC','DISTINCT','DISTINCTROW','DIV','DOUBLE','DROP','DUAL','EACH','ELSE','ELSEIF','ENCLOSED','ESCAPED','EXISTS','EXIT','EXPLAIN','FALSE','FETCH','FLOAT','FOR','FORCE','FOREIGN','FROM','FULLTEXT','GOTO','GRANT','GROUP','HAVING','HIGH_PRIORITY','HOUR_MICROSECOND','HOUR_MINUTE','HOUR_SECOND','IF','IGNORE','IN','INDEX','INFILE','INNER','INOUT','INSENSITIVE','INSERT','INT','INTEGER','INTERVAL','INTO','IS','ITERATE','JOIN','KEY','KEYS','KILL','LEADING','LEAVE','LEFT','LIKE','LIMIT','LINES','LOAD','LOCALTIME','LOCALTIMESTAMP','LOCK','LONG','LONGBLOB','LONGTEXT','LOOP','LOW_PRIORITY','MATCH','MEDIUMBLOB','MEDIUMINT','MEDIUMTEXT','MIDDLEINT','MINUTE_MICROSECOND','MINUTE_SECOND','MOD','MODIFIES','NATURAL','NOT','NO_WRITE_TO_BINLOG','NULL','NUMERIC','ON','OPTIMIZE','OPTION','OPTIONALLY','OR','ORDER','OUT','OUTER','OUTFILE','PRECISION','PRIMARY','PROCEDURE','PURGE','READ','READS','REAL','REFERENCES','REGEXP','RENAME','REPEAT','REPLACE','REQUIRE','RESTRICT','RETURN','REVOKE','RIGHT','RLIKE','SCHEMA','SCHEMAS','SECOND_MICROSECOND','SELECT','SENSITIVE','SEPARATOR','SET','SHOW','SMALLINT','SONAME','SPATIAL','SPECIFIC','SQL','SQLEXCEPTION','SQLSTATE','SQLWARNING','SQL_BIG_RESULT','SQL_CALC_FOUND_ROWS','SQL_SMALL_RESULT','SSL','STARTING','STRAIGHT_JOIN','TABLE','TERMINATED','THEN','TINYBLOB','TINYINT','TINYTEXT','TO','TRAILING','TRIGGER','TRUE','UNDO','UNION','UNIQUE','UNLOCK','UNSIGNED','UPDATE','USAGE','USE','USING','UTC_DATE','UTC_TIME','UTC_TIMESTAMP','VALUES','VARBINARY','VARCHAR','VARCHARACTER','VARYING','WHEN','WHERE','WHILE','WITH','WRITE','XOR','YEAR_MONTH','ZEROFILL','ACTION','BIT','DATE','ENUM','NO','TEXT','TIME','TIMESTAMP');
 383 my %reserved;
 384 $reserved{$_}++ for @reserved;     # Shortened syntax for assigning value of 1 to each associative element in array.
 385                                              # IE:  UNLOCK = 1, WRITE = 1, ETC... Associative array.
 386
 387
 388
 389
 390 #*********************************************************************************
 391 #******************************** MAIN PROGRAM ***********************************
 392 #*********************************************************************************
 393
 394 if (@ARGV == 0)
 395 {
 396         to_file('sample.txt',$sample_txt) if not -f 'sample.txt';
 397         print $documentation."\n";
 398         exit 0;
 399 }
 400
 401 my $form_name = <>;
 402 chomp($form_name);
 403 my $compare = $form_name;
 404 $compare =~ tr/[a-z]/[A-Z]/;
 405 if ($reserved{$compare})
 406 {
 407         print "You have chosen an SQL reserved word for your form name: $form_name.  Please try again.\n";
 408         exit 1;
 409 }
 410 $form_name =~ s/^\s+(\S)\s+$/$1/;       #Remove spaces from beginning and end of form name and save $1 which is a backreference to subexpression ("\S" MEANS Any non-whitespace character)) to $form_name.
 411 $form_name =~ s/\s+/_/g;                #Substitute all blank spaces with _ globally --> g means globally.
 412 if (! -e $form_name)
 413 {
 414         mkdir "$form_name" or die "Could not create directory $form_name: $!";
 415 }
 416 my @field_data;                                                                                  #the very important array of field data
 417 chomp, push @field_data, [ split /::/ ] while <>;               #while <> continues through currently open file (parameter from command line invoking perl ie: "subjective.txt"), chomping return characters, splitting on :: or more (::::) and putting into field_data array.
 418 my %negatives;               #key=field name: these are the fields that require reporting of pertinant
 419                                      #negatives.  will only apply to checkbox_group and scrolling_list_multiples types
 420 my @reserved_used;
 421 #strip outer spaces from field names and field types and change inner spaces to underscores
 422 #and check field names for SQL reserved words now
 423 for (@field_data)
 424 {
 425         if ($_->[0] and $_->[1])        #$_->[0] is field name and $_->[1] is field type.  IE:  @field_data[4]->[0] and @field_data[4]->[1]
 426         {
 427                 $_->[0] =~ s/^\s+(\S)\s+$/$1/;        #\s means spaces, \S means non spaces. (\S) creates backreference pointed to by $1 at end. ***FIELD NAME***
 428                 $_->[0] = lc $_->[0];           #MAKE SURE FILENAMES ARE ALL LOWERCASE (to avoid problems later)
 429                 $_->[0] =~ s/\s+|-+/_/g;                 # So now @field_data[1]->[0] contains the field name without spaces at beginning or end and this replaces spaces with _  ie: "field type" becomes "field_type"
 430                 push @reserved_used, $_->[0] if $reserved{$_->[0]};
 431                 $_->[1] =~ s/^\s+(\S)\s+$/$1/;
 432                 if ($_->[0] =~ /^\+/) #a leading '+' indicates to print negatives
 433                 {               # or not checked values in a checkbox_group or scrolling_list_multiples
 434                         $_->[0] =~ s/^\+(.*)/$1/;
 435                         $negatives{$_->[0]}++;      #Shortened syntax for putting $field_name, 1 into "negatives" associative array.
 436                                                             #Same as %negatives = (%negatives, $_->[0], 1)
 437                 }
 438         }
 439 }
 440 if (@reserved_used)
 441 {
 442         print "You have chosen the following reserved words as field names.  Please try again.\n";
 443         print "$_\n" for @reserved_used;
 444         exit 1;
 445 }
 446
 447
 448
 449 #****************************************************************************
 450 #**Send field data to the Make_form subroutine and receive it back as $text**
 451 #****************************************************************************
 452
 453 my $make_form_results = make_form(@field_data);
 454 my $out;
 455
 456
 457
 458 #***************************************************************************
 459 #**************************REPLACEMENT SECTION******************************
 460 #***************************************************************************
 461 #***This section replaces the 'PLACE_HOLDERS' in the $whatever.php above.***
 462 #***$text holds the results from the "make_form" subroutine below.       ***
 463 #***************************************************************************
 464
 465
 466 #info.txt
 467 $out = replace($info_txt, 'FORM_NAME', $form_name); #Custom delcared sub 3 parameters
 468 to_file("$form_name/info.txt",$out);
 469
 470 #new.php
 471 $out = replace($new_php, 'FORM_NAME', $form_name);
 472 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 473 $out = xl_fix($out);
 474 $date_header = '' if not $date_field_exists;
 475 $out = replace($out,'DATE_HEADER',$date_header);
 476 to_file("$form_name/new.php",$out);
 477
 478 #print.php
 479 $out = replace($print_php, 'FORM_NAME', $form_name);
 480 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 481 $out = xl_fix($out);
 482 to_file("$form_name/print.php",$out);
 483
 484 #report.php
 485 $out = replace($report_php, 'FORM_NAME', $form_name);   #Here's where we set $out = to it's corresponding input (whatever_php) and replace the place holder 'FORM_NAME' with the correct $form_name
 486 $out = replace($out, 'DATABASEFIELDS', $make_form_results);             #Then replace 'DATABASEFIELDS' in 'whatever_php' with $make_form_results, generated from make_form subroutine.
 487 $out = xl_fix2($out);
 488 to_file("$form_name/report.php",$out);
 489
 490 #save.php
 491 $out = replace($save_php, 'FORM_NAME', $form_name);
 492 $out = replace_save_php($out, @field_data);             #Or send it to a special case where extra things can be added to the output. ("replace_save_php" is down below under "sub-routines")
 493 to_file("$form_name/save.php",$out);
 494
 495 #view.php
 496 $out = replace($view_php, 'FORM_NAME', $form_name);
 497 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 498 $out = replace_view_php($out);
 499 $out = xl_fix($out);
 500 to_file("$form_name/view.php",$out);
 501
 502 #table.sql
 503 $out = replace($table_sql, 'FORM_NAME', $form_name);
 504 $out = replace_sql($out, @field_data);
 505 to_file("$form_name/table.sql",$out);
 506
 507 #preview.html
 508 $out = replace($preview_html, 'FORM_NAME', $form_name);
 509 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 510 to_file("$form_name/preview.html",$out);
 511
 512
 513
 514
 515 #******************************************************************
 516 #************************* SUB-ROUTINES ***************************
 517 #******************************************************************
 518
 519 sub replace
 520 {
 521         my $text = shift;  #This shifts through the supplied arguments ($whatever_php, 'FORM_NAME', and $form_name)
 522                                 #This $text is a LOCAL variable.  Does not overwrite other $make_form_results
 523                                 #Shift starts with the first value.  If variable (as in $whatever_php) expands and goes through line by line
 524         my %words = @_;
 525         $text =~ s/$_/$words{$_}/g for keys %words;
 526         return $text;
 527 }
 528
 529
 530 sub replace_save_php #a special case
 531 {
 532         my $text = shift;
 533         my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;  #Checks to see that Field_name and Field_type exist --Grep statement and map to @array.
 534         for (@fields)
 535         {
 536                  $_ = "$_='\".\$field_names[\"$_\"].\"'";
 537         }
 538         my $fields = join ',',@fields;
 539         $text =~ s/FIELDS/$fields/;
 540         @fields = ();
 541         my @negatives;
 542         for (@_)
 543         {
 544                 if ($_->[0] and $_->[1])
 545                 {
 546                         push @fields, "'$_->[0]' => '$_->[1]'";
 547                         if ($negatives{$_->[0]})
 548                         {
 549                                 my @temp;
 550                                 my $count = 3;
 551                                 while ($count < scalar(@$_))
 552                                 {
 553                                         push @temp, "'$_->[$count]' => '$_->[$count]'";
 554                                         $count++;
 555                                 }
 556                                 push @negatives, "'$_->[0]' => array(".join(',', @temp).")";
 557                         }
 558                 }
 559         }
 560         $fields = join ',', @fields;
 561         $text =~ s/FIELDNAMES/$fields/;
 562         my $negatives = join ',', @negatives;
 563         $text =~ s/NEGATIVES/$negatives/;
 564         return $text;
 565 }
 566
 567 sub replace_sql #a special case
 568 {
 569         my $text = shift;
 570         my $replace = '';
 571         for (grep{$_->[0] and $_->[1]} @_)
 572         {
 573           $replace .= $_->[0]." TEXT,\n" if $_->[1] !~ /^date$/;
 574           $replace .= $_->[0]." DATE,\n" if $_->[1] =~ /^date$/;
 575         }
 576         $text =~ s/DATABASEFIELDS/$replace/;
 577         return $text;
 578
 579 #       my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;
 580 #       my $replace = '';
 581 #       $replace .= "$_ TEXT,\n" for @fields;
 582 #       $text =~ s/DATABASEFIELDS/$replace/;
 583 #       return $text;
 584 }
 585
 586 sub replace_view_php           #a special case  (They're all special cases aren't they? ;^ )  )
 587 {
 588         my $text = shift;
 589         $text =~ s/(<\/label>)\s?(<label>)/$1\n$2/g;            #MAKE LAYOUT MORE READABLE. NEWLINE FOR EACH <LABEL> TAG
 590         my @text = split (/\n/,$text);                          #PUT EACH LINE OF TEXT INTO AN ARRAY SPLIT ON NEWLINE (\n)
 591         my @temp = ();
 592         my $selname = "";
 593         foreach (@text)
 594         {
 595                 if ($_ =~ /<select name="(\w*)/) #SELECT NAME FOR POPUP & SCROLLING MENUS.
 596                         {
 597                           $selname = $1;
 598                           goto go;
 599                         }
 600
 601           goto go if $_ =~ s/(<textarea\sname=")([\w\s]+)("[\w\s="]*>)/$1$2$3<?php \$result = chkdata_Txt(\$obj,"$2"); echo \$result;?>/;  #TEXTAREA
 602
 603           goto go if $_ =~ s/(<input\stype="text"\s)(name=")([\w\s]+)(")([^>]*)/$1$2$3$4 value=<?php \$result = chkdata_Txt(\$obj,"$3"); echo \$result;?>/;               #TEXT
 604
 605           goto go if $_ =~ s/(<input\stype="checkbox"\sname=")([\w\s]+)(\[\])("\svalue=")([\w\s]+)(")([^>]*)/$1$2$3$4$5$6 <?php \$result = chkdata_CB(\$obj,"$2","$5"); echo \$result;?>/;   #CHECKBOX-GROUP
 606
 607           goto go if $_ =~ s/(<input\stype="checkbox"\sname=")([\w\s]+)("\svalue=")([\w\s]+)(")([^>]*)/$1$2$3$4$5 <?php \$result = chkdata_CB(\$obj,"$2","$4"); echo \$result;?>/; #CHECKBOX
 608
 609           goto go if $_ =~ s/(<input\stype="radio"\sname=")([\w\s]+)("\svalue=")([\w\s]+)(")([^>]*)/$1$2$3$4$5 <?php \$result = chkdata_Radio(\$obj,"$2","$4"); echo \$result;?>/; #RADIO-GROUP
 610
 611           goto go if $_ =~ s/(<option value=")([\w\s]+)(")/$1$2$3 <?php \$result = chkdata_PopOrScroll(\$obj,"$selname","$2"); echo \$result;?>/g; #SCROLLING-LISTS-BOTH & POPUP-MENU
 612
 613                 go:     push (@temp, $_, "\n");
 614
 615         }
 616
 617         $text = "@temp";
 618         return $text;
 619 }
 620
 621
 622 sub make_form
 623 {
 624         my @data = @_;
 625         my $return = submit(-name=>'submit form');
 626         $return .= '<br>'."\n";
 627         for (@data)
 628         {
 629                 next if not $_->[0];            #Go to next iteration of loop if no "field name"
 630                 next if $_->[0] =~ /^#/;        #ignore perl type comments
 631                 if ($_->[0] =~ /^\w/ and $_->[1])       #Check that the "field name" contains valid characters and that there is a "field type" in array iteration.
 632                 {
 633                         my $field_name = shift @$_;     #Get current field_name for iteration of array.  Shift removes it from the array and moves to next.
 634                         my $field_type = shift @$_;
 635                         my $label = $field_name;
 636                         $label =~ s/_/ /g;
 637                         $label = ucfirst($label);
 638                         $return .= "\n".'<table>'."\n\n";
 639                         if ($field_type =~ /^textfield$/)
 640                         {
 641                                 $return .= Tr(td($label),td(textfield(-name=>$field_name, -value=> join @$_)))."\n";
 642                         }
 643                         elsif ($field_type =~ /^textarea$/)
 644                         {
 645                                 $return .= Tr(td($label),td(textarea(-name=>$field_name, -rows=>4, -columns=>40, -value=> join @$_)))."\n";
 646                         }
 647                         elsif ($field_type =~ /^radio_group$/)
 648                         {
 649                                 $return .= Tr(td($label),td(radio_group(-name=>$field_name, -values=>$_, -default=>'-')))."\n";;
 650                         }
 651                         elsif ($field_type =~ /^checkbox$/)
 652                         {
 653                                 $return .= Tr(td($label),td(checkbox(-name=>$field_name, -value=>'yes', -label=> join @$_)))."\n";
 654                         }
 655                         elsif ($field_type =~ /^checkbox_group$/)
 656                         {
 657                                 $return .= Tr(td($label),td(checkbox_group(-name=>$field_name.'[]', -values=>$_)))."\n";
 658                         }
 659                         elsif ($field_type =~ /^popup_menu$/)
 660                         {
 661                                 $return .= Tr(td($label),td(popup_menu(-name=>$field_name, -values=>$_)))."\n";
 662                         }
 663                         elsif ($field_type =~ /^scrolling_list$/)
 664                         {
 665                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name, -values=>$_, -size=>scalar(@$_))))."\n";
 666                         }
 667                         elsif ($field_type =~ /^scrolling_list_multiples/)
 668                         {
 669                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name.'[]', -values=>$_, -size=>scalar(@$_), -multiple=>'true')))."\n";
 670                         }
 671                         elsif ($field_type =~ /^date$/)
 672                         {
 673 $date_field_exists = 1;
 674 $return .= <<"START";
 675 <tr><td>
 676 <span class='text'><?php xl('$label (yyyy-mm-dd): ','e') ?></span>
 677 <input type='text' size='10' name='$field_name' id='$field_name'
 678 onkeyup='datekeyup(this,mypcc)' onblur='dateblur(this,mypcc)'
 679 title='yyyy-mm-dd last date of this event' />
 680 <img src='../../../interface/pic/show_calendar.gif' align='absbottom' width='24' height='22'
 681 id='img_$field_name' border='0' alt='[?]' style='cursor:pointer'
 682 title='Click here to choose a date'>
 683 <script>
 684 Calendar.setup({inputField:'$field_name', ifFormat:'%Y-%m-%d', button:'img_$field_name'});
 685 </script>
 686 </td></tr>
 687 START
 688                         }
 689                 unshift @$_, $label;
 690                 unshift @$_, $field_type;
 691                 unshift @$_, $field_name;
 692                 $return .= "\n".'</table>'."\n";
 693                 }
 694                 else #probably an html tag or something -- Get to this point if no Field_name and Field_type found in array.
 695                 {
 696
 697                           if ($_->[0] !~ /<br>\s*$|<\/td>\s*$|<\/tr>\s*$|<\/p>\s*$/) {
 698                             $return .= '<br>'."\n";
 699                           }
 700
 701                           $return .= $_->[0]."\n";
 702
 703
 704                 }
 705         }
 706         $return .= "<table>";
 707         $return .= submit(-name=>'submit form');
 708         $return .= "</table>";
 709         return $return;
 710 }
 711
 712 #***********************************************************************************************************
 713 #**Receive 'full file path' and '$out' (finished output) from REPLACEMENT SECTION above and write to file.**
 714 #***********************************************************************************************************
 715
 716 sub to_file
 717 {
 718         my $filename = shift;
 719         my $string = shift;
 720         my $file;
 721         open $file, '>', $filename or die "cannot open $filename: $!";
 722         print $file $string;
 723         close $file or die "cannot close $filename: $!";
 724 }
 725 sub xl_fix #make compliant with translation feature
 726 {
 727         my $string = shift;
 728         return $string if $noxl;
 729         $string =~ s/>([^\s][^<>]+?)<\//> <\? xl("$1",'e') \?> <\//gs;
 730         return $string;
 731 }
 732 sub xl_fix2 #make compliant with translation feature for report.php
 733 {
 734         my $string = shift;
 735         return $string if $noxl;
 736         $string =~ s/\.(\$\w+)\./\.xl("$1")\./gs;
 737         return $string;
 738 }