#!/usr/local/bin/perl 

&PrintHeader;
&ReadParse;

sub ReadParse {
  local (*n) = @_ if @_;
  local ($i, $key, $val);
if (&MethGet) {
    $in = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
  read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
}
#print '$in= ', $in, "/n/n/n", '<p>';
@in = split(/&/, $in);
foreach $i (0 .. $#in) {
  $in[$i] =~ s/\+/ /g;
  ($key, $val) = split(/=/, $in[$i],2);
  $key =~ s/%(..)/pack("c",hex($1))/ge;
  $val =~ s/%(..)/pack("c",hex($1))/ge;
  $in{$key} .= "\0" if (defined($in{$key}));
  $in{$key} .= $val;
  }

($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time());
$file_name = $in{"file_name"};

foreach $key(sort (keys %in)) {
#print '$in{$key} = ', $in{$key}, "\n", '<br>';
  $column_constraint{$key} = $in{$key} if ($in{$key}=~/[\w]/ && $key=~/column_constraint[0-9]+/);
  $column_constraint_input{$key} = $in{$key} if ($in{$key}=~/[\w]/ && $key=~/column_constraint_input[0-9]+/);
  $column_description{$key} = $in{$key} if ($in{$key}=~/[\w]/ && $key=~/column_description[0-9]+/);
  $column_name{$key} = $in{$key} if ($in{$key}=~/[\w]/ && $key=~/column_name[0-9]+/);
  $column_type{$key} = $in{$key} if ($in{$key}=~/[\w]/ && $key=~/column_type[0-9]+/); 
  $column_type_num{$key} = $in{$key} if ($in{$key}=~/[\w]/ && $key=~/column_type_num[0-9]+/);
  $column_type_num_input{$key} = $in{$key} if ($in{$key}=~/[\w]/ && $key=~/column_type_num_input[0-9]+/); 
#  print $key, ' = ', $in{$key}, "\n", '<br>';
}
print '%column_constraint = ', %column_constraint, "<br>\n";
print %column_constraint_input, "\n";
print %column_description, "\n";
print %column_name, "\n";
print %column_type, "\n";
print %column_type_num, "\n";
print %column_type_num_input, "\n";



  open (WRITE_PACKAGE, ">/home/B11B/jguo/car/tmp/$file_name\.sql")||die("Can't open file: zualum-text.html");
  open (WRITE_TABLE, ">/home/B11B/jguo/car/tmp/$file_name\_table.sql")||die("Can't open file: zualum-link.html");
  open (WRITE_HTML, ">/home/B11B/jguo/car/tmp/$file_name\.html")||die("Can't open file: zualum-info.html");

  
  write (WRITE_PACKAGE);
  write (WRITE_TABLE);
  write (WRITE_HTML);

  close (WRITE_PACKAGE);
  close (WRITE_TABLE);
  close (WRITE_HTML);
  
  print 'PulsarTool has created a new database application. ';
  print "<li><a href=\"/osprey7/$file_name\.sql\"> $file_name\.sql<br>";
  print "<li><a href=\"/osprey7/$file_name\_table.sql\"> $file_name\_table.sql<br>";
  print "<li><a href=\"/osprey7/$file_name\.html\"> $file_name\.html<br>";

  return length($in);
}

sub PrintHeader {
#   return "Content-type: text/html\n\n";
    print "Content-type: text/html\n\n";
}

sub MethGet {
  return ($ENV{'REQUEST_METHOD'} eq "GET");
}

sub print_arguments {
  $result = "";
  $i = 0;
  foreach $key (sort keys%column_name) {
    $i = $i + 1;
    $key =~ /^\D+(\d+)$/;
    $column_name = $column_name{$key};
    $column_type = $column_type{"column_type$1"};
    $comma = ",\n    "; 
    $comma = "" if ($i =~ /^1$/);
    $result .= "$comma\i$column_name in $column_type";
  }
  return $result;
}

sub print_columns {
  local($space_num) = @_;
  local($j);
  $j = 0;
  foreach $key (sort keys%column_name) {
    $j = $j + 1;
    $key =~ /^\D+(\d+)$/;
    $column_constraint = $column_constraint{"column_constraint$1"};
    $column_constraint_input = $column_constraint_input{"column_constraint_input$1"};
    $column_description = $column_description{"column_description$1"};
    $column_name = $column_name{$key};
    $column_type = $column_type{"column_type$1"};
    $column_type_num = $column_type_num{"column_type_num$1"};
    $column_type_num_input = $column_type_num_input{"column_type_num_input$1"};

    $column_type_num = $column_type_num_input if defined($column_type_num_input); 
    $column_constraint = $column_constraint_input if defined($column_constraint_input); 
    $comma = ","; 
    $comma = "" if ($j = length(%column_name) );
#print(length(%column_name)."IIIIII$j");    
    $result2 .= "$column_name\t$column_type";
    $result2 .= "($column_type_num)" || ($column_type_num =~/^[0-9]+$/);
    $result2 .= " $column_constraint" || ($column_constraint =~/^\w+$/);
    $result2 .= "$comma\t-- $column_description\n"." " x $space_num;
  }
  return $result2;
}

sub print_insert {
  local($space_num) = @_;
  $i = 0;  
  $result1 = "";
  foreach $key (sort keys%column_name) {
    $i = $i + 1;
    $key =~ /^\D+(\d+)$/;
    $column_name = $column_name{$key};
    $column_type = $column_type{"column_type$1"};
    $comma = ",\n"." " x $space_num;
    $comma = " " x $space_num if ($i =~ /^1$/);
    $result1 .= "$comma\iorow.$column_name";
  }
  return $result1;
}

sub print_update {
  local($space_num) = @_;
  $i = 0;
  $result1 = "";
  foreach $key (sort keys%column_name) {
    $i = $i + 1;
    $key =~ /^\D+(\d+)$/;
    $column_name = $column_name{$key};
    $column_type = $column_type{"column_type$1"};
    $comma = ",\n"." " x $space_num;
    $comma = " " x $space_num if ($i =~ /^1$/);
    $result1 .= "$comma$column_name = iorow.$column_name";
  }
  return $result1;
}

sub print_insert_action {
  local($space_num) = @_;
  $result1 = "";
  $comma = "";
  $i = 0;
  foreach $key (sort keys%column_name) {
    $i = $i + 1;
    $key =~ /^\D+(\d+)$/;
    $column_name = $column_name{$key};
    $column_type = $column_type{"column_type$1"};
    $comma = ";\n"." " x $space_num;
    $comma = ";"." " x $space_num if ($i =~ /^1$/);
    $result1 .= "this_row.$column_name := i$column_name";
    $result1 .= "$comma";
  }
  return $result1;
}

sub print_search_page {
   $result1 = "";
  foreach $key (sort keys%column_name) {
    $key =~ /^\D+(\d+)$/;
    $column_name = $column_name{$key};
    $column_description = $column_description{"column_description$1"};
    $result1 .= "\n    htp.p(\'<tr>\');";
    $result1 .= "\n    htp.p(\'<th>$column_description</\th>\');";
    $result1 .= "\n    htp.p(\'<td>\'||this_row.$column_name\||\'</\td>\');";
    $result1 .= "\n    htp.p(\'</\tr>\');";
  }
  return $result1;
}

sub print_insert_page {
   $result1 = "";
   foreach $key (sort keys%column_name) {
    $key =~ /^\D+(\d+)$/;
    $column_name = $column_name{$key};
    $column_description = $column_description{"column_description$1"};
    $result1 .= "\n    htp.p(\'<tr>\');";
    $result1 .= "\n    htp.p(\'<th>$column_description<//th>\');";
    $result1 .= "\n    htp.p(\'<td> <input type=\"text\" size=50 name=\"i$column_name\" value=\"\"><//td>\');";
    $result1 .= "\n    htp.p(\'<//tr>\');";
  }
  return $result1;
}

sub print_update_page {
  $result1 = "";
  foreach $key (sort keys%column_name) {
    $key =~ /^\D+(\d+)$/;
    $column_name = $column_name{$key};
    $column_description = $column_description{"column_description$1"};
    $result1 .= "\n    htp.p(\'<tr>\');";
    $result1 .= "\n    htp.p(\'<th>$column_description</\th>\');";
    $result1 .= "\n    htp.p(\'<td> <input type=\"text\" size=50 name=\"i$column_name\""; 
    $result1 .= " value=\"\'||this_row.$column_name\||\'\"></\td>\');";
    $result1 .= "\n    htp.p(\'</\tr>\');";
  }
  return $result1;
}

format WRITE_PACKAGE =
--************************************************************
--*    This file is created by NPAC PL/SQL Module Creator    *
--*    on @>/@|/@< @>:@|:@<.                                 *
        $mon $mday $year $hour $min $sec                 
--*    Contact jguo@npac.syr.edu for more information.       *  
                  '@'                   
--************************************************************

------------------------------------------------------------
----  drop previous version of the package              ----
------------------------------------------------------------

drop package @*
             "$file_name\;"
/

----------------------------------------------------  
create or replace package @*
                          "$file_name is"  
----------------------------------------------------  
  procedure rm (
    iid in varchar2
  );
  
  function get (
    iid in varchar2
  ) return @*
           "$file_name\_table\%rowtype;"
	   
  procedure put (
    iorow in out @*
                 "$file_name\_table\%rowtype"
  );
  
  function new (
    iorow in out @*
                 "$file_name\_table\%rowtype"
  ) return @*
           "$file_name\_table.id\%type;"
	   
  function next (
    iorow in out @*
                 "$file_name\_table\%rowtype"
  ) return boolean;
  
  procedure insert_action (
    @*
    &print_arguments
  );
  
  procedure update_action (
    @*
    &print_arguments
  );
  
  procedure delete_action (
    iid in varchar2
  ); 
  
  procedure search_page (
    iid in varchar2
  );  
  
  procedure insert_page;  

  procedure update_page (
    iid in varchar2
  );  

  procedure delete_page (
    iid in varchar2
  );  

  procedure echo_page ( 
    iid in varchar2, 
    iaction in varchar2
  );  

 procedure print_error (
    iwhere in varchar2,
    imessage in varchar2
  );

end;  
/
show errors;
/

---------------------------------------------------------  
create or replace package body @*
                               "$file_name is"  
---------------------------------------------------------  
  this_row @*
       "$file_name\_table\%rowtype;"
  cursor all_row is select * from @*
                               "$file_name\_table order by day;"

  procedure rm (
    iid in varchar2
  ) is
  begin
    delete from @*
                "$file_name\_table" 
      where id = iid;
    exception
      when no_data_found then
        raise;
      when others then
        print_error('rm', sqlerrm(sqlcode) );
  end;

  function get (
    iid in varchar2
  ) return @*
           "$file_name\_table\%rowtype is"
    cursor c (
      this_id varchar2
    ) is
      select * from @*
                    "$file_name\_table the"
      where the.id = this_id;
  begin
    open c (iid);
    fetch c into this_row;
    if c%notfound then
      raise no_data_found;
    end if;
    close c;
    return this_row;
    exception
      when no_data_found then
        raise;
      when others then
        print_error('get', sqlerrm(sqlcode) );
  end;

  procedure put(
    iorow in out @*
                 "$file_name\_table\%rowtype) is"
    cursor c (
      this_id varchar2
    ) is
      select * from @*
                    "$file_name\_table"
        where id = this_id;
  begin
    if (iorow.id is null) then
      select @*
             "$file_name\_seq.nextval into iorow.id"
        from dual;
      insert into @*
                  "$file_name\_table"
        values (
          @*
          &print_insert(10);
        );
    else
      open c(iorow.id);
      fetch c into this_row;
      if c%found then
        update  @*
                "$file_name\_table set"
          @*
          &print_update(10);
          where id = iorow.id;
      else
        raise no_data_found;
      end if;
      close c;
    end if;
    exception
      when no_data_found then
        raise;
      when others then
        print_error('put', sqlerrm(sqlcode) );
  end;

  function new (
    iorow in out @*
                 "$file_name\_table\%rowtype"
  ) return @*
           "$file_name\_table.id\%type is"
  begin
    iorow.id := null;
    put(iorow);
    return iorow.id;
    exception
      when no_data_found then
        raise;
      when others then
        print_error('new', sqlerrm(sqlcode) );
  end;

  function next (
    iorow in out @*
                 "$file_name\_table\%rowtype"
  ) return boolean is
  begin
    if not all_row%isopen then
      open all_row;
    end if;
    fetch all_row into iorow;
    if all_row%notfound then
      close all_row;     
      return false;
    else
      return true;
    end if;
  exception
    when others then
        print_error('next', sqlerrm(sqlcode) );
  end;

  procedure insert_action (
    @*
    &print_arguments 
  ) is
  begin
    @*
    &print_insert_action(4)
    this_row.id := new(this_row);
    echo_page(this_row.id, 'inserted');
    exception
      when others then
        print_error('insert_action', sqlerrm(sqlcode) );
  end;  

  procedure update_action (
    @*
    &print_arguments 
  ) is
  begin  
    @*
    &print_insert_action(4)
    put(this_row);
    echo_page(this_row.id, 'updated');
    exception
      when others then
        print_error('update_action', sqlerrm(sqlcode) );
  end;  

  procedure delete_action ( 
    iid in varchar2
  ) is
  begin  
    this_row.id := iid;
    rm(iid);
    echo_page(this_row.id, 'deleted');
    exception
      when others then
        print_error('delete_action', sqlerrm(sqlcode) );
  end;  

  procedure search_page (
    iid in varchar2
  ) is  
  begin 
    select * into this_row 
      from @*
           "$file_name\_table"
      where id = iid;
    htp.p('<table border=1>');
    @*
    &print_search_page
    htp.p('</table>');
    exception
      when others then
        print_error('search_page', sqlerrm(sqlcode) );
  end;  

  procedure insert_page is  
  begin  
    htp.p('<html>');
    htp.p('<body>');
    htp.p('<h2>Insert Rrecord: </h2>');
    htp.p('<form action="/cgi-bin/wow/@*
                                      "$file_name\.insert_action\" method=\"POST\">');"
    htp.p('<table border=1>');
    @*
    &print_insert_page
    htp.p('</table>');
    htp.p('<input type="submit" value="Submit">');
    htp.p('</form>');
    htp.p('</body>');
    htp.p('</html>');
    exception
      when others then
        print_error('insert_page', sqlerrm(sqlcode) );
  end;  

  procedure update_page (
    iid in varchar2
  ) is  
   begin  
   select * into this_row 
      from @*
           "$file_name\_table"
      where id = iid;
    htp.p('<html>');
    htp.p('<body>');
    htp.p('<h2>Update Record:</h2>');
    htp.p('<form action="/cgi-bin/wow/@*
                                      "$file_name\.update_action\"\ method=\"POST\">');"
    htp.p('<table border=1>');
    @*
    &print_update_page
    htp.p('</table>');
    htp.p('<input type="submit" value="Submit">');
    htp.p('</form>');
    htp.p('</body>');
    htp.p('</html>');
    exception
      when others then
        print_error('update_page', sqlerrm(sqlcode) );
  end;  

  procedure delete_page (
    iid in varchar2
  ) is  
  begin  
    htp.p('<html>');
    htp.p('<body>');
    htp.p('<form action="/cgi-bin/wow/@*
                                     "$file_name\.delete_action\" method=\"POST\">');"
    htp.p('<input type="hidden" name="iid" value="'|| iid ||'">');
    htp.p('<h2>Are you sure to delete this record below?</h2>');
    htp.p('<input type="submit" value="Delete">');
    search_page(this_row.id);
    htp.p('</form>');
    htp.p('</body>');
    htp.p('</html>');
    exception
      when others then
        print_error('delete_page', sqlerrm(sqlcode) );
  end;  

  procedure echo_page (
    iid in varchar2, 
    iaction in varchar2
  ) is  
  begin  
   htp.p('<head>');
   htp.p('</head>');
   htp.p('<body>');
   htp.p('<h1>The following record has been '|| iaction || '</h1>'); 
   search_page(iid);
   htp.p('</body>');
    exception
      when others then
        print_error('echo_page', sqlerrm(sqlcode) );
  end;  

 procedure print_error (
    iwhere in varchar2,
    imessage in varchar2
  ) is
  begin
   htp.p('<head>');
   htp.p('</head>');
   htp.p('<body bgcolor=#aaaa00>');
   htp.p('<h2>Encounted Error in '|| @*
                                     "\'$file_name\.\'||iwhere||'</h1>');" 
   htp.p('<b>Error Message:</b><br>'||imessage);
   htp.p('</body>');
  end;
end;  
---------------------------------------------------------  
/
show errors
/
.

#------------------------------------------------------------
format WRITE_TABLE = 
#------------------------------------------------------------
drop sequence @*
              "$file_name\_seq;"
drop table  @*
            "$file_name\_table;"

create sequence @*
                "$file_name\_seq;"

create TABLE @*
             "$file_name\_table (" 
  @*
  &print_columns(4)
);
show errors
/
.

#------------------------------------------------------------
format WRITE_HTML = 
#------------------------------------------------------------
<html>
<head>
<title>NPAC Patient Record Database</title>
<script language="JavaScript">

<!--scriptbegin
var date_start = new Date();
var date_curr = date_start;
var time_start = date_start.getTime();
var time_curr = time_start;
var date_rel = new Date();
var time_rel = 0;

//scriptend-->

</script>
</head>
<frameset rows="100,*,64">
<frame name="bar" src="Bar.html" marginwidth=1 marginheight=1
scrolling=0 noresize>
<frameset cols="200,*,200">
<frameset rows="150,50,*">
<frame name="cntl" src="Cntl.html">
<frame name="action" src="Search.html">
<frame name="list" src="List.html" marginwidth="1">
</frameset>
<frame name="record" src="Help.html">
<frame name="items" src="Items.html" marginwidth="1">
</frameset>
<frame name="sign" src="Sign.html">

<noframes>
Your browser does not support multiple frames and JavaScript. Please use 
a Netscape 2.0 browser to view the [JavaScript enabled versoin]. 
Or you may  
<a href="/jguo/db1/Main1.html>[Go to Netscpae 1.1 version]</a>.
</noframes>

</frameset>
</html>
.
1;
