contrib/forms/formmaker/formscript.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use CGI qw(:standard);
   7
   8 #file templates here
   9
  10 #documentation
  11 my $documentation =<<'START';
  12
  13 *************************************
  14 *      Form Generating Script 2.0   *
  15 *************************************
  16
  17 This is a complete rewrite of an earlier Perl script I wrote to generate
  18 forms for OpenEMR.  It is now all self contained within a single .pl file.
  19 To run at the shell command line, type:
  20
  21 Perl formscript.pl [filename]
  22
  23 where filename is a text file with data relating to your form.  If you run
  24 without a filename argument, a sample data file will be created in the same
  25 directory named 'sample.txt' that you can use to see how to create your own.
  26
  27 The first line you enter in your textfile is the name of the form.
  28 In the example this is "a1_preop_physical"
  29
  30 Basically you enter one database field item per line like this:
  31
  32 Social History::popup_menu::smoker::non-smoker
  33
  34 or
  35
  36 Social History::radio_group::smoker::non-smoker
  37
  38
  39 where the first item is the field name, the second item is the widget type, and Nth items are values.
  40 spaces within the name will convert to '_'
  41 for the sql database field name.  If you use a SQL reserved word, the form generation
  42 will fail and this program will notify you of the word(s) you used.
  43
  44 The '::' is the standard delimiter that I use between items.  The second item on the line
  45 is the form widget type.  You can choose from:
  46
  47 textfield
  48 textarea
  49 checkbox
  50 checkbox_group
  51 radio_group
  52 popup_menu
  53 scrolling_list
  54 scrolling_list_multiples
  55
  56 Putting a '+' at the beginning of the field name will let the form know that you want to
  57 report negatives.  This means the following:
  58
  59 +cardiac_review::checkbox_group::chest pain::shortness of breath::palpitations
  60
  61 creates a group of checkboxes where if the user chooses the first two boxes, the database will
  62 have the following line entered:
  63
  64 chest pain, shortness of breath.  Negative for palpitations.
  65
  66 The remaining items after the fieldname and the widget type  are the names for
  67 checkboxes or radio buttons or default text
  68 for a textfield or text area.  You can also start a line with a '#' as the first character and this
  69 will be an ignored comment line.  If you put html tags on their own lines, they will be integrated
  70 into the form.  It will be most helpful to look at 'sample.txt' to see how this works.
  71
  72 This is 1.1 and is tested to the extent of installing the form and entering data within an encounter.
  73 Please send feedback to mail@doc99.com.  I will definitely
  74 be fixing and improving it.
  75
  76 Mark Leeds
  77
  78
  79 START
  80
  81 #info.txt
  82 my $info_txt=<<'START';
  83 FORM_NAME
  84 START
  85
  86 #new.php
  87 my $new_php =<<'START';
  88 <?php
  89 include_once("../../globals.php");
  90 include_once("$srcdir/api.inc");
  91 formHeader("Form: FORM_NAME");
  92 ?>
  93 <html><head>
  94 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
  95 </head>
  96 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
  97 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="FORM_NAME" onsubmit="return top.restoreSession()">
  98 <hr>
  99 <h1> FORM_NAME </h1>
 100 <hr>
 101 DATABASEFIELDS
 102 </form>
 103 <?php
 104 formFooter();
 105 ?>
 106 START
 107
 108 #print.php
 109 my $print_php=<<'START';
 110 <?php
 111 include_once("../../globals.php");
 112 include_once("$srcdir/api.inc");
 113 formHeader("Form: FORM_NAME");
 114 ?>
 115 <html><head>
 116 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 117 </head>
 118 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 119 <form method=post action="<?echo $rootdir;?>/forms/FORM_NAME/save.php?mode=new" name="my_form" onsubmit="return top.restoreSession()">
 120 <h1> FORM_NAME </h1>
 121 <hr>
 122 DATABASEFIELDS
 123 </form>
 124 <?php
 125 formFooter();
 126 ?>
 127 START
 128
 129 #report.php
 130 my $report_php=<<'START';
 131 <?php
 132 //------------report.php
 133 include_once("../../globals.php");
 134 include_once($GLOBALS["srcdir"]."/api.inc");
 135 function FORM_NAME_report( $pid, $encounter, $cols, $id) {
 136 $count = 0;
 137 $data = formFetch("form_FORM_NAME", $id);
 138 if ($data) {
 139 print "<table><tr>";
 140 foreach($data as $key => $value) {
 141 if ($key == "id" || $key == "pid" || $key == "user" || $key == "groupname" || $key == "authorized" || $key == "activity" || $key == "date" || $value == "" || $value == "0000-00-00 00:00:00") {
 142         continue;
 143 }
 144 if ($value == "on") {
 145 $value = "yes";
 146 }
 147 $key=ucwords(str_replace("_"," ",$key));
 148 print "<td><span class=bold>$key: </span><span class=text>".stripslashes($value)."</span></td>";
 149 $count++;
 150 if ($count == $cols) {
 151 $count = 0;
 152 print "</tr><tr>\n";
 153 }
 154 }
 155 }
 156 print "</tr></table>";
 157 }
 158 ?>
 159 START
 160
 161 #save.php
 162 my $save_php=<<'START';
 163 <?php
 164 //------------This file inserts your field data into the MySQL database
 165 include_once("../../globals.php");
 166 include_once("$srcdir/api.inc");
 167 include_once("$srcdir/forms.inc");
 168
 169 //process form variables here
 170 //create an array of all of the existing field names
 171 $field_names = array(FIELDNAMES);
 172 $negatives = array(NEGATIVES);
 173 //process each field according to it's type
 174 foreach($field_names as $key=>$val)
 175 {
 176         if ($val == "checkbox")
 177         {
 178                 if ($_POST[$key]) {$field_names[$key] = "yes";}
 179                 else {$field_names[$key] = "negative";}
 180         }
 181         elseif (($val == "checkbox_group")||($val == "scrolling_list_multiples"))
 182         {
 183                 $neg = '';
 184                 if (array_key_exists($key,$negatives)) #a field requests reporting of negatives
 185                 {
 186                         foreach($_POST[$key] as $pos) #check positives against list
 187                         {
 188                                 if (array_key_exists($pos, $negatives[$key]))
 189                                 {       #remove positives from list, leaving negatives
 190                                         unset($negatives[$key][$pos]);
 191                                 }
 192                         }
 193                         $neg = ".   Negative for ".implode(',',$negatives[$key]);
 194                 }
 195                 $field_names[$key] = implode(',',$_POST[$key]).$neg;
 196         }
 197         else
 198         {
 199                 $field_names[$key] = $_POST[$key];
 200         }
 201 }
 202
 203 //end special processing
 204
 205 foreach ($field_names as $k => $var) {
 206 $field_names[$k] = mysql_escape_string($var);
 207 echo "$var\n";
 208 }
 209 if ($encounter == "")
 210 $encounter = date("Ymd");
 211 if ($_GET["mode"] == "new"){
 212 $newid = formSubmit("form_FORM_NAME", $field_names, $_GET["id"], $userauthorized);
 213 addForm($encounter, "FORM_NAME", $newid, "FORM_NAME", $pid, $userauthorized);
 214 }elseif ($_GET["mode"] == "update") {
 215
 216
 217 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");
 218 }
 219 $_SESSION["encounter"] = $encounter;
 220 formHeader("Redirecting....");
 221 formJump();
 222 formFooter();
 223 ?>
 224 START
 225
 226 #table.sql
 227 my $table_sql=<<'START';
 228 CREATE TABLE IF NOT EXISTS `form_FORM_NAME` (
 229 id bigint(20) NOT NULL auto_increment,
 230 date datetime default NULL,
 231 pid bigint(20) default NULL,
 232 user varchar(255) default NULL,
 233 groupname varchar(255) default NULL,
 234 authorized tinyint(4) default NULL,
 235 activity tinyint(4) default NULL,
 236 DATABASEFIELDS
 237 PRIMARY KEY (id)
 238 ) TYPE=MyISAM;
 239 START
 240
 241 #view.php
 242 my $view_php =<<'START';
 243 <!-- view.php -->
 244 <?php
 245 include_once("../../globals.php");
 246 include_once("$srcdir/api.inc");
 247 formHeader("Form: FORM_NAME");
 248 $obj = formFetch("form_FORM_NAME", $_GET["id"]);  #Use the formFetch function from api.inc to get values for existing form.
 249
 250 function chkdata_Txt(&$obj, $var)
 251     {
 252         $result = stripslashes($obj{"$var"});
 253         return $result;
 254     }
 255  function chkdata_CB(&$obj, $nam, $var)
 256     {
 257         $objarr = explode(',',$obj{$nam});
 258         foreach ($objarr as $a)
 259                 {
 260                         if ($a == "$var")
 261                                 {
 262                                         $result = "\"checked\"";
 263                                         }
 264                 }
 265         return $result;
 266     }
 267  function chkdata_Radio(&$obj, $nam, $var)
 268     {
 269         if ($obj{$nam}== "$var")
 270                 {
 271                         $result = "\"checked\"";
 272                         }
 273         return $result;
 274     }
 275  function chkdata_PopOrScroll(&$obj, $nam, $var)
 276     {
 277         $objarr = explode(',',$obj{$nam});
 278         foreach ($objarr as $a)
 279                 {
 280                         if ($a == "$var")
 281                                 {
 282                                         $result = "\"selected\"";
 283                                         }
 284                 }
 285         return $result;
 286     }
 287
 288 ?>
 289 <html><head>
 290 <link rel=stylesheet href="<?echo $css_header;?>" type="text/css">
 291 </head>
 292 <body <?echo $top_bg_line;?> topmargin=0 rightmargin=0 leftmargin=2 bottommargin=0 marginwidth=2 marginheight=0>
 293 <form method=post action="<?echo $rootdir?>/forms/FORM_NAME/save.php?mode=update&id=<?echo $_GET["id"];?>" name="my_form" onsubmit="return top.restoreSession()">
 294 <h1> FORM_NAME </h1>
 295 <hr>
 296 DATABASEFIELDS
 297
 298 </form>
 299 <?php
 300 formFooter();
 301 ?>
 302 START
 303
 304 #preview.html
 305 my $preview_html =<<'START';
 306 <html><head>
 307 </head>
 308 <body>
 309 <form>
 310 <hr>
 311 <h1> FORM_NAME </h1>
 312 <hr>
 313 DATABASEFIELDS
 314 </form>
 315 </body>
 316 </html>
 317 START
 318
 319 #sample.txt
 320 my $sample_txt =<<'START';
 321 a1_preop_physical
 322
 323 chief_complaints::textarea
 324
 325 <h3>past surgical history</h3>
 326 +surgical history::checkbox_group::cholecystectomy::tonsillectomy::apendectomy
 327 <h4>other</h4>
 328 surgical history other::textfield
 329
 330 <h3>past surgical history</h3>
 331 +medical history::scrolling_list_multiples::asthma::diabetes::hypertension
 332 <h4>other</h4>
 333 medical history other::textfield
 334
 335 <h2>Allergies</h2>
 336 +allergies::checkbox_group::penicillin::sulfa::iodine
 337 <h4>other</h4>
 338 allergies other::textfield
 339
 340 <h2>Social History</h2>
 341 <h3>smoking</h3>
 342 smoke history::radio_group::non-smoker::smoker
 343 <h3>alcohol</h3>
 344 etoh history::scrolling_list::none::occasional::daily::heavy use
 345 START
 346
 347 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');
 348 my %reserved;
 349 $reserved{$_}++ for @reserved;     # Shortened syntax for assigning value of 1 to each associative element in array.
 350                                              # IE:  UNLOCK = 1, WRITE = 1, ETC... Associative array.
 351
 352
 353
 354
 355 #*********************************************************************************
 356 #******************************** MAIN PROGRAM ***********************************
 357 #*********************************************************************************
 358
 359 if (@ARGV == 0)
 360 {
 361         to_file('sample.txt',$sample_txt) if not -f 'sample.txt';
 362         print $documentation."\n";
 363         exit 0;
 364 }
 365
 366 my $form_name = <>;
 367 chomp($form_name);
 368 my $compare = $form_name;
 369 $compare =~ tr/[a-z]/[A-Z]/;
 370 if ($reserved{$compare})
 371 {
 372         print "You have chosen an SQL reserved word for your form name: $form_name.  Please try again.\n";
 373         exit 1;
 374 }
 375 $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.
 376 $form_name =~ s/\s+/_/g;                #Substitute all blank spaces with _ globally --> g means globally.
 377 if (! -e $form_name)
 378 {
 379         mkdir "$form_name" or die "Could not create directory $form_name: $!";
 380 }
 381 my @field_data;                                                                                  #the very important array of field data
 382 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.
 383 my %negatives;               #key=field name: these are the fields that require reporting of pertinant
 384                                      #negatives.  will only apply to checkbox_group and scrolling_list_multiples types
 385 my @reserved_used;
 386 #strip outer spaces from field names and field types and change inner spaces to underscores
 387 #and check field names for SQL reserved words now
 388 for (@field_data)
 389 {
 390         if ($_->[0] and $_->[1])        #$_->[0] is field name and $_->[1] is field type.  IE:  @field_data[4]->[0] and @field_data[4]->[1]
 391         {
 392                 $_->[0] =~ s/^\s+(\S)\s+$/$1/;        #\s means spaces, \S means non spaces. (\S) creates backreference pointed to by $1 at end. ***FIELD NAME***
 393                 $_->[0] = lc $_->[0];           #MAKE SURE FIELNAMES ARE ALL LOWERCASE (to avoid problems later)
 394                 $_->[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"
 395                 push @reserved_used, $_->[0] if $reserved{$_->[0]};
 396                 $_->[1] =~ s/^\s+(\S)\s+$/$1/;
 397                 if ($_->[0] =~ /^\+/) #a leading '+' indicates to print negatives
 398                 {               # or not checked values in a checkbox_group or scrolling_list_multiples
 399                         $_->[0] =~ s/^\+(.*)/$1/;
 400                         $negatives{$_->[0]}++;      #Shortened syntax for putting $field_name, 1 into "negatives" associative array.
 401                                                             #Same as %negatives = (%negatives, $_->[0], 1)
 402                 }
 403         }
 404 }
 405 if (@reserved_used)
 406 {
 407         print "You have chosen the following reserved words as field names.  Please try again.\n";
 408         print "$_\n" for @reserved_used;
 409         exit 1;
 410 }
 411
 412
 413
 414 #****************************************************************************
 415 #**Send field data to the Make_form subroutine and receive it back as $text**
 416 #****************************************************************************
 417
 418 my $make_form_results = make_form(@field_data);
 419 my $out;
 420
 421
 422
 423 #***************************************************************************
 424 #**************************REPLACEMENT SECTION******************************
 425 #***************************************************************************
 426 #***This section replaces the 'PLACE_HOLDERS' in the $whatever.php above.***
 427 #***$text holds the results from the "make_form" subroutine below.       ***
 428 #***************************************************************************
 429
 430
 431 #info.txt
 432 $out = replace($info_txt, 'FORM_NAME', $form_name); #Custom delcared sub 3 parameters
 433 to_file("$form_name/info.txt",$out);
 434
 435 #new.php
 436 $out = replace($new_php, 'FORM_NAME', $form_name);
 437 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 438 to_file("$form_name/new.php",$out);
 439
 440 #print.php
 441 $out = replace($print_php, 'FORM_NAME', $form_name);
 442 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 443 to_file("$form_name/print.php",$out);
 444
 445 #report.php
 446 $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
 447 $out = replace($out, 'DATABASEFIELDS', $make_form_results);             #Then replace 'DATABASEFIELDS' in 'whatever_php' with $make_form_results, generated from make_form subroutine.
 448 to_file("$form_name/report.php",$out);
 449
 450 #save.php
 451 $out = replace($save_php, 'FORM_NAME', $form_name);
 452 $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")
 453 to_file("$form_name/save.php",$out);
 454
 455 #view.php
 456 $out = replace($view_php, 'FORM_NAME', $form_name);
 457 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 458 $out = replace_view_php($out);
 459 to_file("$form_name/view.php",$out);
 460
 461 #table.sql
 462 $out = replace($table_sql, 'FORM_NAME', $form_name);
 463 $out = replace_sql($out, @field_data);
 464 to_file("$form_name/table.sql",$out);
 465
 466 #preview.html
 467 $out = replace($preview_html, 'FORM_NAME', $form_name);
 468 $out = replace($out, 'DATABASEFIELDS', $make_form_results);
 469 to_file("$form_name/preview.html",$out);
 470
 471
 472
 473
 474 #******************************************************************
 475 #************************* SUB-ROUTINES ***************************
 476 #******************************************************************
 477
 478 sub replace
 479 {
 480         my $text = shift;  #This shifts through the supplied arguments ($whatever_php, 'FORM_NAME', and $form_name)
 481                                 #This $text is a LOCAL variable.  Does not overwrite other $make_form_results
 482                                 #Shift starts with the first value.  If variable (as in $whatever_php) expands and goes through line by line
 483         my %words = @_;
 484         $text =~ s/$_/$words{$_}/g for keys %words;
 485         return $text;
 486 }
 487
 488
 489 sub replace_save_php #a special case
 490 {
 491         my $text = shift;
 492         my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;  #Checks to see that Field_name and Field_type exist --Grep statement and map to @array.
 493         for (@fields)
 494         {
 495                  $_ = "$_='\".\$field_names[\"$_\"].\"'";
 496         }
 497         my $fields = join ',',@fields;
 498         $text =~ s/FIELDS/$fields/;
 499         @fields = ();
 500         my @negatives;
 501         for (@_)
 502         {
 503                 if ($_->[0] and $_->[1])
 504                 {
 505                         push @fields, "'$_->[0]' => '$_->[1]'";
 506                         if ($negatives{$_->[0]})
 507                         {
 508                                 my @temp;
 509                                 my $count = 2;
 510                                 while ($count < scalar(@$_))
 511                                 {
 512                                         push @temp, "'$_->[$count]' => '$_->[$count]'";
 513                                         $count++;
 514                                 }
 515                                 push @negatives, "'$_->[0]' => array(".join(',', @temp).")";
 516                         }
 517                 }
 518         }
 519         $fields = join ',', @fields;
 520         $text =~ s/FIELDNAMES/$fields/;
 521         my $negatives = join ',', @negatives;
 522         $text =~ s/NEGATIVES/$negatives/;
 523         return $text;
 524 }
 525
 526 sub replace_sql #a special case
 527 {
 528         my $text = shift;
 529         my @fields = map {$_->[0]} grep{$_->[0] and $_->[1]} @_;
 530         my $replace = '';
 531         $replace .= "$_ TEXT,\n" for @fields;
 532         $text =~ s/DATABASEFIELDS/$replace/;
 533         return $text;
 534 }
 535
 536 sub replace_view_php           #a special case  (They're all special cases aren't they? ;^ )  )
 537 {
 538         my $text = shift;
 539         $text =~ s/(<\/label>)\s?(<label>)/$1\n$2/g;            #MAKE LAYOUT MORE READABLE. NEWLINE FOR EACH <LABEL> TAG
 540         my @text = split (/\n/,$text);                          #PUT EACH LINE OF TEXT INTO AN ARRAY SPLIT ON NEWLINE (\n)
 541         my @temp = ();
 542         my $selname = "";
 543         foreach (@text)
 544         {
 545                 if ($_ =~ /<select name="(\w*)/) #SELECT NAME FOR POPUP & SCROLLING MENUS.
 546                         {
 547                           $selname = $1;
 548                           goto go;
 549                         }
 550
 551           goto go if $_ =~ s/(<textarea\sname=")([\w\s]+)("[\w\s="]*>)/$1$2$3<?php \$result = chkdata_Txt(\$obj,"$2"); echo \$result;?>/;  #TEXTAREA
 552
 553           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
 554
 555           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
 556
 557           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
 558
 559           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
 560
 561           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
 562
 563                 go:     push (@temp, $_, "\n");
 564
 565         }
 566
 567         $text = "@temp";
 568         return $text;
 569 }
 570
 571
 572 sub make_form
 573 {
 574         my @data = @_;
 575         my $return = submit(-name=>'submit form');
 576         $return .= '<br>'."\n";
 577         for (@data)
 578         {
 579                 next if not $_->[0];            #Go to next iteration of loop if no "field name"
 580                 next if $_->[0] =~ /^#/;        #ignore perl type comments
 581                 if ($_->[0] =~ /^\w/ and $_->[1])       #Check that the "field name" contains valid characters and that there is a "field type" in array iteration.
 582                 {
 583                         my $field_name = shift @$_;     #Get current field_name for iteration of array.  Shift removes it from the array and moves to next.
 584                         my $field_type = shift @$_;
 585                         my $label = $field_name;
 586                         $label =~ s/_/ /g;
 587                         $label = ucfirst($label);
 588                         $return .= "\n".'<table>'."\n\n";
 589                         if ($field_type =~ /^textfield$/)
 590                         {
 591                                 $return .= Tr(td($label),td(textfield(-name=>$field_name, -value=> join @$_)))."\n";
 592                         }
 593                         elsif ($field_type =~ /^textarea$/)
 594                         {
 595                                 $return .= Tr(td($label),td(textarea(-name=>$field_name, -rows=>4, -columns=>40, -value=> join @$_)))."\n";
 596                         }
 597                         elsif ($field_type =~ /^radio_group$/)
 598                         {
 599                                 $return .= Tr(td($label),td(radio_group(-name=>$field_name, -values=>$_, -default=>'-')))."\n";;
 600                         }
 601                         elsif ($field_type =~ /^checkbox$/)
 602                         {
 603                                 $return .= Tr(td($label),td(checkbox(-name=>$field_name, -value=>'yes', -label=> join @$_)))."\n";
 604                         }
 605                         elsif ($field_type =~ /^checkbox_group$/)
 606                         {
 607                                 $return .= Tr(td($label),td(checkbox_group(-name=>$field_name.'[]', -values=>$_)))."\n";
 608                         }
 609                         elsif ($field_type =~ /^popup_menu$/)
 610                         {
 611                                 $return .= Tr(td($label),td(popup_menu(-name=>$field_name, -values=>$_)))."\n";
 612                         }
 613                         elsif ($field_type =~ /^scrolling_list$/)
 614                         {
 615                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name, -values=>$_, -size=>scalar(@$_))))."\n";
 616                         }
 617                         elsif ($field_type =~ /^scrolling_list_multiples/)
 618                         {
 619                                 $return .= Tr(td($label),td(scrolling_list(-name=>$field_name.'[]', -values=>$_, -size=>scalar(@$_), -multiple=>'true')))."\n";
 620                         }
 621                 unshift @$_, $label;
 622                 unshift @$_, $field_type;
 623                 unshift @$_, $field_name;
 624                 $return .= "\n".'</table>'."\n";
 625                 }
 626                 else #probably an html tag or something -- Get to this point if no Field_name and Field_type found in array.
 627                 {
 628
 629                           if ($_->[0] !~ /<br>\s*$|<\/td>\s*$|<\/tr>\s*$|<\/p>\s*$/) {
 630                             $return .= '<br>'."\n";
 631                           }
 632
 633                           $return .= $_->[0]."\n";
 634
 635
 636                 }
 637         }
 638         $return .= "<table>";
 639         $return .= submit(-name=>'submit form');
 640         $return .= "</table>";
 641         return $return;
 642 }
 643
 644 #***********************************************************************************************************
 645 #**Receive 'full file path' and '$out' (finished output) from REPLACEMENT SECTION above and write to file.**
 646 #***********************************************************************************************************
 647
 648 sub to_file
 649 {
 650         my $filename = shift;
 651         my $string = shift;
 652         my $file;
 653         open $file, '>', $filename or die "cannot open $filename: $!";
 654         print $file $string;
 655         close $file or die "cannot close $filename: $!";
 656 }