<!--
   dbedit - simple yet working mysql database editor
   (c)2000,2001 Marc Lehmann <pcg@goof.com>
   http://www.goof.com/pcg/marc/
   (requires PApp)

   version 0.32
-->

<domain name="dbedit" lang="en">

<import src="macro/editform"/>
<import pm="Convert::Scalar">:utf8</import>

<description>
   a simple mysql database editor specially suited for developing complex
   relational databases "on-the-fly".
</description>

<macro name="page(&amp;)" args="$body"><phtml><![CDATA[
         &gt; <?slink __"Databases", "" :>
#if $S{db}
         &gt; <?slink "db=$S{db}", "database" :>
# if $S{table}
         &gt; <?slink "table=$S{table}", "table" :>
#  if $S{id}
         &gt; <?slink "$S{pri_key}=$S{id}", "row" :>
#  endif
# endif
#endif

<p />

#if $A{sql_exec}
<:my $colour:>
<:my $sql = capture  {:>
<:
   my ($cmd, @arg) = @{delete $A{sql_exec}};

   # {name} => unquoted
   # :name  => standard sql-quoted named argument

   $cmd =~ s{
     \{(\S+)\} (?{ $P{$1} })
   | :(\S+)    (?{ $PApp::SQL::DBH->quote($P{$2}) })
   }{
      $^R
   }xge;
:>
<hr />
<h2>__"SQL-Execution"</h2>
__"command:" <tt><?$cmd:></tt><br />
#  if @arg
__"arguments:" <tt><?join ";", @arg:></tt><br />
#  endif
# if reload_p
<:$colour = "#aaee55":>
<?
  use Convert::Scalar; Convert::Scalar::utf8_on # DEVEL9961
  sprintf __"SQL execution skipped due to page reload.
             You can <a href='%s'>force re-execution</a> if you want.", surl -sql_exec => [$cmd, @arg];
:>
# elif $A{sql_ask}
<:$colour = "#eeee22":>
<?
  Convert::Scalar::utf8_on # DEVEL9961
  sprintf __"Do you <em>really</em> want to execute this potentially harmful command? <a href='%s'>[yes]</a>",
             surl -sql_exec => [$cmd, @arg];
:>
# else
<:
   my $st = eval { sql_exec $cmd, @arg };
   my $err = $@;
:>
#  if $err
<:$colour = "#ff4444":>
__"evaluation error:" <tt><?$err:></tt><br />
</td></tr></table>
#  else
<:$colour = "#22ff22":>
#  endif
#  if $st
__"rows affected:" <tt><?$st->rows:></tt><br />
#  endif
# endif
<hr />
<:}:>
<table cellpadding="5" cellspacing="0" width="100%" bgcolor="<?$colour:>"><tr><td>
<?$sql:>
</td></tr></table>
#endif

<:&$body:>
]]></phtml></macro>

<perl><![CDATA[
   sub sqlform {
      sform -sql_exec => [@_];
   }
]]></perl>

<module name="">
<phtml><![CDATA[
<:page {:>
   <ul><li>
     <?sqlform "create database {database}":>__"Create Database" <?textfield "database":><?endform:>
   </li></ul>

   <table cellspacing="0" cellpadding="2" border="0">
   <:
      for my $db (sql_fetchall "show databases") {
         :><tr><:
         :><td><b><?slink $db, "database", db => $db:></b></td><:
         :><td><?slink __"[EDIT]", "database", db => $db:></td><:
         :><td><font size='-3'><?
            slink __"[DROP]", -sql_exec => ["drop database $db"], -sql_ask => 1;
         :></font></td><:
         :></tr><:
      }
   :>
   </table>

<:}:>
]]></phtml>
</module>

<module name="database" nosession="">
<state keys="db" local="yes"/>
<phtml><![CDATA[
<:page {:>

   <ul><li>
       <?sqlform "create table $S{db}.{table} (id mediumint unsigned not null auto_increment primary key)":>
       __"Create Table"
       <?textfield "table":>
       <?endform:>
   </li></ul>

   <table border="0" cellspacing="5" cellpadding="3">
   <:
      for (sql_fetchall "show table status from $S{db}") {
         :><tr><:
         my ($table, $type, $row_format, $rows, $avg_row_len,$data_len,
               $max_data_len, $index_len, $data_free, $auto_inc, $ctime,$mtime,
               $checktime, $create_opt, $comment) = @$_;
         my @t = ("table", table => "$S{db}.$table");

         :><td><b><?slink $table, @t:></b></td><:
         :><td><font size='-3'><?
            slink __"[DROP]", -sql_exec => ["drop table $S{db}.$table"], -sql_ask => 1;
         :></font></td><:
         :><td align="right"><tt><?slink $rows, @t:></tt></td><:
         :><td><?slink $comment, @t:></td><:
         :></tr><:
      }
   :>
   </table>

<:}:>
]]></phtml></module>

<module name="table_alter" nosession="">
<state keys="db table" local="yes"/>
<phtml><![CDATA[
<:page {:>
   <?slink __"[EDIT]", "table":>

   <h2><?$S{table}:></h2>

   <:
      (my $table = $S{table}) =~ s/^[^.]+.//;
      
      sql_fetch \my ($table, $type, $row_format, $rows, $avg_row_len, $data_len,
                     $max_data_len, $index_len, $data_free, $auto_inc, $ctime, $mtime,
                     $checktime, $create_opt, $comment),
                "show table status from $S{db} like ?", 
                $table;
   :>

   <p>__"Please type enter after changing <em>any</em> field."</p>

   <?slink __"[DROP]", "database", -sql_exec => ["drop table $S{db}.$table"], -sql_ask => 1:><br />

   <:my $alter = "alter table $S{table}":>

   <table cellspacing="0" cellpadding="0" border="0">
   <?sform "database", -sql_exec => ["$alter rename as {newname}"]:>
   <tr>
      <td valign="baseline">__"Rename:"&#160;</td>
      <td><?textfield "newname", $S{table}:></td>
   </tr>
   <?endform:>

   <?sform -sql_exec => ["$alter comment=:comment"]:>
   <tr>
      <td valign="baseline">__"Comment:"&#160;</td>
      <td><?textfield { size => 50 }, "comment", "$comment":></td>
   </tr>
   <?endform:>
   </table>

   <h3>__"Columns (editing columns may take a long time)"</h3>

   <table cellspacing="0" cellpadding="0" border="0">
   <tr>
      <th align="left">__"Name"&#160;</th>
      <th align="left">__"Create"&#160;</th>
      <th align="left">__"Drop"&#160;</th>
      <th align="left">__"Default?"&#160;</th>
   </tr>
   <:{
      my $st = sql_exec "show fields from $S{table}";

      :>
         <tr>
           <td>&#160;</td>
           <td>
             <?sform -sql_exec => ["$alter add {create} first"]:>
             <?textfield { size => 70 }, "create":>
             <?endform:>
           </td>
         </tr>
      <:

      while (my($name, $type, $null, $key, $default, $extra, $privileges)
                = $st->fetchrow_array) {

         $type .= " not null" unless $null;
         $type .= " primary key" if $key eq "pri";
         $type .= " default '$default'" if $default;
         $type .= " $extra" if $extra;

         :>
           <tr>
             <td valign="baseline"><?$name:>&#160;</td>

             <td>
               <?sform -sql_exec => ["$alter change $name {alter}"]:>
               <?textfield { size => 70 }, "alter", "$name $type":>
               <?endform:>
             </td>

             <td valign="baseline">
               <?slink __"[DROP]", -sql_exec => ["$alter drop column $name"], -sql_ask => 1:>
             </td>
             <td valign="baseline">
               <?
                 $default
                    ? slink __"[drop default]", -sql_exec => ["$alter alter $name drop default"]
                    : "&#160;"
               :>
             </td>
           </tr>

           <tr>
             <td valign="baseline">&#160;</td>
             <td>
               <?sform -sql_exec => ["$alter add {create} after $name"]:>
               <?textfield {size => 70}, "create":>
               <?endform:>
             </td>
           </tr>
         <:
      }
   }:>
   </table>

   <h3>__"Keys (changing keys often takes a long time!)"</h3>

   <table cellspacing="0" cellpadding="0" border="0">
   <:
      my $s = sql_exec "show keys from $S{table}";
      my %key;
      while (my $row = $s->fetchrow_arrayref) {
         my($table,$non_unique,$name,$seq,$cname,$collation,$cardinality,$sub_part,$packed,$comment,$mysql4_a,$mysql4_b)
            = @$row;
         $cname .= "($sub_part)" if $sub_part;
         push @{$key{$name}{col}}, $cname;
         $key{$name}{unique} = !$non_unique;
      }
      while (my($name,$v)=each %key) {
         my ($spec, $drop);
         if ($name eq "PRIMARY") {
            $name = $spec = $drop = "primary key";
            $spec .= " ";
         } else {
            $spec = ($v->{unique} ? "unique" : "index")." $name";
            $drop = "index $name";
         }
         $spec .= "(".(join ", ", @{$v->{col}}).")";

         :>
           <tr><td valign="baseline"><?$name:>&#160;</td>
             <td>
               <?sform -sql_exec => ["$alter drop $drop, add {index}"]:>
               <?textfield { size => 60 }, "index", "$spec":>
               <?endform:>
             </td>

             <td valign="baseline">&#160;</td>
             <td valign="baseline">
               <?slink __"[DROP]", -sql_exec => ["$alter drop $drop"]:>
             </td>
           </tr>
         <:

      }

      :>
        <tr>
          <td valign="baseline">__"NEW" -->&#160;</td>
          <td>
             <?sform -sql_exec => ["$alter add {index}"]:>
             <?textfield { size => 60 }, "index":>
             <?endform:>
          </td>
        </tr>
      <:
   :>
   </table>

   <h3>__"Table Options (may require a full copy)"</h3>

   <?sform -sql_exec => ["$alter {optins}"]:>
   <?textfield { size => 60 }, "options", $create_opt:>
   <?endform:>
                
   <?sform -sql_exec => ["$alter type={type}"]:>
   <?
      selectbox "type", $type,
         MyISAM	=> 'MyISAM',
         ISAM	=> 'ISAM',
         BDB	=> 'BDB',
         InnoDB	=> 'InnoDB',
         GEMINI	=> 'GEMINI',
         MERGE	=> 'MERGE',
         HEAP	=> 'HEAP',
   :>
   <?submit "set", __"Set":>
   <?endform:>

<:}:>
]]></phtml>
</module>

<macro name="tableinfo"><perl><![CDATA[
   $S{_table} = $S{table};
   my $st = sql_exec "show columns from $S{table}";
   my $i = 0;
   delete $S{pri_key};
   delete $S{field};
   while (my($field, $type, $null, $key, $default) = $st->fetchrow_array) {
      my ($basetype, $subtype) = ($type =~ /^(\w+)(.*)$/);
      #print "<pre>$i:$field*$basetype*$subtype*$null*$key*$default\n</pre>";
      push @{$S{field}}, {
         name		=> $field,
         type		=> $basetype,
         subtype	=> $subtype,
         null		=> $null,
         key		=> $key,
         default	=> $default
      };
      $S{pri_key} = $field if $key eq "PRI";
   }
]]></perl></macro>

<module name="table" nosession="">
<state keys="db table begin order where select" local="yes"/>
<phtml><![CDATA[
<:page {:>
   <?slink __"[ALTER]", "table_alter":>

   <:tableinfo:>

   <:
      BEGIN {
         %view_short = (
               bigint	=> sub { shift },
               int	=> sub { shift },
               mediumint=> sub { shift },
               smallint	=> sub { shift },
               tinyint	=> sub { shift },
               float	=> sub { shift },
               double	=> sub { shift },
               decimal	=> sub { shift },
               varchar	=> sub { substr shift, 0, 20 },
               char	=> sub { substr shift, 0, 20 },
               tinytext	=> sub { substr shift, 0, 20 },
               text	=> sub { substr shift, 0, 20 },
               mediumtext=> sub { substr shift, 0, 30 },
               longtext	=> sub { substr shift, 0, 40 },
               enum	=> sub { shift },
               set	=> sub { shift },
               tinyblob => sub { substr shift, 0, 30 },
               blob	=> sub { substr shift, 0, 20 },
               mediumblob=> sub { substr shift, 0, 30 },
               longblob	=> sub { substr shift, 0, 40 },
               date	=> sub { shift },
               time	=> sub { shift },
               timestamp=> sub { shift },
          );
      }

      $S{order} ||= $S{pri_key} if $S{pri_key};
      :>
        <p><?slink __"CREATE ROW", "row":></p>

        <table border="0">
          <tr>
             <td>__"where:"&#160;</td>
             <td><?ef_begin:><?ef_string \$S{where}, 60:><?ef_end:></td>
          </tr>
          <tr>
             <td>__"order by:"&#160;</td>
             <td><?ef_begin:><?ef_string \$S{order}, 60:><?ef_end:></td>
          </tr>
        </table>

      <:

      my ($where, $order, $sql);
      $order = " order by $S{order}" if $S{order} =~ /\S/;
      $where = " where $S{where}" if $S{where} =~ /\S/;

      my $st = eval {
         $sql = "select * from $S{table}$where$order limit ?,?";
         utf8_upgrade $sql if $S{force_utf8};
         sql_exec $sql, $S{begin}*1, 20;
      };

      if ($st) {
         :>
           <table width="40%"><tr>
             <td align="left"><?slink "&lt;&lt;&lt;", begin => $S{begin}-20:></td>
             <td align="right"><?slink "&gt;&gt;&gt;", begin => $S{begin}+20:></td>
           </tr></table>
           <?ef_sbegin:>
           <?ef_checkbox \$S{force_utf8}:>&#160;<?ef_submit __"force utf-8 on/off":>
           <?ef_end:>
           <table border="1">
             <tr>
               <?join "", map "<th>".escape_html($_->{name})."</th>", @{$S{field}}:>
               <th>&#160;</th>
             </tr>
         <:

         my $priid;

         while (my $f = $st->fetchrow_arrayref) {

            :><tr><:

            for (0..$#$f) {
               my $data = $f->[$_];
               utf8_on $data if $S{force_utf8} && utf8_valid $data;
               $data = escape_html $view_short{$S{field}[$_]{type}}->($data);
               if ($S{field}[$_]{name} eq $S{pri_key}) {
                  $priid = $f->[$_];
                  $data = slink $data, "row", id => $priid;
               }
               $data = "&#160;" unless $data ne "";
               :><td><?$data:></td><:
            }

            if ($priid) {
               :>
                 <td>
                   <?slink __"[DELETE]", -sql_exec => ["delete from $S{table} where $S{pri_key} = ?", $priid]:>
                 </td>
               <:
            }

            :></tr><:

         }
         :></table><:

         :>
           <table width="40%"><tr>
              <td align="left"><?slink "&lt;&lt;&lt;", begin => $S{begin}-20:></td>
              <td align="right"><?slink "&gt;&gt;&gt;", begin => $S{begin}+20:></td>
           </tr></table>
         <:
      } else {
         :><p>__"error while evaluating SQL expression:" <?$@:><:
      }

   :>

<:}:>
]]></phtml>
</module>

<module name="row" nosession="">
<state keys="force_utf8" preferences="yes"/>
<state keys="db table begin order where select" local="yes"/>
<phtml><![CDATA[
<:page {:>
   <:tableinfo:>

   <:
      unless ($S{id}) {
         my $st = sql_exec "insert into $S{table} () values ()";
         $S{id} = sql_insertid $st;
      }

      sub edit_text {
         my ($size, $ft, $data) = @_;
         if ($ft->{subtype} =~ /^\((\d+)\)/) {
            $size = $1;
         }
         $size = 80 if $size > 80;
         if ($size > 0 && $data !~ /\n/) {
            textfield ({ size => $size, maxlength => 500 },
                       "param_".$ft->{name}, $data);
         } else {
            textarea  ({ size => $size, maxlength => 500, rows => 10, cols => 80, wrap => "wrap" }, 
                       "param_".$ft->{name}, $data);
         }
      }

      BEGIN {
         %edit_field = (
               tinyint	=> sub { edit_text( 4, @_) },
               smallint	=> sub { edit_text( 6, @_) },
               mediumint=> sub { edit_text( 7, @_) },
               int	=> sub { edit_text(13, @_) },
               bigint	=> sub { edit_text(20, @_) },
               float	=> sub { edit_text(20, @_) },
               double	=> sub { edit_text(20, @_) },
               decimal	=> sub { edit_text(20, @_) },
               varchar	=> sub { edit_text(90, @_) },
               char	=> sub { edit_text(90, @_) },
               tinytext	=> sub { edit_text(90, @_) },
               text	=> sub { edit_text(-1, @_) },
               mediumtext=> sub { edit_text(-1, @_) },
               longtext	=> sub { edit_text(-1, @_) },
               enum	=> sub { edit_text(20, @_) },
               set	=> sub { edit_text(60, @_) },
               tinyblob	=> sub { edit_text(20, @_) },
               blob	=> sub { edit_text(20, @_) },
               mediumblob=> sub { edit_text(20, @_) },
               longblob => sub { edit_text(20, @_) },
               date	=> sub { edit_text(10, @_) },
               time	=> sub { edit_text( 5, @_) },
               timestamp=> sub { edit_text(30, @_) },
          );
      }


      if (defined $P{"param_$S{pri_key}"}) {
         $S{force_utf8} = $P{force_utf8};
         eval {
            sql_exec "replace into $S{table} values ("
                        .join(",", ("?") x @{$S{field}})
                        .")",
                     map $S{force_utf8} ? utf8_upgrade $_ : $_,
                     map $P{"param_".$S{field}[$_]{name}},
                                0..$#{$S{field}};
         };
         if ($@) {
            print errbox("database update failed", $@);
         }
      }
      
      my $st = sql_exec "select * from $S{table} where $S{pri_key} = ?", $S{id};

      my $f = $st->fetchrow_arrayref;

      :>
        <?cform:>
        <?checkbox "force_utf8", "1", $S{force_utf8}:>&#160;__"force utf-8 on/off"
        <table border="0">
      <:

      for my $i (0..$#$f) {
         my $ft = $S{field}[$i];
         my $data = $f->[$i];
         utf8_on $data if $S{force_utf8} && utf8_valid $data;
         my $name = $ft->{name};
         $name = "<b>$name</b>" if $name eq $S{pri_key};

         :>
           <tr>
             <td><?$ft->{type}:>&#160;</td>
             <td><?$name:>&#160;</td>
             <td><?$edit_field{$ft->{type}}->($ft, $data):></td>
           </tr>
         <:
      }

      :>
        </table>
        <p />
        <?submit "submit", __"Update":>
        <?endform:>
      <:

   :>

<:}:>
]]></phtml>
</module>

</domain>
