home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 July / CMCD0703.ISO / Linux / mdm.tar.gz / mdm.tar / mdm.cgi < prev   
Text File  |  2003-06-10  |  367KB  |  10,430 lines
  1. #!/usr/bin/perl
  2. #!C:/Perl/bin/perl.exe
  3.  
  4. ######################################################################################
  5. # LICENSE No: #???????
  6. ######################################################################################
  7. #
  8. #
  9. #MySQL(TM) Data Manager v1.70
  10. #
  11. #Copyright ⌐ 2003 Ioannis Livassov
  12. #
  13. #Licence agreement and limited warranty
  14. #
  15. #MySQL Data Manager (Software) is protected by Copyright Law and
  16. #International Treaty.
  17. #
  18. #You should carefully read the terms and conditions of this agreement
  19. #before purchasing and installing the Software.  
  20. #
  21. #If you do not agree to any of the terms of this License, then do not
  22. #purchase, install, or use this Software.  
  23. #
  24. #One purchased copy of the Software may be only used or installed on
  25. #a single computer used by many people. This is not a concurrent use
  26. #license. If you need another copy of the Software to be installed
  27. #you must purchase another license.
  28. #
  29. #You may access this program through a network by a number of remote
  30. #computers.  
  31. #
  32. #This Software is distributed as it is and with no warranties of any
  33. #kind, whether expressed or implied. Experience dictates that any
  34. #program be thoroughly tested with non-critical data before relying on
  35. #it.  The user must assume the risk of using the program.  This
  36. #disclaimer of warranty constitutes an essential part of this License
  37. #Statement. 
  38. #
  39. #Any liability of the distributor will be limited exclusively to
  40. #refund of purchase price.  In no event shall the distributor, or its
  41. #officers, employees, affiliates, contractors, subsidiaries, or parent
  42. #organizations, be liable for any incidental, consequential, or punitive
  43. #damages whatsoever relating to the use of this Software.
  44. #
  45. #This Agreement is the complete statement of the Agreement between the
  46. #parties on the subject matter, and merges and supersedes all other or
  47. #prior understandings, purchase orders, agreements and arrangements.
  48. #
  49. #You may not sell, rent, lease or redistribute the Software in any form
  50. #without prior written consent. You may create derivative works using its
  51. #code partially providing an appropriate references, assuming the purpose
  52. #of the resulting product will be completely different from that of initial
  53. #program. You may of course modify or improve a reasonably small part of
  54. #the code of this Software in order to fit better to your needs provided
  55. #the Software logo,  its look and feel and the text of this license
  56. #agreement  remain intact.
  57. #
  58. # 
  59. #
  60. #MySQL is a trademark of TcX DataKonsultAB
  61. #
  62. ######################################################################################
  63.  
  64. use strict;
  65. use CGI::Carp qw(fatalsToBrowser carpout);
  66. use File::Copy();
  67. use CGI();
  68. use DBI();
  69. use vars qw($q $host $full_url $WIN32 $delim);
  70.  
  71. my $VERSION = '1.70';
  72.  
  73. $q = new CGI;
  74.  
  75.  
  76. $host            = $ENV{HTTP_HOST};
  77. $full_url         = $q->url();
  78. $WIN32             = 1 if ($^O =~ /win32/i);
  79. $delim            = $WIN32 ? "\\" : '/';
  80. my ($dbh_, $HOME,$SelectRows,$UpdateRows,$DEFAULTHOST,$SOCKET,$MYSQL,$configFile, $HELP,
  81.     $OTHER_MYSQL,$USER_DIR,$MAX_BACKUP_SIZE,$MAX_SCRIPT_SIZE, $MAX_ASCII_SIZE, $CONTACT_EMAIL,
  82.     $COMPRESS,$ALLOW_ZIP,$ALLOW_GZIP,$ZIP,$ZIPLOG,$ERRLOG,$ERROR_LOG, $PRINT_POP_UP,
  83.     $BGCOLOR1,$BGCOLOR2,$STATUSFONTCOLOR,$LOGO,$SLOGAN,$SLOGANCOLOR, $LOGOLINK, $LOGOTARGET, $CHARSET);
  84.     
  85. # NUMBER OF ROWS TO BE SHOWN INITIALLY IN "SELECT" AND "UPDATE" FUNCTIONS
  86.     $SelectRows            = '10';
  87.     $UpdateRows         = '10';
  88.  
  89. ######################################################################################
  90. # INSTALLATION (Refer to http://www.edatanew.com/about/)
  91. ######################################################################################
  92. #
  93. # Path to Configuration File:
  94. # It can be either full or relative path.
  95. # On Linux/Unix systems chmod mdmConfig directory to 777
  96. $configFile = './mdmConfig/mdmConfig.conf';
  97. # To disable interactive setup remark or delete the line above:
  98. # 
  99. # This variable must be unremarked and set if the links and buttons "do not work"
  100. # It must look like: $full_url = "http://www.myhostname.com/cgi-bin/mdm.cgi";
  101. #$full_url         = "";
  102. #####################################################################################
  103. my $register = "http://www.edatanew.com/order";
  104. my $demomsg = <<EOT
  105. Demo version can not execute this command.
  106. To register this program and download full version visit:
  107. $register
  108.  
  109. Try fully functional online demo:
  110. http://www.edatanew.com/demo
  111. EOT
  112. ;
  113. my $demomsg1 = <<EOT
  114. Demo version can not execute this command on a table with more
  115. than 4 columns.
  116. To register this program and download full version visit:
  117. $register
  118.  
  119. Try fully functional online demo:
  120. http://www.edatanew.com/demo
  121. EOT
  122. ;
  123.  
  124.  
  125.  
  126.  
  127. if ($configFile and -e $configFile){
  128.     open FH, $configFile or die $!;
  129.     flock (FH,2) unless $WIN32;
  130.     my @config;
  131.     while(<FH>){
  132.         push @config, $_;
  133.     }
  134.     flock (FH,8) unless $WIN32;
  135.     close FH;
  136.     my @default            = ();
  137.     my $config             = readconfig(\@config);
  138.     push @default, "host=$config->{defaultHost}" if $config->{defaultHost};
  139.     push @default, "port=$config->{defaultPort}" if $config->{defaultPort};
  140.     $DEFAULTHOST        = join (';', @default);
  141.     $HOME                = $config->{homeURL};
  142.     $SOCKET             = $config->{defaultSocket};
  143.     $MYSQL                = $config->{mysql};
  144.     $OTHER_MYSQL        = $config->{otherMysql};
  145.     $USER_DIR            = $config->{userDirectory};
  146.     $MAX_BACKUP_SIZE    = $config->{backupMax};
  147.     $MAX_SCRIPT_SIZE    = $config->{SQLMax};
  148.     $MAX_ASCII_SIZE        = $config->{asciiMax};
  149.     $CONTACT_EMAIL        = $config->{adminEmail};
  150.     $COMPRESS            = $config->{compressCommand};
  151.     $ALLOW_ZIP            = $config->{allowZIP};
  152.     $ALLOW_GZIP            = $config->{allowGZIP};
  153.     $ZIP                = $config->{zipSyntax};
  154.     $ZIPLOG                = $config->{zipLog};
  155.     $PRINT_POP_UP        = $config->{printPopUp};
  156.     $HELP                = $config->{helpURL};
  157.     $CHARSET            = $config->{charset};
  158.     $BGCOLOR1            = $config->{bgcolor1};        
  159.     $BGCOLOR2            = $config->{bgcolor2};
  160.     $STATUSFONTCOLOR    = $config->{statusfontcolor};
  161.     $LOGO                = $config->{logo};
  162.     $LOGOLINK            = $config->{logolink};
  163.     $LOGOTARGET            = $config->{logotarget};
  164.     $SLOGAN                = $config->{slogan};
  165.     $SLOGANCOLOR        = $config->{slogancolor};
  166.     
  167.     $BGCOLOR1            = $BGCOLOR1         ? '#' . $BGCOLOR1             : '#336699';
  168.     $BGCOLOR2            = $BGCOLOR2         ? '#' . $BGCOLOR2             : '#003366';
  169.     $STATUSFONTCOLOR    = $STATUSFONTCOLOR     ? '#' . $STATUSFONTCOLOR     : '#6699CC';
  170.     $SLOGANCOLOR        = $SLOGANCOLOR         ? '#' . $SLOGANCOLOR         : '#ffffff';
  171.     $SLOGAN                = "Mysql Data Manager" unless $SLOGAN;
  172.     $CHARSET            = 'ISO-8859-1'           unless ($CHARSET =~ /\S/); 
  173.     
  174.     
  175. }
  176. else {
  177.  
  178. #############################################################################################
  179. #                HARDCODED VALUES                                                            #
  180. # Settings of these values are optional. They are used if config file can not be created    # 
  181. #############################################################################################
  182.  
  183. # HOME PAGE FULL URL
  184.     $HOME                = "http://$host";
  185. #
  186. # COMMON CONNECTION PARAMETERS:
  187. #
  188. # PATH TO SOCKET FILE AND DEFAULT HOST. THE STRINGS ARE USED WHEN THE FIELD 'HOST' (LOGIN PAGE)IS BLANK.
  189. # (CORRECT THIS VALUE AS NEEDED. FOR EXAMPLE UNDER WINDOWS IT MAY BE SOMETHING
  190. # LIKE:     $DEFAULTHOST    = 'host=localhost:3306';
  191. #            $SOCKET = '';
  192. #
  193.     $DEFAULTHOST        = 'host=localhost:3306';
  194.     $SOCKET             = '/tmp/mysql.socket';
  195. #
  196. # OTHER PARAMETERS USED TO RUN mysql UTILITY ONLY
  197. #
  198. # PATH TO mysql CLIENT (CORRECT THIS VALUE AS NEEDED. FOR EXAMPLE UNDER WINDOWS 
  199. # IT WILL BE SOMETHING LIKE: 
  200. # $MYSQL = 'c:\mysql\bin\mysql.exe';
  201.     $MYSQL                 = '/usr/local/mysql/bin/mysql';
  202. #
  203. # (SUBSTITUTE THESE VALUES WITH CORRECT ONES):
  204. # FOR EXAMPLE: SET 'SILENT' AND 'COMPRESS': my $OTHER_MYSQL = '-s -C';
  205. # FOR MORE OPTIONS RUN 'mysql -?' IN COMMAND LINE.
  206.     $OTHER_MYSQL                 = '';
  207.  
  208.  
  209. # PATH TO USER DIRECTORY (CORRECT THIS VALUE AS NEEDED.)
  210. # CAUTION! If you created some backup files as user 'Username' connected to a location
  211. # 'Location1' and then connect different location 'Location2',
  212. # the program will treat you as different user (even if you use the same user name)
  213. # and created earlier files will be unreachable.
  214. # Each user 'username' connected the location 'locationname' will be provided with his
  215. # own subdirectories:
  216. #  /path/to/user_directory/usename.locationname/sql
  217. #  /path/to/user_directory/usename.locationname/backup  
  218. # or under Windows
  219. # D:\path\to\user_directory\usename.locationname\sql
  220. # D:\path\to\user_directory\usename.locationname\backup 
  221. # It also works if you put something like this (under Windows)
  222. # \path\to\usr - the program treats it as: 
  223. # C:\path\to\usr if the current disk drive is C: (D:\... if the current disk drive is D:, etc.)
  224. # 
  225. # the directories usename.locationname/sql and usename.locationname/backup will be created
  226. # by the program
  227.     $USER_DIR                     = '/home/myrootname/data/usr';
  228.  
  229. # MAXIMUM TOTAL SIZE OF BAKUP FILES PER USER/HOST (kilobytes). UNLIMITED IF EQUALS ZERO.
  230.     $MAX_BACKUP_SIZE             = 200;
  231.  
  232. # MAXIMUM TOTAL SIZE OF USER SCRIPTS
  233.     $MAX_SCRIPT_SIZE             = 50;
  234.  
  235. #  MAXIMUM SIZE OF ASCII DELIMITED FILE (FOR IMPORT - EXPORT)
  236.     $MAX_ASCII_SIZE                = 50;
  237.     
  238. # CONTACT EMAIL(TO BE USED IN SOME ERROR MESSAGES
  239.     $CONTACT_EMAIL                 = 'tech@edatanew.com';
  240.  
  241. # MANUAL COMPRESSING: zip OR gzip ?
  242.     $COMPRESS                     = 'gzip';
  243.  
  244. # SET ZERO IF ZIP UTILITY IS NOT INSTALLED (to be used for backup file compressing);
  245.     $ALLOW_ZIP                     = 1;
  246.  
  247. # SET THIS VARIABLE ZERO IF GZIP UTILITY IS NOT INSTALLED. (used for backup file compressing)
  248.     $ALLOW_GZIP                 = 1;
  249.  
  250. # "zip -qj" - ZIP UTILITY CALL UNDER UNIX/LINUX.
  251. # "Wzzip -Pr" OR "Wzzip" ZIP UTILITY CALL UNDER WINDOWS.
  252. # (WinZip COMMAND LINE UTILITY - SEE http://www.winzip.com).
  253. # USUALLY UNDER UNIX/LINUX THIS UTILITY IS ALREADY INSTALLED.
  254. # IF ANY OTHER ZIP UTILITY IS USED UNDER WINDOWS OR ANOTHER OPERATION SYSTEM,
  255. # CORRECT THE LINE BELOW ACCORDINGLY. (used for backup file compressing)
  256. # IF $ALLOW_ZIP =0 YOU CAN LEAVE IT BLANK: $ZIP = '';
  257.  
  258. #$ZIP = 'Wzzip -Pr'; 
  259. #$ZIPLOG = "1>NUL"}    #Win32
  260.     $ZIP                         = 'zip -qj';    #UNIX/LINUX 
  261.  
  262. # UNDER WINDOWS IT CAN LOOK LIKE:
  263. #     $ZIP = 'Wzzip'; # OR $ZIP = 'Wzzip -Pr'
  264. #     $ZIPLOG = "1>NUL";
  265. # THE VARIABLE $ZIPLOG IS USED TO REDIRECT THE OUTPUTOF THE UTILITY Wzzip.
  266.  
  267. # SET THIS VARIABLE EQUALS TO 0 IF YOUR WEB BROWSER DOES NOT SUPPORTS window.print() 
  268. # JAVASCRIPT FUNCTION.
  269.     $PRINT_POP_UP                 = 0 ;
  270.  
  271. #SET URL OF 'HELP' DIRECTORY:
  272.     $HELP                         = "../help";
  273. #DEFAULT CHARACTER SET:
  274.     $CHARSET            = 'ISO-8859-1'; 
  275. #COLORS:
  276.     $BGCOLOR1            = '#d79f00';    # HEXADECIMAL VALUE    WITH LEADING `#' CHARACTER
  277.     $BGCOLOR2            = '#a46c00';    # HEXADECIMAL VALUE    WITH LEADING `#' CHARACTER
  278.     $STATUSFONTCOLOR    = '#d79f00';    # HEXADECIMAL VALUE    WITH LEADING `#' CHARACTER
  279.     $LOGO                = '';          # URL LIKE http://www.yourdomain.com/images/logo.gif'
  280.     $LOGOLINK            = '';
  281.     $LOGOTARGET            = '';
  282.     $SLOGAN                = "Mysql Data Manager";
  283.     $SLOGANCOLOR        = '#a46c00';    # HEXADECIMAL VALUE    WITH LEADING `#' CHARACTER
  284.  
  285. #---------------------------------------------------------------------------------------
  286. # END OF MANUAL SETTING
  287. ########################################################################################
  288. }
  289. #########################################################################################
  290. #        DO NOT MODIFY ANYTHING BELOW THIS LINE                                            #
  291. #########################################################################################
  292.  
  293. my ($query, @ary);
  294. my @selectlike = (
  295.                     'select',
  296.                     'show',
  297.                     'explain',
  298.                     'describe',
  299.                     'desc'
  300. );
  301.  
  302. #++++++++++++++++++++++++++++++++++++++
  303.  
  304. my @typelist = (       'TINYINT',
  305.                     'SMALLINT',
  306.                     'INT',
  307.                     'MEDIUMINT',
  308.                     'BIGINT',
  309.                     'FLOAT',
  310.                     'DECIMAL',
  311.                     'DOUBLE',
  312.                     'CHAR',
  313.                     'VARCHAR',
  314.                     'ENUM',
  315.                     'SET',
  316.                     'TINYBLOB',
  317.                     'TINYTEXT',
  318.                     'BLOB',
  319.                     'TEXT',
  320.                     'MEDIUMBLOB',
  321.                     'MEDIUMTEXT',
  322.                     'LONGBLOB',
  323.                     'LONGTEXT',
  324.                     'DATE',
  325.                     'TIME',
  326.                     'TIMESTAMP',
  327.                     'DATETIME',
  328.                     'YEAR'
  329.   
  330.  
  331. );
  332.  
  333. my %auto_type = (
  334.                     TINYINT                =>1,
  335.                     SMALLINT          =>1,
  336.                        INT                      =>1,
  337.                     MEDIUMINT          =>1,
  338.                     BIGINT              =>1,
  339.                     FLOAT              =>1,
  340.                     NUMERIC              =>1,
  341.                     REAL              =>1,
  342.                     DOUBLE                =>1,
  343.                     DECIMAL              =>1,
  344.                     CHAR              =>1,
  345.                     VARCHAR              =>1,
  346. );
  347. my @textdata = (    'TINYBLOB',
  348.                     'BLOB',
  349.                     'MEDIUMBLOB',
  350.                     'LONGBLOB',
  351.                     'TINYTEXT',
  352.                     'TEXT',
  353.                     'MEDIUMTEXT',
  354.                     'LONGTEXT'
  355. );
  356.  
  357. unless (($CHARSET eq "ISO-8859-1") or ($CHARSET eq "iso-8859-1")){
  358.     local $SIG{__DIE__} = sub{
  359.     print $q->header;
  360.     print "Perl module CGI.pm must be updated"
  361.     };
  362.     $q->charset($CHARSET)
  363. }
  364. my $page     = $q->param('page');
  365. my $agent;
  366. if ($q->user_agent =~ /(MSIE)|(Opera)/i  ) {$agent = 0}
  367. elsif ($q->user_agent =~ /(\[\w\w\])|(Netscape)/i  ){$agent = 1}
  368.  
  369. if (($page eq 'logout') or !$page){
  370.     &logout();
  371.     &printparam();
  372.     exit;
  373. }
  374. elsif ($page eq 'setup') {
  375.     &setup();
  376.     &printparam();
  377.     exit;
  378. }
  379.  
  380. my $NO_HEADER = 1 if (  
  381.  
  382.             $q->param('downloadBackup') and ($q->param('func') =~ /backup/i) 
  383.             or $q->param('downloadFile') or ($q->param('action') =~ /download/i) 
  384.             
  385.             );
  386.  
  387. my ($user, $password, $MySQLhost, $usedefault, $database);
  388. $DEFAULTHOST = "mysql_socket=$SOCKET;".$DEFAULTHOST if $SOCKET;
  389. if ($q->param('login')) {
  390.     $user         = $q->param('user');
  391.     $password    = $q->param('password');
  392.     unless  ($q->param('host')) {
  393.         $MySQLhost            = $DEFAULTHOST;
  394.         $usedefault            = 1;
  395.     }
  396.     else {
  397.         $MySQLhost            = 'host='.$q->param('host');
  398.         $usedefault            = 0;
  399.     }
  400.     if ($q->param('host')    =~ /database=([a-zA-Z0-9_]*)/){$database=$1}
  401.     else {$database         = $q->param('dbname'); $database =~ s/\s//g;}
  402.  
  403.     my $cookies = $q->cookie(    
  404.                             -name=>'db_manager',
  405.                             -value=>[$user, $password, $MySQLhost, $usedefault],
  406.                             -secure=>0
  407.                             );
  408.     print     $q->header(-cookie=>$cookies, -expires=>0);
  409.     $page = 'select_db'    if ($database and ($page eq 'connect')); 
  410.           
  411. } #IF
  412. else {
  413.     ($user, $password, $MySQLhost, $usedefault) = $q->cookie('db_manager');
  414.     if (defined $q->param('change_password')){
  415.         $password     = $q->param('change_password');
  416.         my $cookies = $q->cookie(    
  417.                             -name=>'db_manager',
  418.                             -value=>[$user, $password, $MySQLhost, $usedefault],
  419.                             -secure=>0
  420.                             );
  421.                print     $q->header(-cookie=>[$cookies], -expires=>0);
  422.     }
  423.     else {
  424.         if ($q->param('targetconnect')){
  425.             my $targetuser            = $q->param('targetuser');
  426.             my $targetpassword        = $q->param('targetpassword');
  427.             my $targethost            = $q->param('targethost');
  428.             unless ($targethost){$targethost = $DEFAULTHOST}
  429.             my $cookies = $q->cookie(
  430.                         -name=>'target_db',
  431.                         -value=>[$targetuser, $targetpassword, $targethost],
  432.                         -secure=>0
  433.                         );
  434.             print     $q->header(-cookie=>[$cookies], -expires=>0);        
  435.         }
  436.         else {    
  437.             print $q->header(-expires=>0) unless $NO_HEADER;
  438.         }
  439.     }
  440.     $MySQLhost    = $DEFAULTHOST if ($usedefault);
  441.     $database                                     = $q->param('dbname');
  442. } #ELSE
  443. #++++++++++++++++++++++++++++++++++++++
  444.  
  445. {
  446.     my ($host_, $port_) = gethost($MySQLhost);
  447.     
  448.     sub myhost {
  449.         unless (defined $_[0]){
  450.             if (wantarray){return($host_, $port_)}
  451.             else {return($host_)}
  452.         }
  453.         else {
  454.             if (wantarray){
  455.                 my ($host_, $port_) = gethost($_[0]);
  456.                 return($host_, $port_)
  457.             }
  458.             else {
  459.                 my $host_ = gethost($_[0]);
  460.                 return($host_)
  461.             }
  462.         }
  463.     }
  464. }
  465.  
  466. my $print = "print" if ($q->param('print'));
  467. &startpage($user, $database) unless $NO_HEADER;
  468. my (%attr) =
  469. (
  470.                     PrintError => 0,
  471.                     RaiseError => 0,
  472.                     #AutoCommit => 0
  473. );
  474.  
  475. my $dsn                    = "DBI:mysql:$database;$MySQLhost";
  476. my $dsn_                 = $usedefault ? "DBI:mysql:$database:defaulthost" : $dsn;
  477. my $dbh                 = DBI->connect($dsn, $user, $password,\%attr)
  478.     or &bail_out("(DSN, user, password): $dsn, $user, $password");
  479. undef $dsn_; 
  480. if ($database){$dbh->do("USE $database") or bail_out("cannot USE this database: $database", {page => "connect"})}
  481.  
  482. {
  483.     my ($sth, $res)        = prepare_execute("SELECT VERSION()");
  484.     my $version         = $sth->fetchrow_array();
  485.     $sth->finish();
  486.     sub check_version {
  487.     #input: version number NN.NN.NNanythyng
  488.     #returns undef if current version is lower then required
  489.     #returns 1 if OK;
  490.         my (@v,@x);
  491.         if ($version =~ /^(\d*)\.(\d*)\.(\d*).*/)    {@v = ($1,$2,$3)}
  492.         if ($_[0] =~ /^(\d*)\.(\d*)\.?(\d*)/)    {@x = ($1,$2,$3)}
  493.         if ($v[0] < $x[0]){return undef} elsif ($v[0] > $x[0]){return 1}
  494.         if ($v[1] < $x[1]){return undef} elsif ($v[1] > $x[1]){return 1}
  495.         if ($v[2] < $x[2]){return undef} else {return 1} ;
  496.     }
  497.     sub get_version{$version}
  498.  
  499. }
  500.  
  501. if (check_version('3.23.00')){
  502.     push @selectlike, ('optimize','check','analyze','repair');
  503.     undef $auto_type{'VARCHAR'}; undef $auto_type{'CHAR'};
  504. }
  505. my $demomsg2 = "This was generated by unregistered version of MDM";
  506. if ($page eq 'admin'){
  507.     my $back                    = {page => "admin"};
  508.     $back->{dbname}                  = "$database" if $database;
  509.     $back->{selectdbname_}        = $q->param('selectdbname_') if $q->param('selectdbname_');
  510.     my $func = $q->param('func');
  511.     if        ($func =~ /flush/i)                {&execFlush($back);&loadAdmin()}
  512.     elsif    ($func =~ /analyze/i)            {&execCheckRepair($back, 'ANALYZE')}
  513.     elsif    ($func =~ /check/i)                {&execCheckRepair($back, 'CHECK')}
  514.     elsif    ($func =~ /repair/i)            {&execCheckRepair($back, 'REPAIR')}    
  515.     elsif    ($func =~ /optimize/i)            {&execCheckRepair($back, 'OPTIMIZE')}
  516.     elsif    ($func =~ /access/i)            {&loadAccessControl($back)}
  517.     else {&loadAdmin($back)}
  518. }
  519. elsif ($page eq 'select_db') {
  520.     my $func = $q->param('func');
  521.     if     ($q->param('tableops') =~ /execute/i) {execExecuteQuery({'page' => 'connect'})}
  522.     elsif ($q->param('cancel')){&loadSelectDB()}
  523.     elsif ($q->param('tableops') =~ /drop/i) {dropcreatedb('drop')}
  524.     elsif ($q->param('tableops') =~ /create/i) {dropcreatedb('create')}
  525.     elsif ($func =~ /backup/i){&loadBackup()}
  526.     elsif ($func =~ /restore/i){&loadRestore()}
  527.     else  {&loadSelectTables()}
  528. }
  529. elsif (!$database) {
  530.     if ($page eq 'ddl') {
  531.         $database    = $q->param('database');
  532.         execExecuteQuery({page => 'tables', dbname => "$database", script => 'back'})  if ($q->param('apply'));
  533.     }
  534.        else {&loadSelectDB()}
  535. }
  536. elsif ($page eq 'tables') {
  537.     my $func = $q->param('func');
  538.     if       ($func =~ /describe/i){&execDescribeTables()}
  539.     elsif ($func =~ /(alter)|(create)/i){&loadAlterTable()}
  540.     elsif ($func =~ /(insert)|(search)/i){&loadInsertForm()}
  541.     elsif ($func =~ /update/i){&loadUpdateForm()}
  542.     elsif ($func =~ /select/i){&execSelectFromTable()}
  543.     elsif ($func =~ /drop/i){&loadDropPreview()}
  544.     elsif ($func =~ /delete/i){&loadDeletePreview()}
  545.     elsif ($func =~ /ddl/i){&execGenerateDDL()}
  546.     elsif ($func =~ /(import)|(export)/i){&loadImportExportFile()}
  547.     elsif ($func =~ /script/i){&loadexecscript()}
  548.     elsif ($func =~ /backup/i){&loadBackup()}
  549.     elsif ($func =~ /restore/i){&loadRestore()}
  550.     else  {print "<P>Select something!"}
  551. }
  552. elsif ($page eq 'search') {
  553.     my $func = $q->param('func');
  554.     if ($func =~ /return/i){&loadInsertForm()}
  555.     else {&execSearch}
  556. }elsif ($page eq 'searchresult') {
  557.     my $func = $q->param('func');
  558.     if        (($func =~ /prev/i) or ($func =~ /next/i)){&searchresult()}
  559.     elsif    ($func =~ /back/i){&loadInsertForm()}
  560.     elsif    ($func =~ /edit/i){&loadInsertForm()}
  561.     elsif    ($func =~ /new/i){&loadInsertForm()}
  562.     elsif    ($func =~ /return/i){&searchresult()}
  563.     elsif    ($func =~ /insert/i){&execInsertData()}
  564.     elsif    ($func =~ /delete/i){&searchresult()}
  565.     elsif    ($print){&searchresult()}
  566.     else    {&execSearch}
  567. }
  568. elsif($page eq 'create'){&execAlterTable}
  569. elsif ($page eq 'insert') {&execInsertData}
  570. elsif ($page eq 'alter') {&execAlterTable}
  571. elsif ($page eq 'update') {&execUpdateData}
  572. elsif ($page eq 'updateAfterPreview') {&execUpdateAfterPreview}
  573. elsif ($page eq 'alterAfterPreview') {&execAlterAfterPreview}
  574. elsif ($page eq 'drop') {&execDropTable}
  575. elsif ($page eq 'delete') {&execDeleteFromTable}
  576. elsif ($page eq 'ddl') {
  577.     if ($q->param('apply')){&execExecuteQuery({page => 'tables', dbname => $database, script => 'back'})}
  578.     else {&loadSelectTables()}
  579. }
  580.  
  581. #++++++++++++++++++++++++++++++++++++++
  582.  
  583. else {print "<B>WRONG DATA</BR>"}
  584. print "\n\n<!-- END OF PROCEDURE BODY -->\n\n";
  585.  
  586. print "\n\n\t\t</TD>\n\t</TR>\n</TABLE><!-- END OF MARGIN TABLE -->\n\n\n\n" unless $print;
  587.  
  588.  
  589. print $q->end_html;
  590. $dbh->disconnect;
  591.  
  592. &printparam;
  593. printPopUp() if $print;
  594. exit;
  595. ####################################################
  596. #-----------------S U B R O U T I N S--------------#
  597. ####################################################
  598. sub quoteit {
  599.     my @output = @_;
  600.     for (my $i=0; $i<@output; $i++) {
  601.         $output[$i] =~ s{(.)}{
  602.             if    ($1 eq '<')        { '<'    }
  603.             elsif ($1 eq '>')        { '>'    }
  604.             elsif ($1 eq '&')        { '&'   }
  605.             elsif ($1 eq '"')        { '"'  }
  606. #            elsif ($1 eq "\x8b")    { '‹'  }
  607. #            elsif ($1 eq "\x9b")    { '›'  }
  608.             else                    { $1        }
  609.        }gsex;
  610.     }
  611.     if (wantarray) {return (@output)}
  612.     else {return $output[0];}
  613. }
  614.  
  615. sub printparam {
  616.     return;
  617.     my @x=$q->param();
  618.     my @values;
  619.     print "\n\n\n\n<!-- PARAMETERS -->\n\n";
  620.     print qq!<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=2 BGCOLOR="#CCCCCC">\n\t<TR VALIGN=TOP>!;
  621.     my $max=1;
  622.     for (my $i=0; $i<@x; $i++) {
  623.         my @y = $q->param($x[$i]);
  624.         $values[$i] = \@y;
  625.         $max = scalar (@y) if (@y>$max);
  626.         print qq!\n\t\t<TD BGCOLOR="#DDDDDD"> $x[$i]</TD>!;
  627.     }
  628.     print "</TR>\n";
  629.     for (my $j=0; $j<$max; $j++) {
  630.         print "\t<TR VALIGN=TOP>\n";
  631.         for (my $i=0; $i<@x; $i++) {
  632.             ${$values[$i]}[$j] =~ s/&/&/g;
  633.             ${$values[$i]}[$j] =~ s/</</g;
  634.             ${$values[$i]}[$j] =~ s/>/>/g;
  635.             print qq!\t\t<TD BGCOLOR="#DDDDDD"> !. ${$values[$i]}[$j] . qq!</TD>\n!;
  636.         }
  637.         print "\t</TR>\n";
  638.     }
  639.     print    "</TABLE>\n";
  640. }
  641.  
  642. sub gethost {
  643.     my $myhost = $_[0];
  644.     my ($host,$port);
  645.     if ($myhost =~ /host=(.*):(\d*)/){$host = $1; $port = $2}    #a ...;host=hostname:3306...
  646.     elsif ($myhost =~ /host=([^;]*);/){$host = $1;}                #b ...;host=hostname;...
  647.     elsif ($myhost =~ /^(.*):(\d*)/){$host = $1; $port = $2}    #c hostname:3306...
  648.     elsif ($myhost =~ /^(.*);/){$host = $1}                        #d hostname;...
  649.     elsif ($myhost =~ /host=(\S+)\s*$/){$host = $1;}            #b+ ...;host=hostname;...
  650.     elsif ($myhost =~ /=/){$host = ''}                            #e no hostname, but other params
  651.     else {$host = $myhost}                                        #f hostname only
  652.     if ($myhost =~ /port=(\d*)/){$port = $1}
  653. #    my ($sth,$res) = prepare_execute("SELECT USER()", {});
  654. #    my ($host) = $sth->fetchrow_array();
  655. #    $host = s/.*@(.*)/$1/;
  656. #    ($sth,$res) = prepare_execute("SELECT VARIABLES() LIKE 'PORT'");
  657. #    my $port = $sth->fetchrow_array();
  658.     if (wantarray){return($host, $port)}
  659.     else {return($host)}
  660. }
  661. sub myhost_ {
  662.     my $myhost;
  663.     unless (defined $_[0]){$myhost = $MySQLhost}
  664.     else {$myhost = $_[0]}
  665.     my ($host,$port);
  666.     if ($MySQLhost =~ /host=(.*):(\d*)/){$host = $1; $port = $2} #a ...;host=hostname:3306...
  667.     elsif ($MySQLhost =~ /host=([^;]*);/){$host = $1;}             #b ...;host=hostname;...
  668.     elsif ($MySQLhost =~ /^(.*):(\d*)/){$host = $1; $port = $2}     #c hostname:3306...
  669.     elsif ($MySQLhost =~ /^(.*);/){$host = $1}                     #d hostname;...
  670.     elsif ($MySQLhost =~ /host=(\S+)\s*$/){$host = $1;}             #b+ ...;host=hostname;...
  671.     elsif ($MySQLhost =~ /=/){$host = ''}                         #e no hostname, but other params
  672.     else {$host = $MySQLhost}                                     #f hostname only
  673.     if ($MySQLhost =~ /port=(\d*)/){$port = $1}
  674. #    my ($sth,$res) = prepare_execute("SELECT USER()", {});
  675. #    my ($host) = $sth->fetchrow_array();
  676. #    $host = s/.*@(.*)/$1/;
  677. #    ($sth,$res) = prepare_execute("SELECT VARIABLES() LIKE 'PORT'");
  678. #    my $port = $sth->fetchrow_array();
  679.     if (wantarray){return($host, $port)}
  680.     else {return($host)}
  681. }
  682. sub printPopUp {
  683.     print "<script language=\"JavaScript1.2\">window.print()</script>" if $PRINT_POP_UP;
  684. }
  685.  
  686. sub startpage {
  687.     my $user_                = "USER: $_[0]" if ($page and ($page ne 'logout' and $page ne 'setup'));
  688.     my $databasename        = $database || "<B>NOT SELECTED</B>";
  689.     my $dbname_             = 'DATABASE: '.$databasename if ($page and $page ne 'logout' and $page ne 'connect' and $page ne 'setup');
  690.     my ($hostname,$port)     = myhost();
  691.     $hostname                 .= ":$port" if $port;
  692.     my $demomarker; 
  693. #++++++++++++++++++++++++++++++++++++++
  694.  
  695.     my $host_ = "HOST: $hostname" if ($page and ($page ne 'logout' and $page ne 'setup'));
  696.     
  697.     my $title = $print ? quoteit($q->param('title')) : "MYSQL DATA MANAGER $VERSION";
  698.     $title = "Untitled" if ($title =~ /^\s*$/);
  699. print <<EndOfHead
  700. <HTML>
  701. <HEAD>
  702. <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=$CHARSET">
  703. <TITLE>$title</TITLE>
  704. </HEAD>
  705.  
  706. EndOfHead
  707. ;
  708. #
  709.     unless ($print){
  710.         print <<EndOfStyle
  711. <STYLE TYPE="text/css">
  712. <!--
  713. TD.header {height: 35px}
  714. P.headh5             {color: white; font-size: 16px; font-weight: bold; font-family: "Verdana", "Tahoma", "Arial", "Geneva"}
  715. A.button            {color: white; font-size: 10px; font-weight: bold; font-family: "Verdana", "Tahoma", "Arial", "Geneva"}
  716. A.button:hover        {color: white; text-decoration: none}
  717. A.button:visited    {color: white; text-decoration: none}
  718. p.shead                {font-size: 9px; font-weight: bold; font-family: "Verdana", "Tahoma", "Arial", "Geneva"}
  719. body        {background: #CCCCCC; font-size: 11px; font-family: "Verdana", "Tahoma", "Arial", "Geneva"}
  720. A            {color: #CC0000; font-weight: bold; text-decoration: none}
  721. A:hover        {color: #CC0000; font-weight: bold; text-decoration: none}
  722. A:visited    {color: #CC0000; font-weight: bold; text-decoration: none}
  723. select, textarea, input, TD,UL, TR, P,BR     {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-size: 11px}
  724. TH            {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-weight: bold; font-size: 11px; color: #003466}
  725. CODE        {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-weight: bold; font-size: 12px}
  726. H5            {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-weight: bold; font-size: 16px; color: $SLOGANCOLOR}
  727. H3            {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-weight: bold; font-size: 12px; color: #003466}
  728. EM            {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-size: 10px}
  729. -->
  730. </STYLE>
  731. EndOfStyle
  732. ;
  733. }
  734.     else {
  735.         print <<EndOfStyle
  736. <STYLE TYPE="text/css">
  737. <!--
  738. body        {background: #FFFFFF; font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-size: x-small}
  739. P,BR        {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-size: x-small}
  740. TD,UL       {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-size: x-small}
  741. TR            {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-size: x-small}
  742. TH            {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-weight: bold; ; font-size: x-small}
  743. CODE        {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-size: small}
  744. H5            {font-family: "Verdana", "Tahoma", "Arial", "Geneva"; font-size: medium}
  745. H3            {font-family: "Verdana", "Tahoma", "Arial", "Geneva"}
  746. EM            {font-family: "Verdana", "Tahoma", "Arial", "Geneva"}
  747. -->
  748. </STYLE>
  749. <BODY bgcolor="#FFFFFF">
  750. EndOfStyle
  751.  
  752. ;
  753.         return;
  754.     }
  755.     my $uprow;
  756.     if ($LOGO){$LOGO = qq!<img src="$LOGO" BORDER=0>!}
  757.     if ($LOGOLINK){
  758.         if ($LOGOTARGET){$LOGOTARGET = qq!target="$LOGOTARGET"!}
  759.         $LOGO = qq!<A HREF="$LOGOLINK" $LOGOTARGET>$LOGO</A>!;
  760.     }
  761.     else {$uprow = <<EOT
  762.     <TR BGCOLOR="$BGCOLOR1">
  763.         <TD WIDTH=20 HEIGHT=15 BGCOLOR="$BGCOLOR1"> </TD>
  764.         <TD BGCOLOR="$BGCOLOR1"> </TD>
  765.     </TR>
  766. EOT
  767. }
  768. #++++++++++++++++++++++++++++++++++++++
  769.     
  770.     my $links =     links();
  771.     print <<HeadTable
  772. <BODY bgcolor="#CCCCCC" link="#CC0000" vlink="#CC0000" alink="#CC0000" text="#000000" TOPMARGIN=0 LEFTMARGIN=0 MARGINWIDTH=0 MARGINHEIGHT=0>
  773. <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH="100%">
  774. $uprow
  775.     <TR>
  776.         <TD COLSPAN=2 BGCOLOR="$BGCOLOR1">
  777. <!-- LOGO TABLE -->
  778.     <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH="100%">
  779.         <TR>
  780.             <TD WIDTH=20> </TD>
  781.             <TD  ALIGN=LEFT HEIGHT=35 WIDTH=600><P CLASS="headh5"><FONT COLOR="$SLOGANCOLOR"><B> $SLOGAN $demomarker </B></FONT></P></TD>
  782.             <TD WIDTH=100 ALIGN=RIGHT><P>$LOGO</TD>
  783.         </TR>
  784.     </TABLE>
  785.         </TD>
  786.     </TR>
  787.     <TR BGCOLOR="$BGCOLOR2">
  788.         <TD COLSPAN=2 BGCOLOR="$BGCOLOR2" HEIGHT=17>
  789. <!-- INFO TABLE -->
  790.     <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH="100%">
  791.         <TR>
  792.             <TD WIDTH=20> </TD>
  793.             <TD><FONT COLOR="$STATUSFONTCOLOR"><NOBR> $user_    $host_    $dbname_ </NOBR></FONT></TD>
  794.             <TD ALIGN=RIGHT><FONT COLOR="$STATUSFONTCOLOR"><NOBR> </NOBR></FONT></TD>
  795.         </TR>
  796.     </TABLE>
  797.         </TD>
  798.     </TR>
  799.     <TR>
  800.         <TD WIDTH=20 HEIGHT=15> </TD>
  801.         <TD> </TD>
  802.     </TR>
  803.     <TR>
  804.         <TD COLSPAN=2>
  805. HeadTable
  806. ;
  807.     print links();
  808.     print <<EOT
  809.         </TD>
  810.     </TR>
  811.     <TR>
  812.         <TD WIDTH=20> </TD>
  813.         <TD><BR>
  814. <!-- PROCEDURE BODY STARTS HERE -->
  815. EOT
  816. ;
  817.  
  818.  
  819. #++++++++++++++++++++++++++++++++++++++
  820. }#startpage
  821.  
  822. sub links {
  823.     my ($url1, $url2, $url3, $url4, $url5, $url6);
  824.     my $func = $q->param('func');
  825.     if ($page and ($page ne 'logout') and $page ne 'setup'){
  826.         if ($database) {
  827.             $url2 = qq!<nobr><A HREF="$full_url?page=select_db&dbname=$database">MAIN PAGE</A></nobr>\n!;
  828.         }
  829.         else {
  830.             $url2 = qq!<nobr><FONT COLOR="#999999">MAIN PAGE</FONT></nobr>\n!;
  831.         }
  832.         my $selectdbname_ = "&selectdbname_=".$q->param('selectdbname_') if $q->param('selectdbname_');
  833.         $url1 = qq!<nobr><A HREF="$full_url?page=connect">SELECT DATABASE</A></nobr>\n!;
  834.         $url3 = qq!<A HREF="$full_url?page=logout">LOG OUT</A>\n!;
  835.         $url5 = qq!<A HREF="$full_url?page=admin&dbname=$database$selectdbname_">ADMINISTRATION</A>\n!;
  836.         $url4 = qq!<A HREF="$HOME">HOME</A>\n! if $HOME;
  837.         $url6 = qq!<A HREF="$HELP" TARGET="_blank">HELP</A>\n! if $HELP;
  838.     }
  839.     elsif($configFile) {
  840.         $url1 = qq!<A HREF="$HOME">HOME</A>\n! if $HOME;
  841.         $url6 = qq!<A HREF="$HELP" TARGET="_blank">HELP</A>\n! if $HELP;
  842.         $url2 = qq!<A HREF="$full_url?page=setup">SETUP</A>\n!;
  843.         $url5 = qq!<A HREF="$full_url?page=logout">EXIT SETUP</A>\n! if ($page eq 'setup');
  844.     }
  845.     else {
  846.         $url1 = qq!<A HREF="$HOME">HOME</A>\n! if $HOME;
  847.         $url2 = qq!<A HREF="$HELP" TARGET="_blank">HELP</A>\n! if $HELP;
  848.     }
  849. return <<EOT
  850.  
  851. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  852.     <TR>
  853.         <TD WIDTH="20"> </TD>
  854.         <TD WIDTH="140">$url1</TD>
  855.         <TD WIDTH="90">$url2</TD>
  856.         <TD WIDTH="150">$url5</TD>
  857.         <TD WIDTH="100">$url3</TD>
  858.         <TD WIDTH="100">$url4</TD>
  859.         <TD WIDTH="130" ALIGN=RIGHT>$url6</TD>
  860.     </TR>
  861. </TABLE>
  862.  
  863. EOT
  864. ;
  865. }
  866.  
  867. sub dropcreatedb{
  868.     my $back = {page => "connect"};
  869.     if ($_[0] eq 'drop') {
  870.         if ($q->param('confirm')) {
  871.             bail_out("Database is not selected",$back) unless $q->param('dbdrop');
  872. #++++++++++++++++++++++++++++++++++++++
  873.             my $query = "DROP DATABASE ".$q->param('dbdrop');
  874.             bail_out("Cannot do query:\n$query", $back) unless ($dbh->do($query));
  875.             &loadSelectDB();     
  876.         }
  877.         else {
  878.             bail_out("Database is not selected",$back) unless $database;
  879.             print "<BR><BR><B>Database $database will be dropped.</B><BR>\n";
  880.               print qq?<BR><B><FONT COLOR="#FF0000"><U>CAUTION!</U> SELECTED DATABASE IS NOT EMPTY</FONT></B><BR>\n? 
  881.                 if (@{getTablelist($database)});
  882.             print <<EndOfDrop
  883.         <FORM METHOD=POST ACTION="$full_url">
  884.         <INPUT TYPE=SUBMIT NAME="confirm"     VALUE="CONFIRM">
  885.         <INPUT TYPE=SUBMIT NAME="cancel"     VALUE="CANCEL">
  886.         <INPUT TYPE=HIDDEN NAME="page"         VALUE="select_db">
  887.         <INPUT TYPE=HIDDEN NAME="dbdrop"     VALUE="$database">
  888.         <INPUT TYPE=HIDDEN NAME="tableops"     VALUE="drop">
  889.         
  890.         </FORM>
  891. EndOfDrop
  892. ;
  893.           
  894.           }
  895.      
  896.      }
  897.      elsif($_[0] eq 'create'){
  898.          my $newdb = $q->param('newDB');
  899.         
  900.          if (($newdb eq '') or ($newdb eq 'NEW DATABASE NAME')){bail_out("Please type new database name in the text field", $back)}
  901.         my $query = "CREATE DATABASE $newdb";
  902.         bail_out("Cannot do query:\n$query", $back) unless ($dbh->do($query));
  903.         &loadSelectDB();     
  904.      }
  905. }
  906.  
  907. sub getuserlist{
  908.     my $query        = "SELECT host, user FROM mysql.user ORDER BY user";
  909.     my $back         = {page => 'connect'};
  910.     $back             = {page => 'select_db', dbname => $database} if $database;
  911.     my $sth         = $dbh->prepare($query) || bail_out ("Cannot prepare query:\n$query", $back);
  912.     my $res         = $sth->execute();
  913.     my @userlist    = ();
  914.     my $labelhash    = ();
  915.     if ($DBI::err){push @userlist, '1'; $labelhash->{'1'} = 'ACCESS DENIED'}
  916. #    elsif (???) {    bail_out ("Cannot execute:\n$query", $back)    }
  917.     else {
  918.         while (my $usersref        = $sth->fetchrow_arrayref) {
  919.             my $label = $usersref->[1].'@'.$usersref->[0];
  920.             $usersref->[0]    = $dbh->quote($usersref->[0]);
  921.             $usersref->[1]    = $dbh->quote($usersref->[1]);
  922.             my $value = $usersref->[1].'@'.$usersref->[0];
  923.             push @userlist, $value;
  924.             $labelhash->{$value} = $label;
  925.         }
  926.     }
  927.     $sth->finish;
  928.     if (@userlist == 0){$userlist[0] = '0'; $labelhash->{'0'} = "User List is empty"}
  929.     if (wantarray){return \@userlist, $labelhash}
  930.     else {return \@userlist}
  931. }
  932. sub getdblist {
  933.     my $dbh                    = shift;
  934.     my $back                = {page => 'select_db', dbname => $q->param('dbname')} if $q->param('dbname');
  935.     my $driversref            = $dbh->selectcol_arrayref("SHOW DATABASES");
  936.     if ($DBI::err){
  937.         if ($DBI::errstr =~ /access/i){$driversref->[0]    = $database if $database}
  938.         else {bail_out("Cannot select Databases", $back)}
  939.     }
  940.     
  941.     #unless ($driversref->[0]) {$driversref->[0]    = ''};
  942.     return $driversref
  943. }
  944. sub getTablelist {
  945.     my $query                 = "SHOW TABLES";
  946.     $query                     .= " FROM $_[0]" if ($_[0]);
  947.     my $back;
  948.     unless ($back = $_[1]){$back = {page => 'connect'}}
  949.     return  $dbh->selectcol_arrayref($query) || bail_out("Failed to execute:\n$query", $back);
  950. }
  951.  
  952. sub getlimit {
  953.     #input: $tabs - number of selected tables
  954.     #output (for each table):
  955.     # limit x,y  - arrayref
  956.     # offset x - arrayref
  957.     # rows y - arrayref
  958.     my $tabs = shift;
  959.     my (@limit, @offset, @rows);
  960.     unless (defined $q->param('limit')) {
  961.         @offset        = $q->param('offset');
  962.         @rows         = $q->param('rows');
  963.         for(my $i=0; $i<$tabs; $i++) {
  964.             $rows[$i]        = $rows[0] unless defined $rows[$i];
  965.             $offset[$i]        = $offset[0] unless defined $offset[$i];
  966.             $limit[$i]        = "$rows[$i]" if (($rows[$i] ne '') and ($offset[$i] eq ''));
  967.             $limit[$i]        ="$offset[$i], $rows[$i]" if (($rows[$i] ne '') and ($offset[$i] ne ''));
  968.         }
  969.     }
  970.     else {
  971.         @limit = $q->param('limit');
  972.         for(my $i=0; $i<$tabs; $i++) {
  973.             $limit[$i] = $limit[0] unless defined $limit[$i];
  974.             if ($limit[$i] =~ /^(.+),(.+)$/){
  975.                $offset[$i] = $1;
  976.                $rows[$i] = $2;
  977.             }
  978.             elsif ($limit[$i] !~ /,/) {
  979.                $offset[$i] = '';
  980.                $rows[$i] = $limit[$i];
  981.             }
  982.         }    
  983.     }
  984.     return (\@limit, \@offset, \@rows)
  985. }
  986.  
  987. sub bail_out {
  988. # $_[0] - error message
  989. # $_[1] - link back if $_[2] is not defined or zero or HIDDEN INPUTs leading back if $_[2]
  990. # $_[2] - if zero $_[1] is interpreted as part of URL, if set $_[1] is HIDDEN INPUTs
  991.     if ($NO_HEADER){
  992.         print $q->header(-expire=>0);
  993.         &startpage($user, $database);    
  994.     }
  995.     my $message = quoteit($_[0]);
  996.     $message =~ s/$/<BR>/mg;
  997.     print "\n\n<!--   ------BAIL_OUT------   -->";
  998.     print "\n\n<P><B>$message</B><BR>";
  999.     if ($DBI::err){
  1000.         my $message_ = quoteit($DBI::errstr);
  1001.         $message_      =~ s/^/<BR>/mg;
  1002.         print "Error  $DBI::err ($message_)\n</P>\n" ;
  1003.     }
  1004.     if ($_[2] eq 2){
  1005.         print qq!</FORM><FORM METHOD=POST ACTION=$full_url>\n!;
  1006.     }
  1007.     elsif (!$_[2]){
  1008.         print qq!<FORM METHOD=POST ACTION=$full_url>\n!;
  1009.     }
  1010.     my $input = $_[1];
  1011.     print qq!<INPUT TYPE=SUBMIT VALUE="Back">\n! unless ($_[2] == 3);
  1012.     foreach (keys %$input){
  1013.         print $q->hidden(-name=>$_, -value=>$_[1]->{$_}, -override=>1),"\n";
  1014.     }
  1015.     print "\n\t\t</FORM></TD>\n\t</TR>\n</TABLE>\n\n\n\n" unless $print;
  1016.     print $q->end_html;
  1017. #---errlog---
  1018. #++++++++++++++++++++++++++++++++++++++
  1019.     
  1020.  
  1021.     $dbh->disconnect() if defined $dbh;
  1022.     $dbh_->disconnect() if defined $dbh_;
  1023.     &printparam();
  1024.     exit 0;
  1025. }
  1026.  
  1027. sub ErrMessage {
  1028.     print $_[0];
  1029.     print qq!<BR><B><FONT COLOR="#FF0000">Error $DBI::err (!, quoteit($DBI::errstr),")</FONT></B><P>" if ($DBI::err);
  1030.     print "\n</FORM>" if $_[1];
  1031.     print "\n</TD></TR></TABLE>" if ($_[1] == 2);
  1032.     
  1033. #++++++++++++++++++++++++++++++++++++++
  1034.  
  1035. }
  1036.  
  1037. sub printresult {
  1038. #input:
  1039. # $_[0] - \$sth
  1040. # $_[1] - offset (running number)
  1041. # $_[2] - if set - mark primary keys
  1042.     my $sthref        = $_[0];
  1043.     my $sth         = $$sthref;
  1044.     my $offset         = ($_[1] + 0);
  1045.     my $array        = [];
  1046.     $array->[0][0]    = qq!<TD BGCOLOR="#CCCCCC">No</TD>\n! if (defined $_[1] and !$print);
  1047.     my $pri            = get_mysql_pri($sth);
  1048.     unless (defined $pri) {$pri = []}
  1049.     my ($bgcolorH, $bgcolor, $bgcolorL, $bordercolor, $cellspacing, $rowheight, $headerheight);
  1050.     my ($border, $bordercolorlight, $bordercolordark, $printtitle);
  1051.     if ($print){
  1052.         $bgcolor=$bgcolorH=$bgcolorL='#FFFFFF';
  1053.         $bordercolor                ='#000000';
  1054.         $cellspacing                 = 0;
  1055.         $rowheight                    = $q->param('rowheight');
  1056.         $headerheight                = $q->param('headerheight');
  1057.         $bordercolorlight             = qq!bordercolorlight="#000000"!;
  1058.         $bordercolordark              = qq!bordercolordark="#000000"!;
  1059.         $border                        = '1';
  1060.         my $title                    = quoteit($q->param('title'));
  1061.         if ($title){
  1062.             my $align                = $q->param('align');
  1063.             my @style                = $q->param('style');
  1064.             
  1065.             foreach(@style){
  1066.                 $title = "<$_>$title</$_>"
  1067.             }                    
  1068.             $printtitle                = "<DIV ALIGN=$align><CODE>$title</CODE></DIV><P>"
  1069.         }
  1070.         $printtitle .= "\n$demomsg2";
  1071.     }
  1072.     else {
  1073.         $bgcolor                      = '#EEEEEE';
  1074.         $bgcolorH                     = '#EEEEEE';
  1075.         $bgcolorL                     = '#CCCCCC';
  1076.         $bordercolor                 = '#CCCCCC';
  1077.         $cellspacing                 = 2;
  1078.         $border                        = '0';
  1079.         $bordercolorlight             = "";
  1080.         $bordercolordark              = "";
  1081.  
  1082.     }
  1083.     for(my $i=0; $i < $sth->{NUM_OF_FIELDS}; $i++) {
  1084.         if ($_[2] and $pri->[$i] and !$print){
  1085.             $array->[0][$i+1] = qq!<TH BGCOLOR="$bgcolorH"><FONT COLOR="#FF0000">$sth->{NAME}[$i]</FONT></TH>!;
  1086.         }
  1087.         else{
  1088.             $array->[0][$i+1] = qq!<TH BGCOLOR="$bgcolorH"><FONT COLOR="#000000">$sth->{NAME}[$i]</FONT></TH>!;
  1089.         }
  1090.     }
  1091.     my $j=1;
  1092.     while (@ary = $sth->fetchrow_array ())    {
  1093.         @ary            = quoteit(@ary);
  1094.         $array->[$j][0] = qq!<TD BGCOLOR="$bgcolorL">!.$offset++ .qq!</TD>! if (defined $_[1] and !$print);
  1095.         for (my $i = 0; $i < @ary; $i++) {
  1096.             $ary[$i] = ' ' if ($ary[$i] eq '' or !defined $ary[$i]);
  1097.             $ary[$i] =~ s/(\r\n)|\n/<BR>/mg;
  1098.             $array->[$j][$i+1] = qq!<TD BGCOLOR="$bgcolor">$ary[$i]</TD>!;
  1099.         }
  1100.         $j++;
  1101.     }
  1102.     unless (defined $array->[0]){$array = [[],[]]}
  1103.     my $result =  "\n<!-- printresult subroutine -->\n";
  1104.     $result    .=  "$printtitle\n";
  1105.     $result    .=  qq!\n\<TABLE BORDER=0  BGCOLOR="$bordercolor" CELLSPACING=0 CELLPADDING=0><TR BGCOLOR="$bordercolor"><TD BGCOLOR="$bordercolor">!;
  1106.     $result       .=  qq!<TABLE BORDER=$border $bordercolorlight $bordercolordark CELLSPACING=$cellspacing CELLPADDING=1>\n!;
  1107.     $result    .= qq!<TR $headerheight>@{$array->[0]}</TR>\n!;
  1108.     for (my $i = 1; $i < @$array; $i++)
  1109.     {$result .=  qq!\t<TR $rowheight>@{$array->[$i]}</TR>\n!;}
  1110.     $result    .= qq!</TABLE></TD>\n!;
  1111.     $result       .= qq!</TR></TABLE>\n!;
  1112.     $result    .= "\n<!-- end of printresult subroutine -->\n";
  1113.     return ($result);
  1114. }
  1115.                         
  1116. sub loadSelectDB {
  1117.     my $databasesref    = getdblist($dbh);
  1118.     my $DBlist;
  1119.     my ($textsize, $textareasize) = $agent ? (16, 35 ) : (25, 50 );
  1120.  
  1121.     if ((not defined $databasesref) and $DBI::err){
  1122.         $DBlist         = $q->scrolling_list(
  1123.                         -labels        => {'' => 'ACCESS DENIED'},
  1124.                         -name        =>'dbname',
  1125.                         -values        =>[''],
  1126.                         -default    =>'',
  1127.                         -size        =>15,
  1128.                         -title        =>'Select database'
  1129.                     );
  1130.     }
  1131.     else {
  1132.         if (@$databasesref == 0){
  1133.             $DBlist     = $q->scrolling_list(
  1134.                         -labels        => {'' => 'List is emplty'},
  1135.                         -name        =>'dbname',
  1136.                         -values        =>[''],
  1137.                         -size        =>15,
  1138.                         -title        =>'Select database'
  1139.                     );
  1140.         }
  1141.         else {
  1142.             $DBlist     = $q->scrolling_list(
  1143.                         -name        =>'dbname',
  1144.                         -values        =>['',@$databasesref],
  1145.                         -default    =>'',
  1146.                         -size        =>15,
  1147.                         -title        =>'Select database'
  1148.                     );
  1149.         }
  1150.     }
  1151.     my $headtab = {
  1152.         name    => 'SELECT DATABASE'
  1153.     };
  1154.     my $SQL = quoteit($q->param('SQL'));
  1155.     print "<FORM METHOD=POST ACTION=\"$full_url\">";
  1156.     printHeaderTable($headtab);            
  1157. print <<EndSelectDB        
  1158.          <INPUT TYPE=HIDDEN NAME="page" VALUE="select_db">
  1159.          <TABLE BORDER=0 CELLSPACING=1 CELLPADDING=1>
  1160.              <TR VALIGN=TOP ALIGN=LEFT>
  1161.                  <TD>
  1162.     <!-- internal BIG table -->
  1163.     <TABLE BORDER=0 BGCOLOR="#AAAAAA" CELLPADDING=1 CELLSPACING=0><TR><TD>    
  1164.     <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  1165.          <TR HEIGHT=220>
  1166.                <TD VALIGN=TOP HEIGHT=220>
  1167. <!-- database list  -->
  1168. $DBlist
  1169.             </TD>             
  1170.                <TD VALIGN=TOP HEIGHT=220>
  1171.          <!-- control table -->
  1172.         <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
  1173.             <TR VALIGN=TOP>
  1174.                 <TD VALIGN=TOP><INPUT TYPE=SUBMIT NAME="tableops" VALUE="  CONNECT  " style="Width: 160px" TITLE="Show tables in selected database"><BR><HR SIZE=1></TD>
  1175.             </TR>
  1176.             <TR>
  1177.                 <TD VALIGN=TOP><A><INPUT TYPE=SUBMIT NAME="tableops" VALUE="   Drop Database    " style="width: 160px; color=#CC0000" TITLE="DROP SELECTED DATABASE"></A><BR><HR SIZE=1></TD>
  1178.               </TR>
  1179.             <TR>
  1180.                 <TD VALIGN=TOP><INPUT TYPE=SUBMIT NAME="tableops" VALUE="  Create Database  " style="width: 160px" TITLE="Create new database"></TD>
  1181.             </TR>
  1182.             <TR>
  1183.                 <TD VALIGN=TOP><INPUT TYPE=TEXT SIZE=$textsize NAME="newDB" TITLE="Type the name of the new database to create"  style="width: 160px" 
  1184.                  onFocus="if(this.value=='NEW DATABASE NAME')this.value='';" onBlur="if(this.value=='')this.value='NEW DATABASE NAME';" VALUE="NEW DATABASE NAME"></TD>
  1185.             </TR>
  1186.             <TR>
  1187.                 <TD VALIGN=TOP> </TD>
  1188.             </TR>
  1189.             <TR>
  1190.                 <TD VALIGN=TOP> </TD>
  1191.             </TR>
  1192.             <TR>
  1193.                 <TD VALIGN=TOP><INPUT TYPE=SUBMIT NAME="func" VALUE="  Create Backup  " style="width: 160px" TITLE="Create new database"><BR><HR SIZE=1></TD>
  1194.             </TR>
  1195.             <TR>
  1196.                 <TD VALIGN=TOP><INPUT TYPE=SUBMIT NAME="func" VALUE="     Restore     " style="width: 160px" TITLE="Create new database"></TD>
  1197.             </TR>
  1198.             <TR>
  1199.                 <TD HEIGHT=4></TD>
  1200.             </TR>
  1201.         </TABLE>
  1202. <!-- end of control table -->
  1203.             </TD>
  1204.         </TR>
  1205.       </TABLE>
  1206.     </TD></TR></TABLE>
  1207.     
  1208.                  </TD>
  1209.                  <TD>
  1210. <!-- query table -->
  1211.     <TABLE BORDER=0 BGCOLOR="#AAAAAA" CELLPADDING=1 CELLSPACING=0><TR><TD>    
  1212.     <TABLE BORDER=0 BGCOLOR="#CCCCCC" CELLPADDING=1 CELLSPACING=0>
  1213.         <TR HEIGHT=220 VALIGN=TOP><TD HEIGHT=220 VALIGN=TOP>    
  1214.              
  1215.             <TABLE BORDER=0>
  1216.             <TR>
  1217.                   <TD><INPUT TYPE=SUBMIT NAME="tableops" VALUE="    Execute Query    " style="width: 150px;" TITLE="Execute SQL Statement"></TD>
  1218.             </TR>
  1219.             <TR><TD><TEXTAREA WRAP=PHYSICAL NAME="SQL" ROWS=8 COLS=$textareasize TITLE="Type SQL Statement to execute">$SQL</TEXTAREA></TD>
  1220.               </TR>
  1221.             </TABLE>
  1222.                 
  1223.             
  1224.     </TD></TR></TABLE>
  1225.     </TD></TR></TABLE>
  1226.  
  1227. <!-- end of query table -->                 
  1228.                  </TD>
  1229.              </TR>
  1230.         </TABLE>
  1231. </FORM>
  1232. EndSelectDB
  1233. ;        
  1234. }
  1235.  
  1236. sub belongsb {
  1237. #    syntax: &belong($ref_array, value)    
  1238.     foreach (@{$_[0]}){if ($_[1] eq $_){return 1}}
  1239.     return 0;
  1240. }
  1241. sub belongs {
  1242. #    syntax: &belong($ref_array, value)    
  1243.     foreach (@{$_[0]}){if ($_[1] =~ /^$_$/i){return 1}}
  1244.     return 0;
  1245. }
  1246.  
  1247. sub prepare_execute {
  1248.     my $query     = $_[0];
  1249.     my $sth        = $dbh->prepare($query) || bail_out ("Cannot prepare query:\n$query", $_[1], $_[2]);
  1250.     my $res        = $sth->execute()         || bail_out ("Can not execute query:\n$query", $_[1], $_[2]);
  1251. return ($sth, $res)
  1252. }
  1253.  
  1254. sub count_rows {
  1255. #input: $table = @_[0];
  1256.     my $query    = "SELECT COUNT(*) FROM $_[0]";
  1257.     my $count    = $dbh->selectrow_array($query, \%attr);
  1258.     my $msg     = "WRONG PARAMETERS.";
  1259.     $msg         .= " CHECK YOUR INPUTS!\n\n" if $page =~ /[(insert)|(search)]/;
  1260.     if ($DBI::errstr){
  1261.         my $back;
  1262.         if ($_[1]){bail_out($msg, $_[1],$_[2])}
  1263.         elsif($database) {bail_out($msg, {page => 'select_db', dbname => "$database"})}
  1264.         else {bail_out($msg, {page => 'connect'})}
  1265.     }
  1266.     
  1267.     return ($count)
  1268. }
  1269.  
  1270. sub loadSelectTables {
  1271.     unless ($database or $q->param('dbname')){bail_out("Database is not selected", {page => "connect"})}
  1272.     $query                        = "SHOW TABLES" ;
  1273.     my ($sth, $res)                = &prepare_execute($query, {page => "connect"});
  1274.     my $table;
  1275.     my $i=0;
  1276.     while (my ($y) = $sth->fetchrow_array ())    {
  1277.         $table .= qq!<OPTION VALUE=$y>$y\n!;
  1278.         $i++;
  1279.     }
  1280.     $sth->finish();
  1281.  
  1282.     if ($i == 0){$table .= qq!<OPTION VALUE="">Table list is empty\n!;}
  1283.  
  1284.     my ($wheresize1, $wheresize2, $limitsize) = $agent ?
  1285.         (18, 18, 5) :
  1286.         (31, 31, 8) ;
  1287.     my $buttonwidth     = '123px';
  1288.     my $buttonwidth2    = $buttonwidth * 2;
  1289.  
  1290.  
  1291. print <<EOT
  1292. <FORM METHOD=POST ACTION=$full_url>
  1293. <INPUT TYPE=HIDDEN NAME="page" VALUE="tables">
  1294. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  1295.  
  1296.  
  1297. <TABLE BORDER=0><!-- main table -->
  1298.     <TR>
  1299.         <TD VALIGN=TOP>
  1300.         <TABLE BORDER=0 WIDTH="100%"><!-- left table -->
  1301.             <TR>
  1302.                 <TH ALIGN=LEFT> TABLES IN "$database"</TH>
  1303.             </TR>
  1304.             <TR>
  1305.                 <TD>
  1306. <SELECT NAME="tables" SIZE=13 MULTIPLE>
  1307. $table
  1308. </SELECT></TD>
  1309.             </TR>        
  1310.         </TABLE>
  1311. <!-- EXTENDER --><TABLE BORDER=0 WIDTH=210 CELLPADDING=0 CELLSPACING=0><TR><TD> </TD></TR></TABLE>
  1312.         </TD>
  1313.         <TD  VALIGN=TOP>
  1314. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%"><!-- right table-->
  1315.     <TR>
  1316.         <TD>
  1317.         
  1318. <!-- SEARCH-MODIFY -->
  1319.  
  1320.          <!-- BORDER START -->
  1321.         <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%">
  1322.             <TR>
  1323.                 <TD width="100%"><TABLE BORDER=0 CELLPADDING=2 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%"><TR><TD>
  1324.  
  1325.  
  1326.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  1327.                 <TR>
  1328.                     <TD><INPUT TYPE=SUBMIT NAME="func" VALUE="Search/Modify"     style="width: $buttonwidth" TITLE="Search/Modify records in selected table"></TD>
  1329.                     <TD><INPUT TYPE=SUBMIT NAME="func" VALUE="       DDL      "    style="width: $buttonwidth" TITLE="Generate CREATE TABLE statements for selected tables"></TD>
  1330.                     <TD><INPUT TYPE=SUBMIT NAME="func" VALUE="    IMPORT    "    style="width: $buttonwidth" TITLE="Import data into table from ASCII file"></TD>
  1331.                     <TD><INPUT TYPE=SUBMIT NAME="func" VALUE="    EXPORT   "    style="width: $buttonwidth" TITLE="Export data from table into ASCII file"></TD>
  1332.                 </TR>
  1333.             </TABLE>
  1334.             <!-- BORDER END --></TD></TR></TABLE></TD></TR></TABLE>
  1335.             
  1336. <!-- END OF SEARCH-MODIFY -->
  1337.         
  1338.         </TD>
  1339.     </TR>
  1340.     <TR>
  1341.         <TD HEIGHT=2></TD>
  1342.     </TR>
  1343.     <TR>        
  1344.         <TD>
  1345.         
  1346.         
  1347. <!-- DESCRIBE, INSERT, ALTER, CREATE -->
  1348.         <!-- BORDER START -->
  1349.         <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%">
  1350.             <TR>
  1351.                 <TD WIDTH="100%"><TABLE BORDER=0 CELLPADDING=2 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%"><TR><TD>
  1352.  
  1353.             
  1354.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>        
  1355.                 <TR><TD><INPUT TYPE=SUBMIT NAME="func" VALUE="DESCRIBE"  style="width: $buttonwidth" TITLE="List columns for selected tables"></TD>
  1356.                     <TD><INPUT TYPE=SUBMIT NAME="func" VALUE="  INSERT  " style="width: $buttonwidth" TITLE="Insert new record into selected table"></TD>
  1357.                     <TD><INPUT TYPE=SUBMIT NAME="func" VALUE="   ALTER  "  style="width: $buttonwidth" TITLE="Alter selected table"></TD>
  1358.                     <TD><INPUT TYPE=SUBMIT NAME="func" VALUE="  CREATE  "  style="width: $buttonwidth" TITLE="Create new table"></TD>
  1359.                 </TR>
  1360.             </TABLE>
  1361.             <!-- BORDER END --></TD></TR></TABLE></TD></TR></TABLE>
  1362.             
  1363. <!-- END OF DESCRIBE, INSERT, ALTER, CREATE -->            
  1364.         </TD>
  1365.     </TR>
  1366.     <TR>
  1367.         <TD HEIGHT=2></TD>
  1368.     </TR>
  1369.     <TR>        
  1370.         <TD>
  1371. <!-- UPDATE -->
  1372.  
  1373.         <!-- BORDER START -->
  1374.         <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%">
  1375.             <TR>
  1376.                 <TD WIDTH="100%"><TABLE BORDER=0 CELLPADDING=2 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%"><TR><TD>
  1377.  
  1378.  
  1379.             <TABLE BORDER=0  CELLPADDING=0 CELLSPACING=0>
  1380.                 <TR><TD WIDTH=100><INPUT TYPE=SUBMIT NAME="func" VALUE="  UPDATE "  style="width: $buttonwidth"  TITLE="Edit records in selected table"></TD>
  1381.                     <TD> where <INPUT TYPE=TEXT NAME="updateWhere" VALUE="" SIZE=$wheresize1 TITLE="Define which records to display for editing"></TD>
  1382.                     <TD> limit <INPUT TYPE=TEXT NAME="updateLimit" VALUE="0,$UpdateRows" SIZE=$limitsize TITLE="Define start record and number of records to be displayed"></TD>
  1383.                 </TR>
  1384.             </TABLE>
  1385.             <TABLE BORDER=0  CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
  1386.                 <TR><TD HEIGHT=2 COLSPAN=3></TD>
  1387.                 </TR> 
  1388.  
  1389.             <!--    <TR><TD WIDTH=10> </TD>
  1390.                     <TD> order by <INPUT TYPE=TEXT NAME="updateOrder" VALUE="" SIZE=10> </TD>
  1391.                     <TD> offset <INPUT TYPE="TEXT" NAME="updateStart" VALUE="0" SIZE=5> rows <INPUT TYPE=TEXT NAME="updateRows" VALUE="$UpdateRows" SIZE=5 MAXLENGTH=3></TD>
  1392.                 </TR> -->
  1393.             </TABLE>
  1394.             
  1395.              <!-- BORDER END --></TD></TR></TABLE></TD></TR></TABLE>
  1396.             
  1397. <!-- END OF UPDATE -->
  1398.         </TD>
  1399.     </TR>
  1400.     <TR>
  1401.         <TD HEIGHT=2></TD>
  1402.     </TR>
  1403.     <TR>
  1404.         <TD>
  1405. <!-- SELECT -->    
  1406.          <!-- BORDER START -->
  1407.         <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%">
  1408.             <TR>
  1409.                 <TD width="100%"><TABLE BORDER=0 CELLPADDING=2 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%"><TR><TD>
  1410.         
  1411.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 BGCOLOR="#CCCCCC">
  1412.                 <TR>
  1413.                     <TD WIDTH=100><INPUT TYPE=SUBMIT NAME="func" VALUE="SELECT all" style="width: $buttonwidth"  TITLE="Show records in selected tables"></TD>
  1414.                     <TD> where <INPUT TYPE=TEXT NAME="where" VALUE="" SIZE=$wheresize1 TITLE="Define which records to be displayed"></TD>
  1415.                     <TD> limit <INPUT TYPE=TEXT NAME="limit" VALUE="0,$SelectRows" SIZE=$limitsize TITLE="Define start record and number of records to be displayed"></TD>
  1416.                 </TR>
  1417.             </TABLE>
  1418.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%" BGCOLOR="#CCCCCC">
  1419.                 <TR><TD HEIGHT=2 COLSPAN=5></TD>
  1420.                 </TR> 
  1421.             <!--    <TR><TD WIDTH=10> </TD>
  1422.                     <TD ALIGN=RIGHT>group by </TD>
  1423.                     <TD><INPUT TYPE=TEXT NAME="groupby" SIZE=11  TITLE="Define the columns to group selected records by"> </TD>
  1424.                     <TD ALIGN=RIGHT>order by </TD>
  1425.                     <TD><INPUT TYPE=TEXT NAME="orderby" SIZE=11 TITLE="Define the columns to order selected records by"> </TD>
  1426.                     <TD>limit </TD>
  1427.                     <TD> </TD>
  1428.                 </TR>    -->
  1429.             </TABLE> <!-- BORDER END --></TD></TR></TABLE></TD></TR></TABLE>
  1430. <!-- END OF SELECT -->
  1431.         </TD>
  1432.     </TR>                
  1433.     <TR><TD HEIGHT=2></TD>
  1434.     </TR>
  1435.     <TR>
  1436.         <TD>
  1437. <!-- DELETE -->
  1438.  
  1439.          <!-- BORDER START -->
  1440.         <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%">
  1441.             <TR>
  1442.                 <TD width="100%"><TABLE BORDER=0 CELLPADDING=2 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%"><TR><TD>
  1443.  
  1444.  
  1445.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
  1446.                 <TR>
  1447.                     <TD WIDTH=100><INPUT TYPE=SUBMIT NAME="func" VALUE="  DELETE  " style="width: $buttonwidth; color: #CC0000"  TITLE="DELETE RECORDS FROM SELECTED TABLE"></TD>
  1448.                     <TD> where <INPUT TYPE=TEXT NAME="wheredelete" VALUE="" TITLE="Define which record to delete from selected table.\nIF THIS FIELD IS BLANK, ALL RECORDS WILL BE DELETED" SIZE=$wheresize2></TD>
  1449.                 </TR>
  1450.             </TABLE>
  1451.             <!-- BORDER END --></TD></TR></TABLE></TD></TR></TABLE>
  1452. <!-- END OF DELETE -->
  1453.         </TD>
  1454.     </TR>
  1455.     <TR><TD HEIGHT=2></TD>
  1456.     </TR>
  1457.     <TR>
  1458.         <TD>
  1459. <!-- DROP -->
  1460.  
  1461.          <!-- BORDER START -->
  1462.         <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%">
  1463.             <TR>
  1464.                 <TD width="100%"><TABLE BORDER=0 CELLPADDING=2 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%"><TR><TD>
  1465.  
  1466.  
  1467.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
  1468.                 <TR>
  1469.                     <TD WIDTH=100><INPUT TYPE=SUBMIT NAME="func" VALUE="   DROP   "  style="width: $buttonwidth; color: #CC0000" TITLE="DROP SELECTED TABLES"></TD>
  1470.                 </TR>
  1471.             </TABLE>
  1472.             <!-- BORDER END --></TD></TR></TABLE></TD></TR></TABLE>
  1473. <!-- END OF DROP -->
  1474.         </TD>
  1475.     </TR>
  1476.     <TR><TD HEIGHT=2></TD>
  1477.     <TR>            
  1478.         <TD>
  1479. <!-- EXECUTE SCRIPT CONTROL -->
  1480.  
  1481.          <!-- BORDER START -->
  1482.         <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%">
  1483.             <TR>
  1484.                 <TD width="100%"><TABLE BORDER=0 CELLPADDING=2 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%"><TR><TD>
  1485.  
  1486.  
  1487.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
  1488.                 <TR>
  1489.                     <TD WIDTH="25%"><INPUT TYPE=SUBMIT NAME="func" VALUE="SQL SCRIPTS" style="width: $buttonwidth" TITLE="CREATE, RUN AND SAVE SQL SCRIPTS"></TD>
  1490.                     <TD WIDTH="25%"><INPUT TYPE=SUBMIT NAME="func" VALUE=" BACKUP DB " style="width: $buttonwidth" TITLE="CREATE DUMP FILES"></TD>
  1491.                     <TD WIDTH="25%"><INPUT TYPE=SUBMIT NAME="func" VALUE="RESTORE DB " style="width: $buttonwidth" TITLE="RESTORE FROM DUMP FILES"></TD>
  1492.                     <TD WIDTH="25%"></TD>
  1493.                 </TR>
  1494.             </TABLE>
  1495.             <!-- BORDER END --></TD></TR></TABLE></TD></TR></TABLE>
  1496. <!-- END EXECUTE SCRIPT CONTROL -->        
  1497.         
  1498.         
  1499.         </TD>
  1500.     </TR>
  1501. </TABLE> <!-- END OF RIGHT INNER TABLE -->
  1502.  
  1503.         </TD>
  1504.     </TR>
  1505. </TABLE><!-- END OF MAIN TABLE -->
  1506. </FORM>
  1507. EOT
  1508. ;
  1509.  
  1510.     return
  1511. }
  1512.  
  1513. sub execDescribeTables {
  1514.     print "\n<!-- Describe procedure starts here -->\n";
  1515.     my $headtab = {name    => 'DESCRIBE'};
  1516.     printHeaderTable({name => 'DESCRIBE'});
  1517.     my @tabs = $q->param('tables');
  1518.     if (@tabs == 0 or !$tabs[0]){
  1519.         bail_out ("Table is not specified.", {page => 'select_db', dbname => "$database"});
  1520.     }
  1521.     
  1522. AA:    foreach my $table (@tabs) {
  1523.         print qq!<CODE TITLE="Colums and keys info on table "$table"">TABLE:  $table</CODE><BR>!;
  1524.         my @query = ("DESCRIBE $table", "SHOW INDEX FROM $table");
  1525.         foreach (@query) {
  1526.             my $sth = $dbh->prepare($_);
  1527.             my $res = $sth->execute();
  1528.             if ($DBI::err) {
  1529.                 print "<BR><B>Error $DBI::err (", quoteit($DBI::errstr),")</B><P>";
  1530.                 $sth->finish;
  1531.                 next AA;
  1532.             }
  1533.             print &printresult(\$sth);
  1534.             if ($DBI::err) {ErrMessage ("(Table $table)Print Result Error. $DBI::err $DBI::errstr")}
  1535.             print "<BR>";
  1536.             $sth->finish;
  1537.         }
  1538.         print "\n<HR SIZE=1 LENGTH=700><P>\n"    
  1539.     }
  1540.     print "\n<!-- Describe procedure ends here -->\n";
  1541.     return;
  1542. }
  1543.     
  1544. sub    loadInsertForm {
  1545. # INSERT / SEARCH / EDIT DATA FORM
  1546.     print "<!-- Insert/Search/Modify procedure starts here -->" unless $q->param('update');
  1547.     my @tabs = $q->param('tables');
  1548.     my $array;
  1549.     my $back = {dbname => "$database", page => "select_db"};
  1550.  
  1551.     if ((@tabs == 0) or !$tabs[0]){
  1552.         bail_out("Table is not specified.", $back);
  1553.     }
  1554.     elsif  (@tabs >=2) {
  1555.         bail_out("Too many tables were selected.", $back);
  1556.     }
  1557.     $back->{tables}    = "$tabs[0]";
  1558.     $back->{page}    = '';
  1559.     $back->{func}    = 'return';
  1560.     
  1561.     my $ProcName;
  1562.     my $func = $q->param('func');
  1563.     my $editdata;
  1564.     my $goback;
  1565.     my ($hiddeninput, $hiddeninput1);
  1566.     my $msg         = $_[0];
  1567.     my $rowhint;
  1568.     
  1569.     if ($page eq 'searchresult')  {
  1570.         my @fields         = $q->param('fields');
  1571.         my $where         = $q->param('where');
  1572.         my $order         = $q->param('order');
  1573.         my $start         = $q->param('start');
  1574.         my $rows          = $q->param('rows');
  1575.         my $where_        = quoteit($where);
  1576.         my $count        = $q->param('count');
  1577.         $hiddeninput = $q->hidden(-name=>'fields', -value=>\@fields, -override=>1);
  1578.         $hiddeninput .= <<EndOfInsHidden
  1579. <INPUT TYPE=HIDDEN NAME="order" VALUE="$order">
  1580. <INPUT TYPE=HIDDEN NAME="where" VALUE="$where_">
  1581. <INPUT TYPE=HIDDEN NAME="start" VALUE="$start">
  1582. <INPUT TYPE=HIDDEN NAME="rows" VALUE="$rows">
  1583. <INPUT TYPE=HIDDEN NAME="count" VALUE="$count">
  1584. EndOfInsHidden
  1585. ;
  1586.          $hiddeninput1 = $hiddeninput unless ($func =~ /back/i);
  1587.  
  1588.         $back->{page}    = 'searchresult';
  1589.         $back->{start}    = "$start";
  1590.         $back->{rows}     = "$rows";
  1591.         $back->{fields}    = \@fields;
  1592.         $back->{where}    = "$where";
  1593.         $back->{order}    = "$order";
  1594.  
  1595.         $goback = <<EndGoBack
  1596. <FORM ACTION="$full_url" METHOD=POST>
  1597. <INPUT TYPE=SUBMIT VALUE="Back to search result" TITLE="Go back to Search Result page" style="width: 190px">
  1598. <INPUT TYPE=HIDDEN NAME="tables" VALUE="$tabs[0]">
  1599. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  1600. <INPUT TYPE=HIDDEN NAME="func" VALUE="return">
  1601. <INPUT TYPE=HIDDEN NAME="page" VALUE="searchresult">
  1602. $hiddeninput
  1603. </FORM>
  1604. EndGoBack
  1605. ;
  1606.         if ($func =~ /^\s*edit/i){
  1607.             $rowhint = 'Edit this value';
  1608.             my $query;
  1609.             my @updatewhere;
  1610.             my @selectrow        = $q->param('SelectRow');
  1611.             if (@selectrow and !$msg){
  1612.                 $msg = "<CODE>ROW No $selectrow[0]</CODE>"
  1613.             } 
  1614.             if ($q->param('update')){
  1615.                 @updatewhere = $q->param('updatewhere');
  1616.                 $where = shift @updatewhere; #process curent row
  1617.                 execSearchupdate($back, $where);
  1618.                 unless (@updatewhere) {searchresult(); return}
  1619.             }
  1620.             else {
  1621.  
  1622.                 bail_out('Please select a row(s)', $back) unless (@selectrow);
  1623.                 $query         = "SELECT *  FROM $tabs[0]";
  1624.                 $query         .= " $where" if $where;
  1625.                 $query         .= " $order";
  1626.                 my $callgetwhere = {
  1627.                     count => "$count", 
  1628.                     table => "$tabs[0]", 
  1629.                     start => "$start", 
  1630.                     rows => "$rows", 
  1631.                     query => "$query", 
  1632.                     back => $back, 
  1633.                     returnarray => 1
  1634.                 };
  1635.                 my $updatewhere     = getwhere($callgetwhere);
  1636.                 @updatewhere        = @$updatewhere;
  1637.             }
  1638.             my $selectedrow = $selectrow[0] + 1;
  1639.             $hiddeninput1 .= qq!<INPUT TYPE=HIDDEN NAME="SelectRow" VALUE="$selectedrow">\n!; 
  1640.             $where = $updatewhere[0];  #show next row
  1641.             $query    = "SELECT * FROM $tabs[0] WHERE $where";
  1642.             $ProcName         = 'EDIT RECORD';
  1643.             $func               = 'edit';
  1644. #            print "QUERY = $query<BR>";
  1645.             my($sth,$res)    = prepare_execute($query, {page=>'select_db', dbname=>"$database"});
  1646.             bail_out("Too many results. Please report this event to tech\@edatanew.com", $back ) if ($res > 1);
  1647.             bail_out("Record was not found. Please report this event to tech\@edatanew.com", $back) if ($res == 0);
  1648.             $editdata = $sth->fetchrow_hashref();
  1649.             $sth->finish;
  1650.             foreach (@updatewhere){$hiddeninput1 .= qq!<INPUT TYPE=HIDDEN NAME="updatewhere" VALUE="$_">\n!;}
  1651.             $hiddeninput1 .= qq!<INPUT TYPE=HIDDEN NAME="update" VALUE="1">!; 
  1652.         }
  1653.         elsif ($func =~ /new/i){$func = 'insert'}
  1654.         elsif ($func =~ /back/i){$func = 'search'; $page= 'search';}
  1655.     }
  1656.     elsif ($page eq 'tables'){
  1657.         if($func =~ /insert/i){$func= 'insert'; $page= 'insert';}
  1658.         if($func =~ /search/i){$func= 'search'; $page= 'search';}
  1659.     }
  1660.     if($func eq 'insert'){
  1661.         $ProcName = 'INSERT DATA';
  1662.         $rowhint  = 'Type new value to insert'; 
  1663.     }
  1664.     elsif ($func =~ /^\s*search/i or $page eq 'search'){
  1665.         $ProcName = 'SEARCH RECORDS';$func= 'search';
  1666.         $rowhint  = 'Type search pattern or values (delimited by comma, if applicable)';
  1667.     }
  1668.     
  1669.     my $query         = "DESCRIBE $tabs[0]";
  1670.     my $sth            = $dbh->prepare($query) || bail_out("Cannot prepare query:\n$query",{page => 'select_db', dbname => "$database"});
  1671.     my $res            = $sth->execute         || bail_out("Cannot execute query:\n$query",{page => 'select_db', dbname => "$database"});
  1672.     my $count        = count_rows($tabs[0],{page => 'select_db', dbname => "$database"});
  1673.     my $textsize;
  1674.     my $textareasize;
  1675.     my $namelist;
  1676.     my $insertOptions;
  1677.     my $showfields;
  1678.     my $delayed        = qq!<I>Delayed</I><INPUT TYPE=RADIO NAME="insert_option1" VALUE="DELAYED" TITLE="Delayed Insertion">!    if $func eq 'insert';
  1679.     
  1680.     $array->[0][0]    = qq!<TH ALIGN=LEFT> $sth->{NAME}->[0]</TH>!;
  1681.  
  1682.     # CORRECT THIS LINE TO USE UNQUOTED DATA FOR SEARCHING (DELETE unless CONDITION).
  1683.     $array->[0][1]    = qq!<TH> Unquoted <BR>Data<BR>(funcion)</TH>!             unless ($func eq 'search');
  1684.  
  1685.     $array->[0][2]    = qq!<TH> Upload </TH>!                                     unless ($func eq 'search');
  1686.     $array->[0][3]    = qq!<TH ALIGN=CENTER>I n s e r t  D a t a</TH>!             if $func eq 'insert';
  1687.     $array->[0][3]    = qq!<TH ALIGN=CENTER>S e a r c h  P a t t e r n</TH>!     if $func eq 'search';
  1688.     $array->[0][3]    = qq!<TH ALIGN=CENTER>M o d i f y  D a t a</TH>!             if $func eq 'edit';
  1689.     
  1690.     my $i;
  1691.     if ($func eq 'search'){
  1692.         $array->[0][5]    = qq!<TH ALIGN=CENTER COLSPAN=2 ALIGN=TOP>Advanced search</TH>!;
  1693.         $textsize        = $agent ? 18 : 31;
  1694.         $textareasize    = $agent ? 17 : 30;
  1695.         $namelist        = qq!<SELECT NAME="sort" TITLE="Select column to sort by">\n<OPTION VALUE="">\n!;
  1696.     }
  1697.     else {
  1698.         for ($i=1; $i<($sth->{NUM_OF_FIELDS}-1); $i++) {
  1699.             $array->[0][$i+3] = qq!<TH ALIGN=CENTER> $sth->{NAME}->[$i] </TH>\n!;
  1700.         }
  1701.         $textsize        = $agent ? 36 : 60;
  1702.         $textareasize    = $agent ? 35 : 59;
  1703.     }
  1704.     my $textflag;
  1705.     my $bottomMessage;
  1706.     my $j = 1;
  1707.     while (@ary = $sth->fetchrow_array ())    {
  1708.         my $k=$j-1;
  1709.         ($ary[1],$ary[4],$editdata->{$ary[0]}) = quoteit($ary[1],$ary[4],$editdata->{$ary[0]});
  1710.         my $value = $editdata->{$ary[0]};
  1711.         $array->[$j][0]= qq!<TD> <B>$ary[0] </B></TD>!;
  1712.         if ($ary[1] =~ /^\s*enum/ or $ary[1] =~ /^\s*set/){
  1713.            $array->[$j][1]= qq!<TD ALIGN=CENTER> - </TD>!;
  1714.         }
  1715.         else {
  1716.  
  1717.             $array->[$j][1]= qq!<TD ALIGN=CENTER> <INPUT TYPE=CHECKBOX NAME="unquote" VALUE="$ary[0]" TITLE="Check to insert Functions"> </TD>!;
  1718.         }
  1719.         my $ary1 = $ary[1];
  1720.         $ary1 =~ s/^\s*//;
  1721.         $ary1 =~ s/\W.*//g;
  1722.         my $type = $ary[1];
  1723.         if (belongs(\@textdata, $ary1)){
  1724.             if ($func eq 'search'){
  1725.                 $array->[$j][3]= qq!<TD> <TEXTAREA NAME="$ary[0]_data" COLS=$textareasize ROWS=1 WRAP=OFF TITLE="$rowhint"></TEXTAREA> </TD>\n!;
  1726.             }
  1727.             else {
  1728.                 $array->[$j][2]    = qq!<TD ALIGN=CENTER> <INPUT TYPE = CHECKBOX \t NAME = "upload"\tVALUE = "$ary[0]" TITLE="Check to upload file"> </TD>!;
  1729.                 $array->[$j][3]    = qq!<TD><TEXTAREA NAME="$ary[0]_data" COLS=$textareasize ROWS=5 WRAP=OFF TITLE="$rowhint">$editdata->{$ary[0]}</TEXTAREA> <BR>\n!;
  1730.                 $array->[$j][3] .= qq! <INPUT TYPE=FILE \t\t NAME="$ary[0]_data_upload" \tVALUE="" TITLE="Select file to upload"> </TD>!;
  1731.                 $textflag = 1;
  1732.             }
  1733.         } 
  1734.         elsif($ary[1] =~ /^\s*enum\s*\((.*)\)/){
  1735.             $type = 'enum';
  1736.             $array->[$j][2]        = qq!<TD ALIGN=CENTER> - </TD>!;
  1737.             $array->[$j][3]        = qq!<TD> <SELECT NAME="$ary[0]_data" TITLE="Select value">\n!;
  1738.             $array->[$j][3]     .= qq!\t<OPTION VALUE="">\n!;
  1739.             my @enumval = split ',',$1;
  1740.             foreach (@enumval){
  1741.                 s/^'(.*)'$/$1/;
  1742.                 s/''/'/g;
  1743.                 my $selected    = 'SELECTED' if (($_ eq $editdata->{$ary[0]}) and ($func eq 'edit'));
  1744.                 $array->[$j][3]    .= qq!\t<OPTION VALUE="$_" $selected>$_\n!;
  1745.             }
  1746.             $array->[$j][3]        .= qq!</SELECT> </TD>!;
  1747.         }
  1748.         else {
  1749.              $array->[$j][2]    = qq!<TD ALIGN=CENTER> - </TD>!;
  1750.              $array->[$j][3]    = qq!<TD><INPUT TYPE=TEXT \t\t NAME="$ary[0]_data"\tVALUE="$editdata->{$ary[0]}" SIZE=$textsize TITLE="$rowhint"></TD>!;
  1751.         }
  1752.         if ($func eq 'search'){
  1753.             
  1754.             #DELETE THIS LINE IF YOU NEED TO SEARCH BY UNQUOTED DATA
  1755.             $array->[$j][1] = ''; 
  1756.             
  1757.             #THE REMARKED 'OPTIONS' ARE SUPPORTED BY THE PROGRAM. UNREMARK THEM IF NEEDED.
  1758.             
  1759.             $array->[$j][6]        = qq!<TD ALIGN=LEFT> <EM>$type</EM> </TD>!;
  1760.             my $typename        = $ary[1];
  1761.             $typename            =~ s/^\s*([a-zA-z])\s*\W.*//i;
  1762.             $namelist            .= qq!<OPTION VALUE="$ary[0]">$ary[0]\n!;
  1763.             $showfields            .= qq!<OPTION VALUE="$ary[0]" SELECTED>$ary[0]\n!;
  1764.             my $oper_options    = qq!<OPTION VALUE="">\n!;
  1765.             $oper_options         .= qq!<OPTION VALUE="start">Starts with\n!    unless ($type eq 'enum');
  1766.             $oper_options         .= qq!<OPTION VALUE="end">Ends with\n!        unless ($type eq 'enum');
  1767.             $oper_options         .= qq!<OPTION VALUE="AND">AND (ALL)\n!        unless ($type eq 'enum');
  1768.             $oper_options         .= qq!<OPTION VALUE="OR">OR (ANY)\n!        unless ($type eq 'enum');
  1769.             $oper_options         .= qq!<OPTION VALUE=">">>\n!;
  1770. #            $oper_options         .= qq!<OPTION VALUE=">=">>=\n!;
  1771.             $oper_options         .= qq!<OPTION VALUE="<"><\n!;
  1772. #            $oper_options         .= qq!<OPTION VALUE="<="><=\n!;
  1773.             $oper_options         .= qq!<OPTION VALUE="=">=\n!;
  1774.             $oper_options         .= qq!<OPTION VALUE="BETWEEN">BETWEEN\n!    unless (($type eq 'enum') or (!check_version("3.21.2")));
  1775.             $oper_options         .= qq!<OPTION VALUE="IN">IN\n!                unless ($type eq 'enum');
  1776. #            $oper_options         .= qq!<OPTION VALUE="REGEXP">REGEXP\n!        unless ($type eq 'enum');
  1777. #            $oper_options         .= qq!<OPTION VALUE="LIKE">LIKE\n!;
  1778.             $oper_options         .= qq!<OPTION VALUE="NULL">NULL\n!;
  1779. #            $oper_options         .= qq!<OPTION VALUE="FUNCTION">FUNCTION\n!;
  1780.  
  1781.             $array->[$j][$i+4] =
  1782.             qq!<TD> <SELECT NAME="operator_$ary[0]" TITLE="Select search criterion">$oper_options</SELECT> </TD>!;
  1783.         
  1784.                 my $matchcase        = qq!<INPUT TYPE=CHECKBOX NAME="case_$ary[0]" TITLE="Case sensitive searching">match case ! if check_version("3.23.00");
  1785.             $array->[$j][$i+5]    = qq!<TD><nobr><INPUT TYPE=CHECKBOX NAME="not_$ary[0]" TITLE="Inverse search criterion">not $matchcase</nobr></TD>!;
  1786.         }        
  1787.         else {
  1788.             my $i;
  1789.             $array->[$j][4]        = qq!<TD ALIGN=LEFT> <EM>$type</EM> </TD>!;
  1790.             for (my $i=2; $i<(@ary - 1); $i++){
  1791.                 my $color1;
  1792.                 my $color2        = "</FONT>";
  1793.                 my $font1        = '<EM>';
  1794.                 my $font2        = '</EM>';
  1795.                 if (($i==3 and ($ary[3] =~ /PRI/)) or ($i == 5 and ($ary[5] =~ /auto/i))){
  1796.                     $color1        = qq!<FONT COLOR = '#CC0000'>!;
  1797.                     $font1        = '';
  1798.                     $font2        = '';
  1799.                 }
  1800.                 $array->[$j][$i+3] = qq!<TD> $font1$color1$ary[$i]$color2$font2 </TD>!;
  1801.             }
  1802.         }
  1803.         
  1804.         $j++;
  1805.     } #WHILE
  1806.     $sth->finish();
  1807.     if ($func eq 'search'){
  1808.         my $rowspan             = $j + 1;
  1809.         my $size                 = $j - 1;
  1810.         $namelist                 .= qq!</SELECT> \n!;
  1811.         $showfields             = qq!<SELECT MULTIPLE NAME="fields" SIZE=$size TITLE="Select columns to be displayed in the result">\n!.$showfields;
  1812.         $showfields             .= qq!</SELECT> \n!;
  1813.         $bottomMessage             = "<LI>The Arguments are <U>comma separated</U>.";
  1814.         my $criterion             = <<EndOfCriterion
  1815. <TABLE BORDER=0 CELLPADDIND=2 CELLSPACING=1>
  1816.     <TR>
  1817.         <TD> 
  1818.         </TD>
  1819.     </TR>
  1820.     <TR>
  1821.         <TD ALIGN=RIGHT>Sort by <BR>$namelist</TD>
  1822.     </TR>
  1823.     <TR>
  1824.         <TD ALIGN=RIGHT>Sort Order <BR><SELECT NAME="sortorder" TITLE="Select between ascending and descending ordering">
  1825. <OPTION VALUE="ASC">Ascending
  1826. <OPTION VALUE="DESC">Descending
  1827. </SELECT> </TD>
  1828.     </TR>
  1829.     <TR>
  1830.         <TD ALIGN=RIGHT HEIGHT=6></TD>
  1831.     </TR>
  1832.     <TR>
  1833.         <TD ALIGN=RIGHT>Start <INPUT TYPE=TEXT SIZE=4 NAME="start" VALUE=0 TITLE="Define record search result displaing will start from"> </TD>
  1834.     </TR>
  1835.     <TR>
  1836.         <TD ALIGN=RIGHT>Hits <INPUT TYPE=TEXT SIZE=4 NAME="rows" VALUE=10 TITLE="Define number of records per page to be displayed"> </TD>
  1837.     </TR>
  1838.     <TR>
  1839.         <TD ALIGN=RIGHT TITLE="Select logical operator OR or AND">logical <SELECT NAME="andor" TITLE="Select logical operator OR or AND">
  1840. <OPTION VALUE="OR" SELECTED>OR
  1841. <OPTION VALUE="AND">AND
  1842. </SELECT> </TD>
  1843.     </TR>
  1844.     <TR>
  1845.         <TD ALIGN=RIGHT>Show columns <BR>in search result <BR>$showfields</TD>
  1846.     </TR>
  1847.  
  1848. </TABLE>
  1849. EndOfCriterion
  1850. ;
  1851.         push @{$array->[0]},"<TD ROWSPAN=$rowspan VALIGN=TOP>$criterion </TD>";
  1852.         push @{$array->[0]},"<TH ALIGN=CENTER> $sth->{NAME}->[1] </TH>\n";
  1853.  
  1854.     }
  1855.     else {
  1856.         my $word = 'UPDATE';
  1857.          
  1858.         if ($func eq 'insert'){
  1859.             my @insmethod = (
  1860.                     $q->radio_group(
  1861.                         -name=>'insmethod', 
  1862.                         -values=>['INSERT'], 
  1863.                         -default=>'INSERT', 
  1864.                         -labels=>{INSERT => ''}
  1865.                         ),
  1866.                     $q->radio_group(
  1867.                         -name=>'insmethod', 
  1868.                         -values=>['REPLACE'], 
  1869.                         -default=>'-', 
  1870.                         -labels=>{REPLACE => ''}
  1871.                         )
  1872.             );
  1873.             
  1874.             $word =  qq![INSERT $insmethod[0] | REPLACE $insmethod[1]]!;
  1875.         }
  1876.         my $ignore = qq![<I> Ignore</I><INPUT TYPE=CHECKBOX NAME="insert_option2" VALUE = "IGNORE" TITLE="Ignore rows that duplicate values for unique keys">]! if (($func eq 'insert') or check_version('3.23.16'));
  1877.         $insertOptions = <<EOT
  1878.             $word [<I> Low_Priority</I><INPUT TYPE=RADIO NAME="insert_option1" VALUE = "LOW_PRIORITY" TITLE="Defer the statement until no clients are reading from the table">
  1879.             $delayed ]
  1880.             $ignore
  1881. EOT
  1882. ;
  1883.         $bottomMessage = <<EOT
  1884.         
  1885. <LI>To import data into<B> Text </B>and <B>Blob</B> fields from local file, select the checkbox "Upload".<BR>
  1886. Otherwise use textatrea to insert data (any information in the file field will be ignored).
  1887. <LI>Check "Unquoted Data" to use SQL functions or numeric values. <BR><U>NEVER USE IT IF YOU ARE NOT SURE WHAT IT DOES</U><BR> 
  1888.  
  1889. EOT
  1890. ;
  1891.     
  1892.     }
  1893.     my $headtab = {
  1894.         name    => "$ProcName",
  1895.         table    => "TABLE \"$tabs[0]\"",
  1896.         rows    => "Total rows: $count",
  1897.         msg        => "$msg"
  1898.     };
  1899.     printHeaderTable($headtab);
  1900.     print <<InsertHead
  1901.     
  1902.  
  1903. <FORM ACTION="$full_url" METHOD="POST"  ENCTYPE="multipart/form-data">
  1904.  
  1905. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 BGCOLOR="#AAAAAA">
  1906.             <TR>
  1907.                 <TD WIDTH="100%">
  1908.                 
  1909. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=1 BGCOLOR="#AAAAAA" WIDTH="100%"><!-- Insert Form Table -->
  1910.  
  1911. InsertHead
  1912. ;
  1913.  
  1914.     foreach (@$array) {
  1915.         ${$_}[2] = '' unless $textflag;
  1916.         print qq!\t<TR BGCOLOR="#CCCCCC" HEIGHT=22>@{$_}</TR>\n!;
  1917.  
  1918.     }
  1919.     print <<InsertBottom
  1920.  
  1921. </TABLE>
  1922. </TD></TR></TABLE>
  1923. <P>
  1924. <INPUT TYPE = HIDDEN NAME="tables" VALUE="$tabs[0]">
  1925. <INPUT TYPE = HIDDEN NAME="page" VALUE="$page">
  1926. <INPUT TYPE = HIDDEN NAME="func" VALUE="$func">
  1927. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  1928. $hiddeninput1
  1929.  
  1930. <!-- Option Table -->
  1931.  
  1932. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  1933.     <TR>
  1934.         <TD><INPUT TYPE = SUBMIT NAME="submit" VALUE="Submit" TITLE="Submit" style="width: 190px"> </TD>
  1935.         <TD><INPUT TYPE=RESET TITLE="Reset form"> </TD>
  1936.         <TD>$insertOptions</TD>
  1937.     </TR>
  1938. </TABLE>
  1939. <!--End of Option Table -->
  1940. </FORM><P>
  1941. $goback
  1942. <UL>
  1943. $bottomMessage
  1944. <!-- loadInsertForm procedure ends here -->
  1945. </UL>
  1946. InsertBottom
  1947. ;
  1948.     return;
  1949. }
  1950.  
  1951. sub loadZoom {
  1952.     my ($table)            = $q->param('tables');
  1953.     my @fields             = $q->param($table.'_fields');
  1954.     my $dbname             = $q->param('dbname');
  1955.     my $updateWhere     = $q->param('updateWhere');
  1956.     my $updateOrder     = $q->param('updateOrder');
  1957.     $updateWhere         = '' unless ($updateWhere =~ /\S/);
  1958.     $updateOrder         = '' unless ($updateOrder =~ /\S/);
  1959.     my $updateRows         = $q->param('updateRows');
  1960.     my $updateStart     = $q->param('updateStart');
  1961.     my $zoomselect         = $q->param('zoomselect');
  1962.     my $where             = $q->param('where');
  1963.     my $order             = $q->param('order');
  1964.     my $start             = $q->param('SelectRow') + 0;
  1965.     my $rows             = 1;
  1966.     $updateRows         = '' if ($updateRows =~ /ALL/i);
  1967.  
  1968.     my $back = {
  1969.         dbname            => "$database",
  1970.         tables            => $table,
  1971.         page            => "tables",
  1972.         func            => "update",
  1973.         updateStart        => $q->param('start'),
  1974.         updateRows        => $q->param('rows'),
  1975.         updateWhere        => "$where",
  1976.         updateOrder        => "$order",
  1977.     };
  1978.     my @hidfields         = $q->param('fields');
  1979.     $back->{"$table\_fields"} = \@hidfields;
  1980.     
  1981.     my $query             = "SELECT $zoomselect FROM $table";
  1982.     $query                 .= " WHERE $where" if $where;
  1983.     $query                 .= " ORDER BY $order" if $order;
  1984.     $query                 .= " LIMIT $start, $rows ";
  1985.     my ($sth,$res)         = prepare_execute($query,$back);
  1986.     my ($array)         = $sth->fetchrow_array() or bail_out ("(zoom) Retrieve Error", $back);
  1987.     $sth->finish();
  1988.     ($array,$updateOrder,$updateWhere,$order,$where) = quoteit($array,$updateOrder,$updateWhere,$order,$where);
  1989.  
  1990.     print qq?\n\n<!-- loadZoom Procedure starts here -->\n\n?;
  1991.     print qq?<FORM METHOD=POST METHOD="$full_url">?;
  1992.     my $headtab = {
  1993.         name    => "UPDATE (Zoom)",
  1994.         table    => "TABLE: $table",
  1995.         rows    => 'row# = '."$start",
  1996.         title2    => "This is column $zoomselect, row number $start"
  1997.     };
  1998.     printHeaderTable($headtab);
  1999.     my $textareasize    = $agent ? 60 : 90;
  2000.     print <<ZoomContinue
  2001. <!-- Update Table -->
  2002. <TABLE BORDER=0>
  2003.     <TR BGCOLOR="#cccccc">
  2004.         <TH BGCOLOR="#EEEEEE">$zoomselect</TH>
  2005.     </TR>
  2006.     <TR VALIGN=TOP>
  2007.         <TD><TEXTAREA ROWS=15 COLS=$textareasize NAME="n0_0" WRAP=OFF TITLE="Edit this value">$array</TEXTAREA></TD>
  2008.     </TR>
  2009. </TABLE>
  2010.  
  2011. <!-- Submit Buttons Table -->
  2012.     <TABLE BORDER=0>
  2013.         <TR>
  2014.             <TD><INPUT TYPE=SUBMIT NAME="update" VALUE="Update"  TITLE="Save changes"></TD>
  2015.             <TD><INPUT TYPE=SUBMIT NAME="reload" VALUE="Zoom Out" TITLE="Go back to Update Page"></TD>
  2016.             <TD><INPUT TYPE=RESET TITLE="Reset form"></TD>
  2017.             <TD WIDTH=15></TD>
  2018.             <TD>UPDATE [ low priority<INPUT TYPE=CHECKBOX NAME="update_option1" VALUE="LOW_PRIORITY" TITLE="Defer the statement until no clients are reading from the table"> ] [
  2019.                               ignore <INPUT TYPE=CHECKBOX NAME="update_option2" VALUE="IGNORE"  TITLE="Ignore rows that duplicate values for unique keys"> ]</TD>
  2020.         </TR>
  2021.     </TABLE>
  2022.  
  2023. <INPUT TYPE=HIDDEN NAME="page" VALUE="update">
  2024. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$dbname">
  2025. <INPUT TYPE=HIDDEN NAME="tables" VALUE="$table">
  2026. <INPUT TYPE=HIDDEN NAME="updateStart" VALUE="$updateStart">
  2027. <INPUT TYPE=HIDDEN NAME="updateRows" VALUE="$updateRows">
  2028. <INPUT TYPE=HIDDEN NAME="updateWhere" VALUE="$updateWhere">
  2029. <INPUT TYPE=HIDDEN NAME="updateOrder" VALUE="$updateOrder">
  2030. <INPUT TYPE=HIDDEN NAME="where" VALUE="$where">
  2031. <INPUT TYPE=HIDDEN NAME="order" VALUE="$order">
  2032. <INPUT TYPE=HIDDEN NAME="start" VALUE="$start">
  2033. <INPUT TYPE=HIDDEN NAME="rows" VALUE="$rows">
  2034. <INPUT TYPE=HIDDEN NAME="fields" VALUE="$zoomselect">
  2035. ZoomContinue
  2036. ;
  2037.     print $q->hidden(    -name=>"$table\_fields",
  2038.                           -default=>[@fields],
  2039.                         -override=>1);
  2040.  
  2041.     print "\n\n</FORM>\n\n<!-- loadZoom Procedure ends here -->\n\n";
  2042.     return
  2043. }
  2044. sub loadUpdateForm {
  2045.     print "<!-- loadUpdateForm Procedure starts here -->\n\n";
  2046.     my @tabs = $q->param('tables');
  2047.     my $back = {dbname => "$database", page => 'select_db'};
  2048.     if  (@tabs >=2) {
  2049.         bail_out("Too many tables were selected!", $back)
  2050.     }
  2051.     if ((@tabs == 0) or !$tabs[0]){
  2052.         bail_out("Table was not specified.", $back);
  2053.     }
  2054.     if ($page eq 'tables') {$back = {page => 'select_db', dbname => "$database"}}
  2055.     elsif ($page eq 'update'){
  2056.         $back->{tables}                = "$tabs[0]";
  2057.         $back->{page}                = "update";
  2058.         $back->{reload}                = "Reload";
  2059.         $back->{updateStart}        = $q->param('start');
  2060.         $back->{updateRows}            = $q->param('rows');
  2061.         $back->{updateWhere}        = $q->param('where');
  2062.         $back->{updateOrder}        = $q->param('order');
  2063.         my @hidfields                 = $q->param('fields');
  2064.         $back->{"$tabs[0]\_fields"}    = \@hidfields;
  2065.     }
  2066.     
  2067.     my $order = $q->param('updateOrder');
  2068.     $order = '' unless ($order =~ /\S/);
  2069.     my $where = $q->param('updateWhere');
  2070.     $where = '' unless ($where =~ /\S/);
  2071.     my $rows; my $start;
  2072.     if (defined $q->param('updateLimit')) {
  2073.         ($start, $rows) = split ',',$q->param('updateLimit')
  2074.     }
  2075.     else {
  2076.         $rows = $q->param('updateRows');
  2077.         $start = $q->param('updateStart');
  2078.     }
  2079.  
  2080.     my $count = count_rows($tabs[0]);
  2081.     $rows = '' if ($rows =~ /ALL/i);
  2082.         
  2083.     my @fields = $q->param("$tabs[0]\_fields");
  2084.     @fields = $q->param("fields") if $q->param('error');
  2085.     my $fields = join (', ', @fields);
  2086.     my $query = "DESCRIBE $tabs[0]";
  2087.     my ($sth,$res) = prepare_execute($query, $back);
  2088.  
  2089.     my @descrlist;
  2090.     my @printType;
  2091.     my @names;
  2092.     my @types;
  2093.     my $enums;
  2094.     my @fullname;
  2095.     my $primary_flag;
  2096.     while (@descrlist = $sth->fetchrow_array()) {
  2097.         $primary_flag = '1' if ($descrlist[3] =~ /pri/i ) ;
  2098.         if (belongs(\@fields,$descrlist[0]) or @fields == 0) {
  2099.             push @printType,$descrlist[1];
  2100.             if (($descrlist[1] =~ /^\s*\w*blob/i) or ($descrlist[1] =~ /^\s*\w*text/i)){push @types, "-1"}
  2101.             elsif($descrlist[1] =~ /^\s*enum\s*\((.*)\)/){
  2102.                 push @types,'enum';
  2103.                 my @enumval = ('',split ',',$1);
  2104.                 @enumval = quoteit(@enumval);
  2105.                 for (my $i = 0; $i < @enumval; $i++){
  2106.                     $enumval[$i] =~ s/^'(.*)'$/$1/;
  2107.                     $enumval[$i] =~ s/''/'/g;
  2108.                     $enums->{$descrlist[0]}[$i] = $enumval[$i];
  2109.                 }
  2110.             }
  2111.             else {push @types, 0}
  2112.             push @names,$descrlist[0];
  2113.         }
  2114.         push @fullname,$descrlist[0];
  2115.     }
  2116.     $sth->finish();
  2117.     
  2118.     my $types = \@types;
  2119.     my $size = scalar @fullname;
  2120.     if (!$fields or ($size == scalar @fields)){$fields = '*'; @fields = @fullname}
  2121.  
  2122.     my ($where_, $order_) = quoteit($where, $order);
  2123.     print $q->start_multipart_form(-method=>"POST",
  2124.                                      -action=>$full_url);
  2125.  
  2126.     my $headtab = {
  2127.         name    => 'UPDATE',
  2128.         table    => "TABLE: $tabs[0]",
  2129.         rows    => "Total rows: $count",
  2130.         msg        => "$_[0]"
  2131.         
  2132.     };
  2133.     my ($wheresize, $textsize, $textareasize) = $agent ? (20, 15, 20 ) : (30, 20, 30 );
  2134.     printHeaderTable($headtab);
  2135.     print qq?
  2136. <TABLE BORDER=0><TR><TD>
  2137.  
  2138.  
  2139.     <!-- Parameter Table -->
  2140.     <TABLE BORDER=0 CELLPADDING=2 WIDTH="100%">
  2141.         <TR>
  2142.             <TD> where <INPUT TYPE=TEXT NAME="updateWhere" VALUE="$where_" SIZE=$wheresize TITLE="Specify records to display"></TD>
  2143.             <TD> order by <INPUT TYPE=TEXT NAME="updateOrder" VALUE="$order_" SIZE=15 TITLE="Specify column to order the records by"></TD>
  2144.             
  2145.             <TD> offset <INPUT TYPE=TEXT NAME="updateStart" VALUE="$start" SIZE=5 TITLE="Specify start record"></TD>
  2146.             <TD> rows <INPUT TYPE=TEXT NAME="updateRows" VALUE="$rows" SIZE=3 MAXLENGTH=3 TITLE="Specify number of records to be displayed"></TD>
  2147.             <TD> <INPUT TYPE=SUBMIT NAME="reload" VALUE="Reload" TITLE="Reload the page applying new display options only."></TD>
  2148.         </TR>
  2149.         <TR>
  2150.             <TD COLSPAN=5 ALIGN=LEFT HEIGHT=6></TD>
  2151.         </TR>
  2152.     </TABLE>
  2153. </TD></TR></TABLE>
  2154. ?;
  2155.  
  2156. print qq?        
  2157. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  2158. <INPUT TYPE=HIDDEN NAME="tables" VALUE="$tabs[0]">
  2159. <INPUT TYPE=HIDDEN NAME="page" VALUE="update">
  2160. <INPUT TYPE=HIDDEN NAME="start" VALUE="$start">
  2161. <INPUT TYPE=HIDDEN NAME="rows" VALUE="$rows">
  2162. <INPUT TYPE=HIDDEN NAME="where" VALUE="$where_">
  2163. <INPUT TYPE=HIDDEN NAME="order" VALUE="$order_">
  2164. ?;
  2165.     foreach (@fields){
  2166.         last if ($fields eq '*');
  2167.         print "<INPUT TYPE=HIDDEN NAME=\"fields\" VALUE=\"$_\">\n";
  2168.     }
  2169.     my $priref;
  2170.     if (($start =~ /[\D]/) or ($rows =~ /[\D]/)) {
  2171.         ErrMessage("<P><B>The values OFFSET and ROWS must be numeric!</B><P>");
  2172.         print $q->hidden(-name=>'error', -value=>'1');
  2173.     }
  2174.     else {
  2175.  
  2176.  
  2177.         $query  = "SELECT $fields FROM $tabs[0]";
  2178.         $query .= " WHERE $where" if $where;
  2179.         $query .= " ORDER BY $order" if $order;
  2180.         $query .= " LIMIT $start, $rows"            if ($start and ($rows or ($rows eq '0')));
  2181.         $query .= " LIMIT $rows"                     if (!$start and ($rows or ($rows eq '0')));
  2182.         $query .= " LIMIT $start, ".($count-$start)    if ($start and (!$rows and ($rows ne '0')));
  2183.  
  2184.         $sth = $dbh->prepare($query) || do {print $q->hidden(-name=>'error', -value=>'1'); ErrMessage("Something wrong")};
  2185.         $res = $sth->execute         || do {print $q->hidden(-name=>'error', -value=>'1'); ErrMessage("Wrong parameters")};
  2186.  
  2187.  
  2188.         $priref = get_mysql_pri($sth);
  2189.         unless (defined $priref){$priref = []}
  2190.         print "<P><B>The Table contains no Data!</B><BR>\n\n" if ($count == 0);
  2191.     }
  2192.     print "<!-- Update Table -->\n\n";
  2193.     print "<TABLE BORDER=0>\n";
  2194.     print "\t<TR BGCOLOR=\"#cccccc\">\n\t\t<TD>  </TD>\n\t\t<TD>    </TD>\n";
  2195.     my $i = 0;
  2196.     my $zoom_ok = '';
  2197.     foreach (@fields) {
  2198.         my $color = '#000000';
  2199.         $color = '#ff0000' if $priref->[$i];
  2200.         my $zoomselect = '';
  2201.         if ($types[$i] == -1) {
  2202.            $zoomselect = qq!<INPUT TYPE=RADIO NAME="zoomselect" VALUE="$_" TITLE="Select column to zoom">! ;
  2203.            $zoom_ok = 1;
  2204.         }
  2205.         print     qq!\t\t<TH BGCOLOR="#EEEEEE"><FONT COLOR="$color"> $zoomselect $_</TH>\n!;
  2206.         $i++;
  2207.     }
  2208.     print "\t</TR>\n";
  2209.  
  2210.     $i = 0;
  2211.     my $j;
  2212.     while (@ary = $sth->fetchrow_array()) {
  2213.         print "\t<TR VALIGN=TOP>\n\t\t<TD>".($i+$start)."</TD>\n";
  2214.         print qq!\t\t<TD><INPUT TYPE="CHECKBOX" NAME="SelectRow" VALUE="!.($i+$start).qq!" TITLE="Select row (to zoom or delete)"></TD>\n!;
  2215.         my $jj=0;
  2216.         for ($j=0; $j<@ary; $j++) {
  2217.             $ary[$j] = quoteit($ary[$j]);
  2218.             if ($types[$jj] == -1){
  2219.                 print "\t\t<TD ALIGN=CENTER>";
  2220.                 print "<TEXTAREA ROWS=2 COLS=$textareasize NAME=\"n".$i."_".$jj."\" WRAP=OFF TITLE=\"Edit this value\">$ary[$j]</TEXTAREA></TD>\n";
  2221.             }
  2222.             elsif ($types[$jj] eq 'enum'){
  2223.                 print "\t\t<TD ALIGN=CENTER><SELECT NAME=\"n".$i."_".$jj."\" TITLE=\"Select another value\">\n";
  2224.                 foreach (@{$enums->{$names[$j]}}) {
  2225.                     my $selected = 'SELECTED' if ($_ eq "$ary[$j]");
  2226.                     print qq!<OPTION VALUE="$_" $selected>$_\n!;
  2227.                 }
  2228.                 print "</SELECT></TD>\n";
  2229.             }
  2230.             else {
  2231.                 print "\t\t<TD ALIGN=CENTER><INPUT TYPE=TEXT NAME=\"n".$i."_".$jj."\" VALUE = \"$ary[$j]\" TITLE=\"Edit this value\" SIZE=$textsize></TD>\n";
  2232.             }
  2233.             $jj++    
  2234.         }#for
  2235.         print "\t</TR>\n";
  2236.         $i++;
  2237.     }#while
  2238.     $sth->finish();
  2239.     my $DBIerr                 = $DBI::err;
  2240.     $DBIerr                 += 0;
  2241.     $DBIerr == 0 or bail_out ("Retrieve Error");
  2242.         
  2243.     print "\t<TR>\n\t\t<TD COLSPAN=\"". (scalar (@$types)+2) ."\"><HR SIZE=\"1\"></TD>\n\t</TR>\n";
  2244.     print "\t<TR>\n\t\t<TD COLSPAN=\"". (scalar (@$types)+2) ."\">Insert new row:</TD>\n\t</TR>\n";
  2245.     print "\t<TR>\n\t\t<TD> </TD>\n\t\t<TD> </TD>\n";
  2246.     @printType = quoteit(@printType);
  2247.     foreach (@printType) {
  2248.         s/^\s*enum.*/enum/i;
  2249.         print "\t\t<TD ALIGN=CENTER>$_</TD>\n";        
  2250.     }
  2251.     print "\t</TR>\n";
  2252.         
  2253.     print "\t<TR>\n\t\t<TD>$count</TD>\n\t\t<TD> </TD>\n";
  2254.     $i = 0;    
  2255.     foreach (@types) {
  2256.         if ($_ == -1){
  2257.            print qq!\t\t<TD ALIGN=CENTER><TEXTAREA WRAP=OFF ROWS=2 COLS =$textareasize NAME="$fields[$i]\_data" TITLE="Insert value"></TEXTAREA></TD>\n!;
  2258.         }
  2259.         elsif ($_ eq 'enum'){
  2260.             print qq!\t\t<TD ALIGN=CENTER><SELECT NAME="$fields[$i]\_data">\n!;
  2261.             foreach (@{$enums->{$names[$i]}}) {
  2262.                 print qq!<OPTION VALUE="$_">$_\n!;
  2263.             }
  2264.                 print "</SELECT></TD>\n";
  2265.         }
  2266.         else {
  2267.             print qq!\t\t<TD ALIGN=CENTER><INPUT TYPE=TEXT NAME="$fields[$i]\_data" TITLE="Insert value" SIZE=$textsize></TD>\n!;
  2268.         }    
  2269.         $i++;
  2270.     }#foreach
  2271.     my $zoombutton = '<INPUT TYPE=SUBMIT NAME="zoom" VALUE="Zoom" TITLE="Zoom selected value">' if $zoom_ok;
  2272.  
  2273.             my @insmethod = (
  2274.                     $q->radio_group(
  2275.                         -name=>'insmethod', 
  2276.                         -values=>['INSERT'], 
  2277.                         -default=>'INSERT', 
  2278.                         -labels=>{INSERT => ''}
  2279.                         ),
  2280.                     $q->radio_group(
  2281.                         -name=>'insmethod', 
  2282.                         -values=>['REPLACE'], 
  2283.                         -default=>'-', 
  2284.                         -labels=>{REPLACE => ''}
  2285.                         )
  2286.             );
  2287.             my $word =  qq![INSERT $insmethod[0] | REPLACE $insmethod[1]]!;
  2288.     print <<EndSubmit
  2289.     </TR>
  2290.          </TABLE>
  2291. <!-- Footer Table Starts Here -->
  2292.  
  2293. <TABLE BORDER=0>
  2294.     <TR>
  2295.         <TD ALIGN=LEFT VALIGN=TOP>
  2296. <!-- PREVIEW -->    
  2297.     <TABLE BORDER=0>
  2298.         <TR>
  2299.             <TD><P><INPUT TYPE=CHECKBOX NAME="preview" TITLE="Check to preview generated command"></TD>
  2300.             <TD VALIGN=MIDDLE TITLE="Check to preview generated command">Preview SQL query.</TD>
  2301.         </TR>
  2302.     </TABLE><BR>        
  2303.         
  2304. <!-- Submit Buttons -->    
  2305.     <TABLE BORDER=0>
  2306.         <TR>
  2307.               <TD><INPUT TYPE=SUBMIT NAME="update" VALUE="Update" TITLE="Update the table"></TD>
  2308.            <TD><INPUT TYPE=SUBMIT NAME="insert" VALUE="Insert" TITLE="Insert new row"></TD>
  2309.            <TD>$zoombutton</TD>
  2310.            <TD><INPUT TYPE=SUBMIT NAME="delete" VALUE="Delete" style="color: #CC0000" TITLE="Delete selected rows"></TD>
  2311.            <TD><INPUT TYPE=RESET TITLE="Reset changes"></TD>
  2312.         </TR>
  2313.     </TABLE>
  2314.  
  2315.     <TABLE BORDER=0>
  2316.         <TR>
  2317.             <TD>UPDATE [ low priority<INPUT TYPE=CHECKBOX NAME="update_option1" VALUE="LOW_PRIORITY" TITLE="Defer the statement until no clients are reading from the table"> ] [
  2318.                               ignore <INPUT TYPE=CHECKBOX NAME="update_option2" VALUE="IGNORE"  TITLE="Ignore rows that duplicate values for unique keys"> ]</TD>
  2319.         </TR>
  2320.         <TR>
  2321.             <TD>$word [ low priority<INPUT TYPE=RADIO NAME="insert_option1" VALUE="low_priority" TITLE="Defer the statement until no clients are reading from the table">/
  2322.                               delayed <INPUT TYPE=RADIO NAME="insert_option1" VALUE="DELAYED" TITLE="Delayed Insertion"> ] [
  2323.                            ignore <INPUT TYPE=CHECKBOX NAME="insert_option2" VALUE="IGNORE"  TITLE="Ignore rows that duplicate values for unique keys"> ]</TD>
  2324.         </TR>
  2325.         <TR>
  2326.             <TD>DELETE [ low priority<INPUT TYPE=CHECKBOX NAME="delete_option1" VALUE="LOW_PRIORITY" TITLE="Defer the statement until no clients are reading from the table"> ]</TD>
  2327.         </TR>
  2328.  
  2329.     </TABLE>
  2330.     </TD><TD VALIGN=TOP>
  2331. <!-- Select columns Table -->
  2332.      <TABLE><TR><TD TITLE="Select columns to display"><B>Select columns</B><BR>
  2333.      
  2334. EndSubmit
  2335. ;    
  2336.     print "<SELECT SIZE=$size NAME=$tabs[0]\_fields MULTIPLE>\n";
  2337.     foreach (@fullname){
  2338.         my $selected = 'SELECTED' if (belongs(\@fields, $_) or !@fields);
  2339.         print qq!<OPTION VALUE="$_" $selected>$_ \n!;
  2340.     }
  2341.     print "\t\t</SELECT></TD>\n\t\t</TR>\n\t</TABLE>\n\n";
  2342.     print "\t\t</TD>\n\t</TR>\n</TABLE><!-- Footer Table Ends Here -->\n\n";
  2343.     print $q->end_form;
  2344.     print "\n\n<!-- loadUpdateForm Procedure ends here -->\n\n";    
  2345.     
  2346. }
  2347. sub execSelectFromTable {
  2348.     my @tabs = $q->param('tables');
  2349.     my $back         = {page => 'select_db', dbname => "$database"};
  2350.     if ((@tabs == 0) or !$tabs[0]){
  2351.         bail_out("Table is not specified.", $back);
  2352.     }
  2353.     print "\n\n<!-- Select from Table procedure starts here -->\n\n";
  2354.     my $dbname        = $q->param ('dbname');
  2355.     my @where         = $q->param ('where');
  2356.     for (my $i=0; $i<@where; $i++){
  2357.         $where[$i] = '' unless ($where[$i] =~ /\S/);
  2358.     }
  2359.  
  2360.     my @groupby     = $q->param ('groupby');
  2361.     my @orderby     = $q->param('orderby');
  2362.     my @select         = $q->param('select');
  2363.     my @limitref     = getlimit(scalar @tabs);
  2364.     
  2365.     my @limit         = @{$limitref[0]};
  2366.     my @offset         = @{$limitref[1]};
  2367.     my @rows         = @{$limitref[2]};
  2368.     my @exclude = $q->param('exclude');
  2369.     if ((@tabs - @exclude) > 1){
  2370.         print <<EOT
  2371. <FORM METHOD=POST ACTION="$full_url">
  2372. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$dbname">
  2373. <INPUT TYPE=HIDDEN NAME="page" VALUE="tables">
  2374. <INPUT TYPE=HIDDEN NAME="func" VALUE="select">
  2375. EOT
  2376. ;
  2377.     }
  2378.     my $i = -1;
  2379.     foreach (@tabs) {
  2380.         $i++;
  2381.         unless (defined $where[$i]) {$where[$i] = $where[0]}
  2382.         
  2383.         my $exclude = qq!    <INPUT TYPE=CHECKBOX NAME="exclude" VALUE="$_" TITLE="Exclude this table next time the page is reloaded"> Exclude! if ((@tabs - @exclude) > 1);
  2384.         next if (belongs (\@exclude, $_));
  2385.         
  2386.         my (
  2387.         $orderby_,
  2388.         $groupby_,
  2389.         $limit_,
  2390.         $select_,
  2391.         $tabs_,
  2392.         $where_,
  2393.         ) = quoteit(
  2394.                                  $orderby[$i],
  2395.                              $groupby[$i],
  2396.                              $limit[$i],
  2397.                              $select[$i],
  2398.                              $tabs[$i],
  2399.                              $where[$i],
  2400.                              );
  2401.         
  2402.  
  2403.         my $tableform =  <<EOT
  2404. <TABLE>
  2405.     <TR>
  2406.         <TD><INPUT TYPE="SUBMIT" VALUE="Go" TITLE="Reload page"></TD>
  2407.         <TD>SELECT</TD>
  2408.         <TD><INPUT TYPE="TEXT" SIZE="10" NAME="select"     VALUE="$select_" TITLE="List of columns and aliases"></TD>
  2409.         <TD>FROM</TD>
  2410.         <TD><INPUT TYPE="TEXT" SIZE="10" NAME="tables"    VALUE="$tabs_" TITLE="List of tables and aliases"></TD>
  2411.         <TD>WHERE</TD>
  2412.         <TD><INPUT TYPE="TEXT" SIZE="10" NAME="where"    VALUE="$where_" TITLE="Specify conditions of WHERE clause"></TD>
  2413.         <TD>GROUP BY</TD>
  2414.         <TD><INPUT TYPE="TEXT" SIZE="10" NAME="groupby"    VALUE="$groupby_" TITLE="Specify columns to group by"></TD>
  2415.         <TD>ORDER BY</TD>
  2416.         <TD><INPUT TYPE="TEXT" SIZE="10" NAME="orderby"    VALUE="$orderby_" TITLE="Specify columns to order by"></TD>
  2417.         <TD>LIMIT</TD>
  2418.         <TD><INPUT TYPE="TEXT" SIZE="10" NAME="limit"    VALUE="$limit_" TITLE="Limit the output"></TD>
  2419.     </TR>
  2420. </TABLE>
  2421. EOT
  2422. ;
  2423.  
  2424.         my @total;
  2425.         my $tabs;
  2426.         my $query         = "SELECT * FROM $_ WHERE 1=0";
  2427.         my $sth        = $dbh->prepare($query);
  2428.         my $res        = $sth->execute();
  2429.         if ($DBI::err){
  2430.             unless ((@tabs - @exclude) > 1){
  2431.                  print <<EOT
  2432. <FORM METHOD=POST ACTION="$full_url">
  2433. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$dbname">
  2434. <INPUT TYPE=HIDDEN NAME="page" VALUE="tables">
  2435. <INPUT TYPE=HIDDEN NAME="func" VALUE="select">
  2436. EOT
  2437. ;
  2438.             }
  2439.             print $tableform;
  2440.             print qq!<code>TABLE: $tabs_</code> $exclude<p>\n!;
  2441.             print qq!<font color="#cc0000"><b>Cannot select from this table</b></font><BR>$DBI::errstr<BR>\n!;
  2442.             print "<hr size=1><BR>\n";
  2443.             unless ((@tabs - @exclude) > 1){
  2444.                 print "\n</FORM>";
  2445.             }
  2446.             next
  2447.         }
  2448.  
  2449.         my $fieldsref         = $sth->{NAME};
  2450.         my $size        = $sth->{NUM_OF_FIELDS};
  2451.         if ($tabs[$i] =~ /\W/){ 
  2452.             my $tables;
  2453.             if ((eval {local $SIG{__DIE__};  $tables = $sth->{mysql_table}}) or (eval {local $SIG{__DIE__};  $tables = $sth->{table}})) {
  2454.                 my @unitabs;
  2455.                 for (my $j=0; $j<$size; $j++){
  2456.                     $fieldsref->[$j] = "$tables->[$j]\.$fieldsref->[$j]" ;
  2457.                     unless (belongs(\@unitabs,$tables->[$j])) {
  2458.                         push @unitabs, $tables->[$j];
  2459.                         push @total, count_rows($tables->[$j]);
  2460.                     }
  2461.                 }
  2462.                 $tabs = join(', ', @unitabs);
  2463.             }
  2464.             else {
  2465.                 unless ((@tabs - @exclude) > 1){
  2466.                      print <<EOT
  2467. <FORM METHOD=POST ACTION="$full_url">
  2468. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$dbname">
  2469. <INPUT TYPE=HIDDEN NAME="page" VALUE="tables">
  2470. <INPUT TYPE=HIDDEN NAME="func" VALUE="select">
  2471. EOT
  2472. ;
  2473.                  }
  2474.                 print $tableform;
  2475.                 print qq!<code>TABLE: $tabs_</code> $exclude<p>\n!;
  2476.                 print qq!<font color="#cc0000"><b>Perl module DBD::mysql must be updated in order to use multiple table names</b></font><BR>\n!;
  2477.                 print "<hr size=1><BR>\n";
  2478.                 unless ((@tabs - @exclude) > 1){
  2479.                     print "\n</FORM>";
  2480.                 }
  2481.  
  2482.                 next
  2483.             }
  2484.         }
  2485.         else {push @total, count_rows($tabs[$i]); $tabs = $tabs[$i]}
  2486.         $sth->finish();
  2487.         my $total        = join(', ',@total);        
  2488.         my @fields         = $q->param("fields_$tabs[$i]");
  2489.         my $fields         = join (', ', @fields);
  2490.         $fields = '*' if (!$fields or ($size == scalar @fields));
  2491.         if ($select[$i]) {$query = "SELECT $select[$i] FROM $tabs[$i] "}
  2492.         else {$query = "SELECT $fields FROM ".$tabs[$i]}
  2493. #        unless (defined $where[$i]) {$where[$i] = $where[0]}
  2494.         $query .= " WHERE $where[$i]"          if ($where[$i]);
  2495.         unless (defined $groupby[$i]) {$groupby[$i] = $groupby[0]}
  2496.         $query .= " GROUP BY $groupby[$i]"       if ($groupby[$i]);
  2497.         unless (defined $orderby[$i]) {$orderby[$i] = $orderby[0]}
  2498.         $query .= " ORDER BY $orderby[$i]"       if ($orderby[$i]);
  2499.  
  2500.         $query .= " LIMIT $limit[$i]" if  ($limit[$i] ne '');
  2501.         my $query_ = quoteit($query);
  2502.         unless ((@tabs - @exclude) > 1){
  2503.             printform({query => $query_});
  2504.             
  2505.              print <<EOT
  2506. <FORM METHOD=POST ACTION="$full_url">
  2507. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$dbname">
  2508. <INPUT TYPE=HIDDEN NAME="page" VALUE="tables">
  2509. <INPUT TYPE=HIDDEN NAME="func" VALUE="select">
  2510. <INPUT TYPE=HIDDEN NAME="query" VALUE="$query_">
  2511. EOT
  2512. ;
  2513.         }
  2514.         print qq!<P TITLE="Executed query">$query_</P>\n!;
  2515.         print $tableform;
  2516.  
  2517.         $sth = $dbh->prepare($query) || ErrMessage; 
  2518.         $res = $sth->execute         || ErrMessage;
  2519.         print <<EOT
  2520. <TABLE BORDER=0>
  2521.     <TR>
  2522.         <TD COLSPAN=2>
  2523.             <TABLE WIDTH=700 BORDER=0>
  2524.                 <TR>
  2525.                     <TD><CODE>TABLE:  $tabs</CODE>$exclude</TD>    
  2526.                     <TD WIDTH=30 ALIGN=RIGHT> </TD>
  2527.                     <TD WIDTH=270><CODE>Total Rows:  $total</CODE></TD>
  2528.                 </TR>
  2529.             </TABLE>
  2530.         </TD>
  2531.     </TR>
  2532.     <TR VALIGN=TOP>
  2533.         <TD VALIGN=TOP><!-- printresult -->
  2534. EOT
  2535. ;
  2536.         print &printresult(\$sth, $offset[$i], 1) unless $DBI::err;
  2537.         
  2538.         $sth->finish();
  2539.         
  2540.         print <<EOT
  2541.         
  2542. <!-- /endprintresult -->
  2543.         </TD>
  2544.         <TD VALIGN=TOP>
  2545.         
  2546. <TABLE>
  2547.     <TR>
  2548.         <TD TITLE="List of selected columns.
  2549. The columns can alternatively be selected from this list"><P><B>SHOW COLUMNS</B></TD>
  2550.     </TR>
  2551.     <TR>
  2552.         <TD>
  2553. <SELECT MULTIPLE NAME="fields_$tabs[$i]" SIZE=$size>
  2554. EOT
  2555. ;
  2556.         for (my $j=0; $j<$size; $j++){
  2557.             my $selected = "SELECTED" if (belongs(\@fields, $fieldsref->[$j]) or !@fields);
  2558.             print qq!<OPTION VALUE="$fieldsref->[$j]" $selected>$fieldsref->[$j] \n!;
  2559.         }
  2560.         print <<EOT
  2561. </SELECT></TD></TR></TABLE>
  2562.         </TD>
  2563.     </TR>
  2564. </TABLE>
  2565. <BR><HR SIZE=1><BR>
  2566. EOT
  2567. ;
  2568.         unless ((@tabs - @exclude) > 1){
  2569.             print "\n</FORM>";
  2570.         }
  2571.     }
  2572.     print "\n</FORM>" if ((@tabs - @exclude) > 1);
  2573.     print "\n\n<!-- Select from Table procedure endss here -->\n\n";
  2574. return
  2575. }
  2576.  
  2577. sub execExecuteQuery {
  2578.  
  2579.     my $back = shift;
  2580.     
  2581.     my $queries                = $back->{SQL} || $q->param('SQL');
  2582.     my $selectedscript        = $back->{selectedscript} || $q->param('selectscript');
  2583.     unless ($print){
  2584.         print "\n<!-- EXECUTE QUERY starts here -->\n";
  2585.     }    
  2586.     bail_out ("Query was emptY!", $back) unless ($queries =~ /\S/);
  2587.     
  2588.     $queries                 =~ s/\/\*.*\*\///sg;
  2589.     $queries                =~ s/^\s*#.*$//mg;
  2590.     my $newline                ="\n";
  2591.     $queries                 .= "\n";
  2592.     my @queryarray            = ();
  2593.     my $jj                     = 0;
  2594.     $_                         = $queries;
  2595.     my $newquery             = 1;
  2596.     while (
  2597.         m/
  2598.         (.*?)                # $1
  2599.         (                    # $2
  2600.             (?<!\\)(["'])    # $3
  2601.             (.*?)            # $4
  2602.             (?<!\\)(\3)        # $5
  2603.             |;|\Z            # 
  2604.         )
  2605.         (;?)                # $6
  2606.         /gxs
  2607.     )
  2608.     {
  2609.         if ($newquery){
  2610.             push @queryarray, "$1";
  2611.             if ($2 ne ';'){
  2612.                 $queryarray[-1] .= $2;
  2613.                 if ($6 ne ';'){$newquery = 0}
  2614.             }
  2615.         }
  2616.         else {
  2617.             $queryarray[-1] .= $1;
  2618.             if ($2 ne ';'){$queryarray[-1] .= $2}
  2619.             else {$newquery = 1}
  2620.             if ($6 eq ';'){$newquery = 1}
  2621.         }
  2622.         $jj++;
  2623.         last if ($jj > 50000);
  2624.     }
  2625.  
  2626.     bail_out ("Query was empty!", $back, '1')if (@queryarray == 0);
  2627.     unless ($print){
  2628.         print "Script Name: ", quoteit($q->param('selectscript')) if ($q->param('script') =~ /run/i);
  2629.     }
  2630.     for (my $i = 0; $i < @queryarray; $i++){
  2631.         $query = $queryarray[$i];
  2632.         next unless ($query =~ /\w./);
  2633.            my $keyword = '';
  2634.            $query =~ /^\s*(\w*)\s.*/; $keyword = $1;
  2635. #++++++++++++++++++++++++++++++++++++++
  2636.         my $sth = $dbh->prepare ($query);
  2637.         my $res = $sth->execute;
  2638.         if ($DBI::err){
  2639.             bail_out ("Cannot execute query $query", $back) if $q->param('abortsql');
  2640.             ErrMessage ("Cannot execute query");
  2641.         }
  2642.         else {
  2643.             $query = quoteit($query);
  2644.         
  2645.                if (belongs(\@selectlike,$keyword) and $query !~ /^\s*SELECT\s+.+\s+INTO\s+OUTFILE\s+/i) {
  2646.                 printform({query => $query, SQL =>$queries, selectedscript => $selectedscript}) unless ($print or ($page eq 'select_db'));
  2647.  
  2648.  
  2649.                  print &printresult(\$sth,undef,1);
  2650.                 ErrMessage("Print Result Error $DBI::errstr") if $DBI::err;
  2651.             }        
  2652.         }
  2653.         if ($page eq 'select_db'){
  2654.                 my $sql_ = quoteit($q->param('SQL'));
  2655.                 print <<EOT
  2656. <FORM ACTION="$full_url" METHOD=POST>
  2657. <INPUT TYPE=SUBMIT VALUE="BACK">
  2658. <INPUT TYPE=HIDDEN NAME="page" VALUE="connect">
  2659. <INPUT TYPE=HIDDEN NAME="SQL" VALUE="$sql_">
  2660. </FORM>
  2661. EOT
  2662. ;
  2663.         }
  2664.             $query =~ s/^\s*$//mg;
  2665.             $query =~ s/^/<BR>/mg;
  2666.             $query =~ s/\t/    /g;
  2667.             print <<EOT
  2668. <P>Executed Query:<b>$query</b><BR>
  2669. Result: $res <P>
  2670. <HR SIZE=1 LENGTH="100%"><BR>
  2671.  
  2672. EOT
  2673. unless $print;
  2674.     }
  2675.     print "<!-- End of EXECUTE QUERY -->\n\n" ;
  2676.     return;
  2677. }# END EXECUTE
  2678.  
  2679. sub loadDropPreview {
  2680.     print "\n\n<!-- loadDropPreview Procedure starts here -->\n\n";
  2681.     my @tabs = $q->param('tables');
  2682.     bail_out("Table is not specified.", {dbname => "$database", page => 'select_db'}) unless @tabs;
  2683.     print qq!<FORM METHOD=POST ACTION="$full_url">!;
  2684.     printHeaderTable({name => "DROP"});
  2685.     print qq!<TABLE BORDER=0>\n!;
  2686.     foreach (@tabs){
  2687.         print qq!<TR><TD><B>DROP TABLE $_</B></TD>!;
  2688.         print qq!<TD><INPUT TYPE=CHECKBOX NAME="tables" VALUE="$_" CHECKED></TD></TR>\n!;
  2689.     }
  2690.     print qq!</TABLE><P>!;
  2691.     print qq!<INPUT TYPE=SUBMIT NAME="drop" VALUE="Submit">\n !;
  2692.     print qq!<INPUT TYPE=HIDDEN NAME="dbname" VALUE="!.$q->param('dbname').qq!">\n!;
  2693.     print qq!<INPUT TYPE=SUBMIT NAME="return" VALUE="Return">\n!;
  2694.        print qq!<INPUT TYPE=HIDDEN NAME="page" VALUE="drop">\n!;
  2695.     print qq?\n\n<!-- loadDropPreview Procedure ends here -->\n\n?;
  2696.     print qq!</FORM>!;
  2697.     return;
  2698. }
  2699.  
  2700.  
  2701. sub execDropTable {
  2702.     if ($q->param('drop')){ 
  2703.         my @tabs = $q->param('tables');
  2704.            bail_out("Table is not specified.", {dbname => "$database", page => 'select_db'}) unless @tabs;
  2705.         foreach (@tabs){
  2706.             my $query = "DROP TABLE $_";
  2707.             $dbh ->do($query) || bail_out("Cannot drop table", {page=>'select_db', dbname=>"$database"});
  2708.         }
  2709.     }
  2710.     &loadSelectTables();
  2711.     return;
  2712. }
  2713. sub loadDeletePreview {
  2714.     print "\n\n<!-- loadDeletePreview Procedure starts here -->\n\n";
  2715.     print qq!<FORM METHOD=POST ACTION="$full_url">!;
  2716.     printHeaderTable({name => "DELETE"});
  2717.     my @tabs = $q->param('tables');
  2718.     my $back = {dbname => "$database", page => 'select_db'};
  2719.  
  2720.     bail_out("Table is not specified.", $back) unless @tabs;
  2721.     bail_out("Too Many Tables were selected.", $back) if (@tabs >= 2);
  2722.  
  2723.     my $where = quoteit($q->param('wheredelete'));
  2724.     my $query;
  2725.     if ($where) {$query = "DELETE FROM $tabs[0] WHERE $where"}
  2726.     else {$query = "DELETE FROM $tabs[0] WHERE 1=1"}
  2727.  
  2728.     print "<BR>QUERY:<B> $query</B><P>\n";
  2729.     print "<INPUT TYPE=\"SUBMIT\" NAME=\"delete\" VALUE=\"Submit\">\n";
  2730.     print "<INPUT TYPE=\"SUBMIT\" NAME=\"return\" VALUE=\"Return\">";
  2731.     print "<INPUT TYPE=\"HIDDEN\" NAME=\"tables\" VALUE=\"$tabs[0]\">\n";
  2732.     print "<INPUT TYPE=\"HIDDEN\" NAME=\"wheredelete\" VALUE=\"$where\">\n";
  2733.     print "\n<INPUT TYPE=\"HIDDEN\" NAME=\"dbname\" VALUE=\"".$q->param('dbname')."\">\n";
  2734.        print "<INPUT TYPE=\"HIDDEN\" NAME=\"page\" VALUE=\"delete\">\n";
  2735.     print "</FORM>";
  2736.     print "<!-- loadDeletePreview Procedure endss here -->";
  2737.  
  2738.     return;
  2739. }
  2740. sub loadAlterTable {
  2741.     my $input        = shift;
  2742.     my $back         = $input->{back} || {page => 'select_db', dbname => "$database"};
  2743.     if (($q->param('action')=~/import/i) or ($q->param('action')=~/export/i)){
  2744.         $back = {page => 'tables', dbname => "$database", func => $q->param('action')}
  2745.     }
  2746.     my (@tabs, $del, $hr, $newcolumn, $sth, $res);
  2747.     if ($page eq 'alterAfterPreview'){
  2748.         if ($q->param('back')){@tabs = $q->param('tables')}
  2749.         else{@tabs = $q->param('newtablename')}
  2750.         unless ($tabs[0]){@tabs = ()}
  2751.         $page = 'alter';
  2752.     }
  2753.     elsif     ((($q->param('func')=~/create/i) or     ($q->param('action')=~/create/i) or     $page eq 'create') and ($q->param('alter') !~ 'SAVE')){
  2754.         @tabs=();
  2755.         $page = 'create';
  2756.     }
  2757.     else {
  2758.         unless (@tabs = $q->param('newtablename') and ($q->param('alter') or $q->param('saveas'))) {@tabs = $q->param('tables')};
  2759.         if (@tabs >=2) {
  2760.             bail_out("Too many tables!", $back);
  2761.         }
  2762.         elsif (!$tabs[0]){
  2763.             bail_out("Table is not selected.", $back) if (($q->param('func')=~/ALTER/i) or (($q->param('action')=~/ALTER/i)));
  2764.             @tabs=();
  2765.         }
  2766.         $page = 'alter';
  2767.     }
  2768.  
  2769.     print "<!-- Alter procedure starts here -->\n";
  2770.     my $proof = qq!<NOSCRIPT><INPUT TYPE=SUBMIT VALUE="<"></NOSCRIPT>!;
  2771.     my $proof_ = qq!<INPUT TYPE=SUBMIT VALUE="<">!;
  2772.     my $autoincr;
  2773.     my $tabletype;
  2774.     my $comment;
  2775.     
  2776.     my $min_rows;
  2777.     my $max_rows;
  2778.     my $avgrowlength;
  2779.     my $reload            = 1 if ($q->param('alter') or $q->param('saveas') or $q->param('reload') or ($q->param('page') eq 'tables'));
  2780.     if (@tabs > 0){
  2781.         ($sth, $res) = prepare_execute("DESCRIBE $tabs[0]", $back);
  2782.         $autoincr = '<p CLASS="shead">Auto<BR>Column</p>';
  2783.         $del = "Del.";
  2784.         $newcolumn = "ADD NEW COLUMN:";
  2785.         $hr = "<HR SIZE=1>";
  2786.     }
  2787.     my @option;
  2788.     my %option_;
  2789.     if (check_version("3.23.0")){
  2790.         my $par = {};
  2791.         my @selected;
  2792.         my @types = ("MyISAM", "ISAM", "HEAP", "BDB", "InnoDB", "MERGE");
  2793.         if ($tabs[0]){
  2794.             my ($sth, $res)        = prepare_execute("SHOW TABLE STATUS LIKE '$tabs[0]'", $back);
  2795.             $par                = $sth->fetchrow_hashref();
  2796.             $sth->finish();
  2797. #this doesn't work with older DBI modules
  2798. #            $par                = $dbh->selectrow_hashref("SHOW TABLE STATUS LIKE '$tabs[0]'");
  2799.         }
  2800.         my $type = $reload ? $par->{Type} : $q->param('tabletype');
  2801.         if ($type =~ /myisam/i){$selected[1] = 'SELECTED';                 $type    = 'myisam'}
  2802.         elsif ($type =~ /isam/i){$selected[2] = 'SELECTED';             $type    = 'isam'}
  2803.         elsif ($type =~ /heap/i){$selected[3] = 'SELECTED';                $type    = 'heap'}
  2804.         elsif ($type =~ /inno/i){$selected[5] = 'SELECTED';                $type    = 'innodb'}
  2805.         elsif ($type =~ /(?:db|berkeley)/i){$selected[4] = 'SELECTED';    $type    = 'bdb'}
  2806.         elsif ($type =~ /(?:merge|mrg)/i){$selected[6] = 'SELECTED';    $type    = 'merge'}
  2807.         else  {$selected[0] = 'SELECTED'}
  2808.         my $value_            = $par->{Comment};
  2809.         {$value_            =~ s/^(.*?)(?:;\s*InnoDB free: \d+ \wB;?.*)$/$1/i if $type eq 'innodb';}
  2810.         my $value             = $reload ? $value_ : $q->param('comment');
  2811.         ($value, $value_)    = quoteit($value, $value_);
  2812.         my $comentlength     = $agent ? 30 : 50;
  2813.         $option_{COMMENT_}    = "$value_";
  2814.         $comment            = qq!<INPUT NAME="comment" TYPE=TEXT VALUE="$value" MAXLENGTH=60 size=$comentlength>!;
  2815.             
  2816.  
  2817.         $tabletype        = <<EOT
  2818. <B>TYPE:</B> <SELECT NAME="tabletype" ID="tabtype" onChange="this.form.submit()">
  2819. <OPTION VALUE="" $selected[0]>
  2820. <OPTION VALUE="MyISAM" $selected[1]>MyISAM
  2821. <OPTION VALUE="ISAM" $selected[2]>ISAM
  2822. <OPTION VALUE="HEAP" $selected[3]>HEAP
  2823. EOT
  2824. ;
  2825.         $tabletype        .= qq!<OPTION VALUE="BDB" $selected[4]>BDB\n! if check_version("3.23.17");
  2826.         $tabletype        .= qq!<OPTION VALUE="InnoDB" $selected[5]>InnoDB\n! if check_version("3.23.29");
  2827.         $tabletype        .= qq!<OPTION VALUE="MERGE" $selected[6]>MERGE\n! if (check_version("3.23.25") and $tabs[0] and $selected[6]);
  2828.         $tabletype        .= qq!</SELECT>$proof\n!;
  2829.         $tabletype        .= qq!<INPUT TYPE=HIDDEN NAME="tabletype_" VALUE="$par->{Type}">\n!;
  2830. #        my ($minrows, $maxrows, $avgrow, $autoincr, $rowformat, $packkeys, $delaykey, $checksum);
  2831.         my $create_options;
  2832.         my $create_options_ = $par->{Create_options};
  2833.         my $auto_increment;
  2834.         if ($reload){
  2835.             $create_options    = $create_options_;
  2836.             my $Type     = $q->param('tabletype');
  2837.             my $Type_    = $par->{Type};
  2838.             $auto_increment    = $par->{Auto_increment} if ($par->{Type} =~ /MyISAM/i) or (check_version("4.1.0") and $par->{Type} =~/HEAP/i); 
  2839.         }
  2840.         else {
  2841.             my $MIN_ROWS        = $q->param('MIN_ROWS');
  2842.             my $PACK_KEYS        = $q->param('PACK_KEYS');
  2843.             my $MAX_ROWS        = $q->param('MAX_ROWS');
  2844.             my $CHECKSUM        = $q->param('CHECKSUM');
  2845.             my $AVG_ROW_LENGTH    = $q->param('AVG_ROW_LENGTH');
  2846.             my $DELAY_KEY_WRITE = $q->param('DELAY_KEY_WRITE');
  2847.             my $ROW_FORMAT         = $q->param('ROW_FORMAT');
  2848.  
  2849.             $create_options    .= "MIN_ROWS=$MIN_ROWS " if $MIN_ROWS ne '';
  2850.             $create_options    .= "PACK_KEYS=$PACK_KEYS " if $PACK_KEYS ne '';
  2851.             $create_options    .= "MAX_ROWS=$MAX_ROWS " if $MAX_ROWS ne '';
  2852.             $create_options    .= "CHECKSUM=$CHECKSUM " if $CHECKSUM ne '';
  2853.             $create_options    .= "AVG_ROW_LENGTH=$AVG_ROW_LENGTH " if $AVG_ROW_LENGTH ne '';
  2854.             $create_options    .= "DELAY_KEY_WRITE=$DELAY_KEY_WRITE " if $DELAY_KEY_WRITE ne '';
  2855.             $create_options    .= "ROW_FORMAT=$ROW_FORMAT " if $ROW_FORMAT ne '';
  2856.             $auto_increment    =  deletespace($q->param('auto_increment'));
  2857.         }
  2858.         {
  2859.             if ($create_options_ =~ /MIN_ROWS=(\w+)\s?/i){$option_{MIN_ROWS_} = "$1"}
  2860.         }
  2861.         {
  2862.             if ($create_options_    =~ /PACK_KEYS=(\w+)\s?/i){$option_{PACK_KEYS_} = "$1"}
  2863.         }
  2864.         {
  2865.             if($create_options_ =~ /MAX_ROWS=(\w+)\s?/i){$option_{MAX_ROWS_} = "$1"}
  2866.         }
  2867.         {
  2868.             if($create_options_ =~ /CHECKSUM=(\w+)\s?/i){$option_{CHECKSUM_} = "$1"}
  2869.         }
  2870.         {
  2871.             if($create_options_ =~ /AVG_ROW_LENGTH=(\w+)\s?/i){$option_{AVG_ROW_LENGTH_} = "$1"}
  2872.         }
  2873.         {
  2874.             if($create_options_ =~ /DELAY_KEY_WRITE=(\w+)\s?/i){$option_{DELAY_KEY_WRITE_} = "$1"}
  2875.         }
  2876.         $option_{AUTO_INCREMENT_} = "$par->{Auto_increment}";
  2877.         {
  2878.             if($create_options_ =~ /ROW_FORMAT=(\w+)\s?/i){$option_{ROW_FORMAT_} = "$1"}
  2879.         }
  2880.  
  2881.         
  2882.         my $selected;
  2883.         {
  2884.             $create_options =~ /MIN_ROWS=(\w+)\s?/i;
  2885.             $option[0] = qq!MIN_ROWS</TD><TD><INPUT TYPE=TEXT NAME="MIN_ROWS" VALUE="$1" TITLE="The minimum number of rows you plan to store in the table.">!;
  2886.         }
  2887.         {
  2888.             $create_options    =~ /PACK_KEYS=(\w+)\s?/i;
  2889.             $option[1]        = qq!PACK_KEYS</TD><TD TITLE="Index compression for MyISAM and ISAM tables. A value of 1 specifies compression for string values and (MyISAM) Numeric index values. A value of 0 specifies no index compression"><SELECT NAME="PACK_KEYS">\n!;
  2890.             if (check_version('4.0.0')){
  2891.                 $selected        = $1 eq '' ? 'SELECTED' : '';
  2892.                 $option[1]        .= qq!<OPTION VALUE="DEFAULT" $selected>DEFAULT\n! ;
  2893.             }
  2894.             elsif($1 eq ''){
  2895.                 $option[1]        .= qq!<OPTION VALUE="" SELECTED>\n!;
  2896.             }
  2897.             $selected        = $1 eq '0'         ? 'SELECTED' : '';
  2898.             $option[1]        .= qq!<OPTION VALUE="0" $selected>0\n!;
  2899.             $selected        = $1 eq '1'         ? 'SELECTED' : '';
  2900.             $option[1]        .= qq!<OPTION VALUE="1" $selected>1\n!;
  2901.             $option[1]        .= qq!</SELECT>\n!;
  2902.         }
  2903.         {
  2904.             $create_options =~ /MAX_ROWS=(\w+)\s?/i;
  2905.             $option[2] = qq!MAX_ROWS</TD><TD><INPUT TYPE=TEXT NAME="MAX_ROWS" VALUE="$1" TITLE="The maximum number of rows you plan to store in the table. (MyISAM tables) See the description of AVG_ROW_LENGTH in MySQL manual.">!;
  2906.         }
  2907.         {
  2908.             $create_options    =~ /CHECKSUM=(\w+)\s?/i;
  2909.             $option[3]        = qq!CHECKSUM</TD><TD TITLE="If set to 1, MySQL maintains a checksum for each table row. (MyISAM tables)"><SELECT NAME="CHECKSUM">\n!;
  2910.             $selected        = $1 eq '' ? 'SELECTED' : '';
  2911.             $option[3]        .= qq!<OPTION VALUE="" $selected>\n!;
  2912.             $selected        = $1 eq '0' ? 'SELECTED' : '';
  2913.             $option[3]        .= qq!<OPTION VALUE="0" $selected>0\n!;
  2914.             $selected        = $1 eq '1' ? 'SELECTED' : '';
  2915.             $option[3]        .= qq!<OPTION VALUE="1" $selected>1\n!;
  2916.             $option[3]        .= qq!</SELECT>\n!;
  2917.         }
  2918.         {
  2919.             $create_options =~ /AVG_ROW_LENGTH=(\w+)\s?/i;
  2920.             $option[4] = qq!AVG_ROW_LENGTH</TD><TD><INPUT TYPE=TEXT NAME="AVG_ROW_LENGTH" VALUE="$1" TITLE="The approximate average row length of your table. (MyISAM tables) Together with MAX_ROWS it determines the maximum datafile size. See MySQL manual for more info">!;
  2921.         }
  2922.         if (check_version('3.23.3')){
  2923.             $create_options    =~ /DELAY_KEY_WRITE=(\w+)\s?/i;
  2924.             $option[5]        = qq!DELAY_KEY_WRITE</TD><TD TITLE="If this is set to 1, the index cache is flushed only occasionally for the table, rather then after each INSERT operation. (MyISAM tables)"><SELECT NAME="DELAY_KEY_WRITE">\n!;
  2925.             $selected        = $1 eq '' ? 'SELECTED' : '';
  2926.             $option[5]        .= qq!<OPTION VALUE="" $selected>\n!;
  2927.             $selected        = $1 eq '0' ? 'SELECTED' : '';
  2928.             $option[5]        .= qq!<OPTION VALUE="0" $selected>0\n!;
  2929.             $selected        = $1 ? 'SELECTED' : '' ;
  2930.             $option[5]        .= qq!<OPTION VALUE="1" $selected>1\n!;
  2931.             $option[5]        .= qq!</SELECT>\n!;
  2932.         }
  2933.         $option[6]        = qq!AUTO_INCREMENT</TD><TD><INPUT TYPE=TEXT NAME="auto_increment" VALUE="$auto_increment" TITLE="The next AUTO_INCREMENT value to be generated. MyISAM tables and HEAP tables as of MySQL 4.1.">!;
  2934.         
  2935.         if (check_version('3.23.6')){
  2936.             $create_options    =~ /ROW_FORMAT=(\w+)\s?/i;
  2937.             $option[7]        = qq!ROW_FORMAT</TD><TD TITLE="This option specifies the row storage type. (MyISAM tables)"><SELECT NAME="ROW_FORMAT">\n!;
  2938.             $selected        = $1 eq '' ? 'SELECTED' : '';
  2939.             $option[7]        .= qq!<OPTION VALUE="DEFAULT" $selected>DEFAULT\n!;
  2940.             $selected        = $1 eq 'FIXED' ? 'SELECTED' : '';
  2941.             $option[7]        .= qq!<OPTION VALUE="FIXED" $selected>FIXED\n!;
  2942.             $selected        = $1 eq 'DYNAMIC' ? 'SELECTED' : '';
  2943.             $option[7]        .= qq!<OPTION VALUE="DYNAMIC" $selected>DYNAMIC\n!;
  2944.             $selected        = $1 eq 'COMPRESSED' ? 'SELECTED' : '';
  2945.             $option[7]        .= qq!<OPTION VALUE="COMPRESSED" $selected>COMPRESSED\n!;
  2946.             $option[7]        .= qq!</SELECT>\n!;
  2947.         }
  2948.     }
  2949.     my $typeoptionlistref = sub  {
  2950.         my @optionlist;
  2951.         my $type = shift;
  2952.         $type =~ s/^\s*(\w*)(\(.*\))?(.*)/$1/;
  2953.         my $symbols = $2; 
  2954.         my $therest = $3;
  2955.         $symbols =~ s/^\((.*)\)/$1/ if $symbols;
  2956.         
  2957.         my $unsigned = '';
  2958.         my $zerofill = '';
  2959.         my $binary = '';
  2960.         $symbols = quoteit($symbols);
  2961.         $unsigned = 'CHECKED' if ($therest =~ /unsign/i);
  2962.         $zerofill = 'CHECKED' if ($therest =~ /zerofill/i);
  2963.         $binary = 'CHECKED' if ($therest =~ /binary/i);
  2964.         for (my $i=0; $i<@typelist; $i++) {
  2965.             my $selected = 'SELECTED' if ($typelist[$i] =~ /^($type)$/i);
  2966.             push @optionlist, qq!<OPTION VALUE="$typelist[$i]" $selected>$typelist[$i] \n!;
  2967.         }
  2968.  
  2969. return (\@optionlist, $type, $symbols, $unsigned, $zerofill, $binary) if wantarray;
  2970. return (\@optionlist) if defined wantarray;
  2971. };
  2972.     my ($newtablength, $textsize, $textsize1, $lengthsize, $textareasize) = $agent ? (23, 13, 10, 10, 30 ) : (30, 20, 15, 16, 40 );
  2973.  
  2974.     print qq!<FORM METHOD=POST ACTION="$full_url" ID="form1">!;
  2975.     my ($procname, $tabtitle, $colnametitle, $saveastitle, $saveas1, $ignore);
  2976.     my $ignoreselected = 'CHECKED' if ($q->param('ignore') and !$reload);
  2977.     if (@tabs) {
  2978.         $procname         = qq!ALTER TABLE!;
  2979.         $tabtitle         = qq!Edit table name.\nAlphanumeric characters and underscore only!;
  2980.         $colnametitle     = qq!Edit column name.\nAlphanumeric characters and underscore only!;
  2981.         $saveastitle     = qq!Type the name of a new table.\nAlphanumeric characters and underscore only!;
  2982.         $saveas1        = qq!<INPUT TYPE=SUBMIT NAME="saveas" VALUE="Save as"  style="width: 80" TITLE="Create new table with the same structure. All changes will be applied to new table">!;
  2983.         $ignore            = qq?   <INPUT TYPE=CHECKBOX NAME="ignore" VALUE="1" $ignoreselected TITLE="The rows that duplicate values for unique key values will be deleted!"><FONT COLOR="#CC0000" TITLE="The rows that duplicate values for unique key values will be deleted!">IGNORE</FONT>?;
  2984.     }
  2985.     else {
  2986.         $procname         = "CREATE NEW TABLE";
  2987.         $tabtitle         = "Type the name of new table.\nAlphanumeric characters and underscore only";
  2988.         $colnametitle     = "Type column name in this field.\nAlphanumeric characters and underscore only";
  2989.     }
  2990.     my $newtabvalue = $reload ?  $tabs[0] : quoteit($q->param('newtablename'));
  2991.     
  2992.     print <<EOT
  2993. <!-- Header Table -->
  2994. <TABLE BORDER=0 CELLSPACING=1 CELLPADDING=2>
  2995.     <TR><TD ALIGN=LEFT COLSPAN=2><FONT COLOR="#003466"><B>$procname</B></FONT>$ignore</TD><TD COLSPAN=3> $input->{msg}</TD><TR>
  2996.     <TR VALIGN=MIDDLE>
  2997.         <TD COLSPAN=2 ><nobr><CODE>TABLE NAME: </CODE><INPUT TYPE=TEXT NAME="newtablename" VALUE="$newtabvalue" SIZE=$newtablength TITLE="$tabtitle"> </nobr></TD>
  2998.         <TD><NOBR>$tabletype</NOBR></TD><TD ALIGN=RIGHT>COMMENT</TD><TD>$comment</TD>
  2999.     </TR>
  3000. <!-- <TR><TH COLSPAN=5 ALIGN=LEFT HEIGHT=0></TH><TR> -->
  3001. <!-- End of Header Table -->
  3002. EOT
  3003. ;
  3004. if (@option){
  3005.     my $tr;
  3006.     my $j;
  3007.     for (my $i=0; $i < 8; $i++){
  3008.         if (my $option = shift @option){
  3009.             unless ($tr){print "<TR><TD ALIGN=RIGHT>$option</TD>"; $tr = 1}
  3010.             else {print "<TD ALIGN=RIGHT COLSPAN=2>$option</TD></TR>\n"; $tr = 0}
  3011.         }
  3012.         elsif ($j){$j=0}
  3013.         else {$j++}
  3014.     }
  3015.     for (1..$j){
  3016.         if($tr){print "<TD COLSPAN=2> </TD><TD> </TD></TR>"; $tr=0}
  3017.         else{print "<TR><TD> </TD><TD> </TD><TD> </TD>"; $tr=1}
  3018.     }
  3019. }
  3020.     print "</TABLE>";
  3021.  
  3022.  
  3023.  
  3024.     print <<EOT
  3025. <TABLE ID="MAIN" BORDER=0 CELLPADDING=2 CELLSPACING=2>    
  3026.     <TR>
  3027.         <TD><p CLASS="shead">$del</p></TD>
  3028.         <TD TITLE="$colnametitle"><p CLASS="shead">COLUMN NAME</p></TD>
  3029.         <TD TITLE="Select column type"><p CLASS="shead">Type</p></TD>
  3030.         <TD TITLE="Type column length or values of ENUM or SET types (quoted and comma separated)"><p CLASS="shead">Length or<BR>enum/set elements</p></TD>
  3031.         <TD TITLE="This attribute disallows negative values.\n(Numerics only)"><p CLASS="shead">Unsigned</p></TD>
  3032.         <TD TITLE="This attribute causes the displayed value to be padded with leading zeros to the display width.\n(Nimerics only)"><p CLASS="shead">Zerofill</p></TD>
  3033.         <TD TITLE="This attribute causes column value to be treated as binary string and case sensitive in comparation and sorting operations.\n(String types only)"><p CLASS="shead">Binary</p></TD>
  3034.         <TD TITLE="This attribute specifies whethere or not the column may contain NULL values. If not specified, NULL is the default."><p CLASS="shead">Not Null</p></TD>
  3035.         <TD TITLE="Specifies the default value for the column. This can not be used for BLOB or TEXT types."><p CLASS="shead">Default</p></TD>
  3036.         <TD TITLE="Selected column will be turned into Autocolumn.\nOnly one column can be Autocolumn">$autoincr</TD>
  3037.     </TR>
  3038. EOT
  3039. ;
  3040. #    my @columns;
  3041.     my @colname            = $q->param('colname');
  3042.     my $pri_flag;
  3043.     my $firstafteroption;
  3044.  
  3045.     if (@tabs > 0){
  3046.         my @type            = $q->param('type');
  3047.         my @length            = $q->param('length');
  3048.         my @unsigned        = $q->param('unsigned');
  3049.         my @notnull            = $q->param('notnull');
  3050.         my @zerofill        = $q->param('zerofill');
  3051.         my @default            = $q->param('default');
  3052.         my @binary            = $q->param('binary');
  3053.         my $autoincrement    = $q->param('autoincrement');
  3054.         my $i                 = 0;
  3055.         while (my @row = $sth->fetchrow_array()) {
  3056.             my ($checkdrop, $colname, $coltype, $default, $type,
  3057.             $symbols, $notnull_selected, $unsigned_selected, $zerofill_selected,
  3058.             $binary_selected, $autoincrement_selected, $drop, $firstafter_selected);
  3059.             my $typeoptionref = [];
  3060.             $drop                = $q->param("drop_column_$row[0]");
  3061.             if ($reload){
  3062.                 $colname[$i]            = $row[0];
  3063.                 $coltype                 = $row[1];
  3064.                 ($typeoptionref, $type, $symbols, $unsigned_selected, $zerofill_selected, $binary_selected, $autoincrement_selected) = &$typeoptionlistref($coltype);
  3065.                 $autoincrement_selected    = 'CHECKED' if ($row[5] =~ /^.*auto.*increment.*$/i);
  3066.                 $default                 = quoteit($row[4]); # defaults
  3067.                 $colname                 = $row[0];
  3068.                 $notnull_selected        = 'CHECKED' unless ($row[2] =~ /yes/i);
  3069.             }
  3070.             else{
  3071.                 $type                     = $type[$i];
  3072.                 $symbols                = quoteit($length[$i]);
  3073.                 $unsigned_selected        = 'CHECKED' if (belongs(\@unsigned, $row[0]));
  3074.                 $zerofill_selected        = 'CHECKED' if (belongs(\@zerofill, $row[0]));
  3075.                 $notnull_selected        = 'CHECKED' if (belongs(\@notnull, $row[0]));
  3076.                 $binary_selected        = 'CHECKED' if (belongs(\@binary, $row[0]));
  3077.                 $autoincrement_selected    = 'CHECKED' if ($autoincrement eq $row[0]);
  3078.                 $default                = quoteit($default[$i]);
  3079.                 $typeoptionref            = &$typeoptionlistref($type[$i]);
  3080.                 $firstafter_selected    = 'SELECTED' if ($q->param('firstafterwhat') eq $colname[$i]);
  3081.                 $colname[$i]            = quoteit($colname[$i]);
  3082.             }
  3083.             $firstafteroption .= qq!<OPTION VALUE="$colname[$i]" $firstafter_selected>$colname[$i]\n! if (!$q->param("drop_column_$row[0]") xor $q->param("release_column_$row[0]"));
  3084.         
  3085.  
  3086.             my $auto = '';
  3087.             if ($row[3] =~ /PRI/i){
  3088.                 if ($auto_type{uc $type}){$auto = qq!<INPUT TYPE=CHECKBOX NAME="autoincrement" VALUE="$row[0]" $autoincrement_selected TITLE="AUTO_INCREMENT columns">!}
  3089.                 else {$auto = qq!<INPUT TYPE=CHECKBOX TITLE="Selected column type doesn't support AUTO_INCREMENT columns" DISABLED>!}
  3090.                 $pri_flag = 1;
  3091.             }
  3092.             else {$auto = qq!<INPUT TYPE=CHECKBOX TITLE="AUTO_INCREMENT column must be defined as PRIMARY KEY" DISABLED>!}
  3093.             
  3094.             if ($drop and !$q->param("release_column_$row[0]")){
  3095.                 $type                 = $row[1];
  3096.                 $type                 =~ s/^\s*(\w*)(\(.*\))?(.*)/$1/;
  3097.                 $type                = uc $type;
  3098.                 $symbols            = $2; 
  3099.                 my $therest            = $3;
  3100.                 $symbols            =~ s/^\((.*)\)/$1/ if $symbols;
  3101.                 $symbols            = quoteit($symbols);
  3102.                 my $unsigned        = $row[0] if ($therest =~ /unsign/i);
  3103.                 my $zerofill        = $row[0] if ($therest =~ /zerofill/i);
  3104.                 my $binary            = $row[0] if ($therest =~ /binary/i);
  3105.                 my $notnull            = $row[0] unless ($row[2] =~ /yes/i);
  3106.                 $default             = quoteit($row[4]); # defaults
  3107.                 $autoincrement        = ($row[5] =~ /^.*auto.*increment.*$/i) ? $row[0] : '';
  3108.                 print <<EOT
  3109.     <TR>
  3110.         <TD><INPUT TYPE=SUBMIT NAME="release_column_$row[0]" VALUE="O" TITLE="CLICL TO KEEP THIS COLUMN" style="width: 20" notab  tabindex=0 taborder=0></TD>
  3111.         <TD  COLSPAN=3>
  3112.         $row[0]
  3113.         <INPUT TYPE=HIDDEN NAME="colname"                 VALUE="$row[0]">
  3114.         <INPUT TYPE=HIDDEN NAME="type"                     VALUE="$type">
  3115.         <INPUT TYPE=HIDDEN NAME="length"                 VALUE="$symbols">
  3116.         <INPUT TYPE=HIDDEN NAME="unsigned"                 VALUE="$unsigned">
  3117.         <INPUT TYPE=HIDDEN NAME="zerofill"                 VALUE="$zerofill">
  3118.         <INPUT TYPE=HIDDEN NAME="binary"                 VALUE="$binary">
  3119.         <INPUT TYPE=HIDDEN NAME="notnull"                VALUE="$notnull">
  3120.         <INPUT TYPE=HIDDEN NAME="default"                 VALUE="$default">
  3121.         <INPUT TYPE=HIDDEN NAME="autoincrement"            VALUE="$autoincrement">
  3122.         <INPUT TYPE=HIDDEN NAME="drop_column_$row[0]"    VALUE="X">
  3123.         </TD>
  3124.         <TD COLSPAN=6>THIS COLUMN WILL BE DROPPED</TD>
  3125.     <TR>
  3126. EOT
  3127. ;
  3128.             }
  3129.             else{
  3130.                 my $DisabledTitle1 = 'This column type can not have Default Values';
  3131.                 my $DisabledTitle2 = 'This column type does not allow such values';
  3132.                 my ($unsigned, $zerofill, $binary);
  3133.                 if ($type =~ /int|decimal/i or (check_version('4.0.2') and $type =~/double|float/i)){
  3134.                     $unsigned = qq!<INPUT TYPE=CHECKBOX NAME="unsigned" VALUE="$row[0]" $unsigned_selected TITLE="This attribute disallows negative values.\n(Numerics only)">! 
  3135.                 }
  3136.                 else {
  3137.                     $unsigned = qq!<INPUT TYPE=CHECKBOX TITLE="This column type does not allow this option" DISABLED>!;
  3138.                     $unsigned .= qq!<INPUT TYPE=HIDDEN NAME="unsigned" VALUE="$row[0]">! if $unsigned_selected
  3139.                 } 
  3140.  
  3141.                 
  3142.                 if ($type =~ /int|decimal|double|float/i){
  3143.                     $zerofill    = qq!<INPUT TYPE=CHECKBOX NAME="zerofill" VALUE="$row[0]" $zerofill_selected TITLE="This attribute causes the displayed value to be padded with leading zeros to the display width.\n(Nimerics only)">!
  3144.                 }
  3145.                 else {
  3146.                     $zerofill    = qq!<INPUT TYPE=CHECKBOX TITLE="This column type does not allow this option" DISABLED>!;
  3147.                     $zerofill    .= qq!<INPUT TYPE=HIDDEN NAME="zerofill" VALUE="$row[0]">! if $zerofill_selected
  3148.                 }
  3149.                 
  3150.                 
  3151.                 if ($type =~ /char/i) {
  3152.                     $binary    = qq!<INPUT TYPE=CHECKBOX NAME="binary" VALUE="$row[0]" $binary_selected TITLE="This attribute causes column value to be treated as binary string and case sensitive in comparation and sorting operations.\n(String types only)">!
  3153.                 }
  3154.                 else{
  3155.                     $binary    = qq!<INPUT TYPE=CHECKBOX TITLE="This column type does not allow this option" DISABLED>!;
  3156.                     $binary    .= qq!<INPUT TYPE=HIDDEN NAME="binary" VALUE="$row[0]">! if $binary_selected
  3157.                 }
  3158.                 
  3159.                 my $notnull    = qq!<INPUT TYPE=CHECKBOX NAME="notnull" VALUE="$row[0]" $notnull_selected TITLE="This attribute specifies whethere or not the column may contain NULL values. If not specified, NULL is the default.">!;
  3160.                 my $defaultvalue = 
  3161.                 ($type !~ /text|blob/i) ? 
  3162.                 qq!<INPUT TYPE=TEXT NAME="default" VALUE="$default" SIZE=$textsize1 TITLE="Specifies the default value for the column. This can not be used for BLOB or TEXT types.">!
  3163.                 : qq!<INPUT TYPE=TEXT VALUE="" DISABLED SIZE=$textsize1 TITLE="$DisabledTitle1" style="background color: #CCCCCC"><INPUT TYPE=HIDDEN NAME="default" VALUE="$default">!;
  3164.                 my $length        = 
  3165.                 ($type =~ /int|decimal|double|float|char|enum|set|year|timestamp/i) ? 
  3166.                 qq!<INPUT TYPE=TEXT NAME="length" SIZE=$lengthsize VALUE="$symbols"  TITLE="Type column length or values of ENUM or SET types (quoted and comma separated)">! 
  3167.                 : qq!<INPUT TYPE=TEXT SIZE=$lengthsize VALUE="" DISABLED SIZE=$lengthsize TITLE="$DisabledTitle2" style="background color: #CCCCCC"><INPUT TYPE=HIDDEN NAME="length" VALUE="$symbols" >!;
  3168.                 print <<EOT
  3169.     <TR>
  3170.         <TD><INPUT TYPE=SUBMIT NAME="drop_column_$row[0]" VALUE="X" TITLE="Click to drop this column" style="width: 20" notab tabindex=0 taborder=0></TD>
  3171.         <TD><INPUT TYPE=TEXT NAME="colname" VALUE="$colname[$i]" TITLE="Edit column name" SIZE=$textsize></TD>
  3172.         <TD TITLE="Select column type"><SELECT NAME="type" TITLE="Select column type"  onChange="this.form.submit()">
  3173. @$typeoptionref
  3174.             </SELECT></TD>
  3175.         <TD><NOBR>$proof $length</NOBR></TD>    
  3176.         <TD>$unsigned</TD>
  3177.         <TD>$zerofill</TD>
  3178.         <TD>$binary</TD>
  3179.         <TD>$notnull</TD>
  3180.         <TD>$defaultvalue</TD>
  3181.         <TD>$auto</TD>        
  3182.     <TR>
  3183. EOT
  3184. ;
  3185.             }
  3186.             $i++;
  3187.         }#WHILE
  3188.         $sth->finish();
  3189.     }#if tabs>0
  3190.     print "\t<TR><TD COLSPAN=10>$hr</TD></TR>\n";
  3191.     print "\t<TR><TD COLSPAN=10><B>$newcolumn</B></TD></TR>\n";
  3192.     my ($newcoltyperef, $newcolname, $newcollength, $newcoldefault, $unsigned_new, $zerofill_new, $binary_new, $notnull_new);
  3193.     if ($reload){
  3194.         $newcoltyperef    = &$typeoptionlistref();
  3195.         $newcollength    = qq!<INPUT TYPE=TEXT style="background color: #CCCCCC" DISABLED SIZE=$lengthsize TITLE="Please select column type">!;
  3196.         $newcoldefault    = qq!<INPUT TYPE=TEXT style="background color: #CCCCCC" DISABLED SIZE=$textsize1 TITLE="Please select column type">!;
  3197.         $unsigned_new    = $zerofill_new = $binary_new = $notnull_new = qq!<INPUT TYPE=CHECKBOX TITLE="Please select column type" DISABLED>!
  3198.     }
  3199.     else{
  3200.         my $type        = $q->param('newcoltype');
  3201.         $newcolname        = quoteit($q->param('newcolname'));
  3202.         $newcollength    = quoteit($q->param('newcollength'));
  3203.         $newcoldefault    = quoteit($q->param('newcoldefault'));
  3204.         $unsigned_new    = 'CHECKED' if $q->param('unsigned_new');
  3205.         $zerofill_new    = 'CHECKED' if $q->param('zerofill_new');
  3206.         $binary_new        = 'CHECKED' if $q->param('binary_new');
  3207.         $notnull_new    = 'CHECKED' if $q->param('notnull_new');
  3208.         $newcoltyperef    = &$typeoptionlistref($type);
  3209.         
  3210.         if ($type =~ /(int)|(decimal)|(double)|(float)|(char)|(enum)|(set)|(year)|(timestamp)/i){
  3211.             $newcollength = qq!<INPUT TYPE=TEXT NAME="newcollength" SIZE=$lengthsize VALUE="$newcollength" TITLE="Type column length or values of ENUM or SET types (quoted and comma separated)">!;
  3212.         }
  3213.         else {
  3214.             $newcollength = qq!<INPUT TYPE=TEXT style="background color: #CCCCCC" DISABLED SIZE=$lengthsize TITLE="This column type does not allow such values">!;
  3215.         }
  3216.         if ($type and $type !~ /(text)|(blob)/i){
  3217.             $newcoldefault = qq!<INPUT TYPE=TEXT NAME="newcoldefault" VALUE="$newcoldefault" size=$textsize1 TITLE="Specifies the default value for the column. This can not be used for BLOB or TEXT types.">!;
  3218.         }
  3219.         else {
  3220.             $newcoldefault = qq!<INPUT TYPE=TEXT style="background color: #CCCCCC" DISABLED size=$textsize1 TITLE="This column type can not have Default Values">!
  3221.         }
  3222.         if ($type =~ /(int)|(decimal)/i or (check_version('4.0.2') and $type =~/(double)|(float)/i)){
  3223.             $unsigned_new = qq!<INPUT TYPE=CHECKBOX NAME="unsigned_new" $unsigned_new TITLE="This attribute disallows negative values \n(Numerics only)">!
  3224.         }
  3225.         else{
  3226.             $unsigned_new = qq!<INPUT TYPE=CHECKBOX TITLE="This column type does not allow this option" DISABLED>!
  3227.         }
  3228.         if ($type =~ /(int)|(decimal)|(double)|(float)/i){
  3229.             $zerofill_new = qq!<INPUT TYPE=CHECKBOX NAME="zerofill_new" $zerofill_new TITLE="This attribute causes the displayed value to be padded with leading zeros to the display width.\n(Nimerics only)">!
  3230.         }
  3231.         else{
  3232.             $zerofill_new = qq!<INPUT TYPE=CHECKBOX TITLE="This column type does not allow this option" DISABLED>!
  3233.         }
  3234.         if ($type =~ /char/i){
  3235.             $binary_new = qq!<INPUT TYPE=CHECKBOX NAME="binary_new" $binary_new TITLE="This attribute causes column value to be treated as binary string and case sensitive in comparation and sorting operations.\n(String types only)">!
  3236.         }
  3237.         else{
  3238.             $binary_new = qq!<INPUT TYPE=CHECKBOX TITLE="This column type does not allow this option" DISABLED>!
  3239.         }
  3240.         if($type){
  3241.             $notnull_new = qq!<INPUT TYPE=CHECKBOX NAME="notnull_new" $notnull_new TITLE="This attribute specifies whethere or not the column may contain NULL values. If not specified, NULL is the default.">!
  3242.         }
  3243.         else{
  3244.             $notnull_new = qq!<INPUT TYPE=CHECKBOX TITLE="This column type does not allow this option" DISABLED>!
  3245.         }
  3246.     }
  3247.  
  3248.     print <<EOT
  3249.     <TR>
  3250.         <TD> </TD>
  3251.         <TD><INPUT TYPE=TEXT NAME="newcolname" VALUE="$newcolname" SIZE=$textsize TITLE="Type new column name. The name must be unique and consist of alphanumeric and underscore characters only."></TD>
  3252.         <TD TITLE="Select column type"><SELECT SIZE=1 NAME="newcoltype" TITLE="Select column type" onChange="this.form.submit()">
  3253.         <OPTION VALUE="" SELECTED> 
  3254. @$newcoltyperef
  3255.         </SELECT></TD>
  3256.         <TD><NOBR>$proof $newcollength</NOBR></TD>
  3257.         <TD>$unsigned_new</TD>
  3258.         <TD>$zerofill_new</TD>
  3259.         <TD>$binary_new</TD>
  3260.         <TD>$notnull_new</TD>
  3261.         <TD>$newcoldefault</TD>
  3262.         <TD> </TD>        
  3263.     </TR>
  3264. EOT
  3265. ;    
  3266. # first / after
  3267.     if (@tabs > 0){
  3268.         my ($selected_f, $selected_a, $enkeysselected, $diskeysselected, $orderby, $enkeys, $orderbyvalye, $ascchecked, $desccheched);
  3269.         unless($reload){
  3270.             my $firstafter        = $q->param('firstafter');
  3271.             $selected_f            = 'SELECTED'    if $firstafter eq 'FIRST';
  3272.             $selected_a            = 'SELECTED'    if $firstafter eq 'AFTER';
  3273.             $enkeysselected     = 'CHECKED'        if $q->param('enkeys') eq 'ENABLE';
  3274.             $diskeysselected    = 'CHECKED'        if $q->param('enkeys') eq 'DISABLE';
  3275.             $ascchecked            = 'CHECKED'    if $q->param('order') eq 'ASC';
  3276.             $desccheched        = 'CHECKED'    if $q->param('order') eq 'DESC';
  3277.             
  3278.             $orderbyvalye        = quoteit(deletespace($q->param('orderby')));
  3279.         }
  3280.         if (check_version("4.0.0")){
  3281.             $enkeys = <<EOT
  3282.         <TD><INPUT TYPE=RADIO NAME="enkeys" VALUE="ENABLE" $enkeysselected></TD>
  3283.         <TD>ENABLE KEYS</TD>
  3284.         <TD><INPUT TYPE=RADIO NAME="enkeys" VALUE="DISABLE" $diskeysselected></TD>
  3285.         <TD>DISABLE KEYS</TD>
  3286. EOT
  3287. ;
  3288.         }
  3289.         if (check_version("3.23.28")){
  3290.             my $size = $agent ? 40 : 55;
  3291.             $orderby = <<EOT
  3292.         <TD>ORDER BY</TD>
  3293.         <TD><INPUT TYPE=TEXT NAME="orderby" SIZE=$size TITLE="Column names separated by comma" VALUE="$orderbyvalye"></TD>
  3294.         <TD><INPUT TYPE=RADIO NAME="order" VALUE="ASC" $ascchecked></TD>
  3295.         <TD>ASC</TD>
  3296.         <TD><INPUT TYPE=RADIO NAME="order" VALUE="DESC" $desccheched></TD>
  3297.         <TD>DESC</TD>
  3298. EOT
  3299. ;
  3300.         }
  3301.          
  3302.         print <<EOT
  3303.     <TR>
  3304.         <TD> </TD>
  3305.         <TD ALIGN=RIGHT><SELECT NAME="firstafter" SIZE=1>
  3306. <OPTION VALUE="" SELECTED>
  3307. <OPTION VALUE="FIRST" $selected_f>FIRST
  3308. <OPTION VALUE="AFTER" $selected_a>AFTER
  3309. </SELECT></TD>
  3310.         <TD COLSPAN=8 TITLE="Define where to place new column">
  3311. <SELECT NAME="firstafterwhat" SIZE=1 TITLE="Define where to place new column">
  3312. <OPTION VALUE="">SELECT COLUMN
  3313. <OPTION VALUE="">-------------
  3314. $firstafteroption
  3315. </SELECT></TD>
  3316.     </TR>
  3317. </TABLE>
  3318. <HR SIZE="1" LENGTH="700">
  3319. EOT
  3320. ;
  3321. if ($orderby or $enkeys){
  3322.     print <<EOT
  3323. <TABLE>
  3324.     <TR>
  3325. $enkeys
  3326.         <TD> </TD>
  3327. $orderby
  3328.     </TR>
  3329. </TABLE>
  3330. <HR SIZE="1" LENGTH="700">
  3331. EOT
  3332. ;
  3333. }
  3334. # KEYS
  3335.  
  3336.         $query            = "SHOW INDEX FROM $tabs[0]";
  3337.         ($sth, $res)    = prepare_execute($query, $back,'2');
  3338.         if ($res > 0){
  3339.             print <<EOT
  3340. <BR><CODE>Drop the Key:</CODE><BR>
  3341. <TABLE BORDER=0 CELLPADDING=2 CELLSPACING=2>
  3342.     <TR>
  3343.         <TD><B>Select</B></TD>
  3344.         <TD><B>KEY NAME</B></TD>
  3345.         <TD><B>KEY</B></TD>
  3346.         <TD><B>COLUMN NAME (SUB PART)</B></TD>
  3347.     </TR>
  3348. EOT
  3349. ;
  3350.             my $matrix_ref    = $sth->fetchall_arrayref();
  3351.             my ($rows)        = (!defined($matrix_ref)? 0: scalar(@{$matrix_ref}));
  3352.             my ($cols)        = 10;
  3353.             my @matrix        = @{$matrix_ref};
  3354.             my $k            = 0;
  3355.             $sth->finish();
  3356.             my $ref;
  3357.             while (scalar  @matrix){
  3358.                 my %hashmatrix    = ();
  3359.                 my $thekey        = $matrix[0][2];
  3360.                 for (my $j = 0; $j < @matrix; $j++){
  3361.                     if ($matrix[$j][2] eq $thekey) {
  3362.                         $hashmatrix{$matrix[$j][3]}    = $matrix[$j];
  3363.                         $ref                         = splice (@matrix, $j, 1);
  3364.                         $j--;
  3365.                     }#IF 
  3366.                 }#FOR
  3367.                 if ((keys %hashmatrix) > 0) {
  3368.                     my @row =  @{$hashmatrix{1}};
  3369.                     my $keytype;
  3370.                     if ($row[1] == 0){
  3371.                         if ($row[2]     =~ /^\s*primary\s*$/i){$keytype = 'PRIMARY KEY'}
  3372.                         else {$keytype    = 'UNIQUE'}
  3373.                     }
  3374.                     else {
  3375.                         if (($row[9] =~ /^\s*FULLTEXT\s*$/i) or ($row[10] =~ /^\s*FULLTEXT\s*$/i)){$keytype = 'FULLTEXT';}
  3376.                         else {$keytype = 'INDEX' }
  3377.                     }
  3378.                 
  3379.                     my $options;
  3380.                     foreach (sort {$a <=> $b}(keys %hashmatrix)) {
  3381.                         my @row = @{$hashmatrix{$_}};
  3382.                         my $subpart = "($row[7])" if ($row[7]);
  3383.                         $options .= qq!<OPTION VALUE="">$row[4]$subpart\n!;
  3384.                     }#FOREACH
  3385.                     my $checked = '';
  3386.                     unless ($reload){
  3387.                         my @drop_key    = $q->param('drop_key');
  3388.                         $checked        = 'CHECKED' if (belongs(\@drop_key, $row[2]));
  3389.                     }
  3390.                     print qq!
  3391.     <TR><TD><INPUT TYPE=CHECKBOX NAME="drop_key" VALUE="$row[2]" TITLE="Select key to drop" $checked></TD>
  3392.         <TD BGCOLOR="#EEEEEE">$row[2]</TD>
  3393.         <TD BGCOLOR="#EEEEEE">$keytype</TD>
  3394.         <TD BGCOLOR="#EEEEEE"><SELECT SIZE=1 style="color: #a0a0a0">$options</SELECT></TD>
  3395.     </TR>\n!;
  3396.                 }#IF
  3397.  
  3398.                 bail_out("Counter Overflow. Sorry!") if ($k++ > 100000);
  3399.             }#WHILE
  3400.         print "</TABLE>\n<HR SIZE=1 LENGTH=700><BR>";
  3401.         }#if res > 0
  3402.         my $keyname        = '';
  3403.         my @keytype        = ();
  3404.         my $indcolname    = '';
  3405.         unless ($reload){
  3406.             $keyname    = quoteit($q->param('keyname'));
  3407.             my $i        = 0;
  3408.             foreach ('PRIMARY KEY', 'UNIQUE', 'INDEX', 'FULLTEXT'){
  3409.                 $keytype[$i] = 'SELECTED' if ($q->param('keytype') eq $_);
  3410.                 $i++;
  3411.             }
  3412.             $indcolname = quoteit($q->param('indcolname'));
  3413.         }
  3414.         my $fulltext    = qq!<OPTION VALUE="FULLTEXT" $keytype[3]>FULLTEXT! if (check_version('3.23.23'));
  3415.         print <<EndNewIndex
  3416. <TABLE BORDER=0 CELLPADDING=2 CELLSPACING=2>
  3417.     <TR>
  3418.         <TD COLSPAN=3><CODE>Add New Key:</CODE></TD>
  3419.     <TR>
  3420.         <TD><B>KEY NAME</B></TD>
  3421.         <TD><B>KEY</B></TD>
  3422.         <TD><B>COLUMN NAMES</B><i> comma separated</i></TD>
  3423.     </TR>
  3424.     <TR>
  3425.         <TD><I>optionally</I><br><INPUT TYPE=TEXT NAME="keyname" VALUE="$keyname" SIZE=12 TITLE="Type key name. Alphanumeric and underscore characters only"></TD>
  3426.         <TD TITLE="Select the key type"> <BR><SELECT SIZE=1 NAME="keytype" TITLE="Select the key type">
  3427.             <OPTION VALUE="">
  3428.             <OPTION VALUE="PRIMARY KEY" $keytype[0]>PRIMARY
  3429.             <OPTION VALUE="UNIQUE" $keytype[1]>UNIQUE
  3430.             <OPTION VALUE="INDEX" $keytype[2]>INDEX
  3431.             $fulltext
  3432.             </SELECT></TD>
  3433.         <TD><TEXTAREA ROWS=3 COLS=$textareasize NAME="indcolname" TITLE="Type the column names comprising the key.\nComma separated">$indcolname</TEXTAREA></TD>
  3434.     </TR>
  3435. </TABLE>
  3436. <HR SIZE=1 LENGTH=700>
  3437. EndNewIndex
  3438. ;
  3439.     
  3440.     }#if @tabs>0 (for keys)
  3441.     else {print "</TABLE><P>";}
  3442.     my $action = '';
  3443.     if (($q->param('func') =~ /import/i) or ($q->param('func') =~ /export/i)){
  3444.         $action = $q->param('func');
  3445.     }
  3446.     elsif (($q->param('action') =~ /import/i) or ($q->param('action') =~ /export/i)){
  3447.         $action = $q->param('action');
  3448.     }
  3449.     if ($action){print qq!\n<INPUT TYPE=HIDDEN NAME="action" VALUE="$action">\n!;}
  3450.     my $sqlchecked = 'CHECKED' if $q->param('preview');
  3451.     foreach (keys %option_){print qq!<INPUT TYPE=HIDDEN NAME="$_" VALUE="$option_{$_}">\n!}
  3452.  
  3453.     print <<EOT
  3454. <INPUT TYPE=HIDDEN NAME="tables" VALUE="$tabs[0]">
  3455. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  3456. <INPUT TYPE=HIDDEN NAME="page" VALUE="$page">
  3457. <TABLE BORDER=0 CELLPADDIND=0 CELLSPACING=0>
  3458.     <TR>
  3459.         <TD COLSPAN=5 TITLE="Check to preview generated command">
  3460.         <INPUT TYPE=CHECKBOX NAME="preview" TITLE="Check to preview generated command" $sqlchecked> Preview SQL query.</TD>
  3461.     </TR>
  3462.     <TR>
  3463.         <TD><INPUT TYPE=SUBMIT VALUE="   SAVE   " NAME="alter" TITLE="Apply changes" onLoad="focus=on" tabindex=1 taborder=1 style="width: 80; color: #cc0000"> </TD>
  3464.         <TD>$saveas1</TD>
  3465.         <TD><INPUT TYPE=SUBMIT NAME="reload" VALUE="RELOAD" TITLE="READ ORIGINAL VALUES. ALL CHANGE WILL BE LOST" style="width: 80"></TD>
  3466.         <TD><INPUT TYPE=SUBMIT VALUE="PROOF" TITLE="READ ORIGINAL VALUES. ALL CHANGE WILL BE LOST" style="width: 120"></TD>
  3467.         <TD><INPUT TYPE=RESET TITLE="Reset form" style="width: 80"></TD>
  3468.     </TR>
  3469. </TABLE>
  3470. </FORM>
  3471.  
  3472.  
  3473. EOT
  3474. ;
  3475.     print "<FORM ACTION=$full_url METHOD=POST>\n";
  3476.     print qq!<INPUT TYPE=SUBMIT NAME="back" VALUE="Back">\n!;
  3477.     foreach (keys %$back){print qq!<INPUT TYPE=HIDDEN NAME="$_" VALUE="$back->{$_}">\n!}
  3478.     print "</FORM>\n\n";
  3479.     print "<!-- Alter procedure ends here -->\n\n";
  3480.  
  3481.     return;
  3482.  
  3483. }
  3484.  
  3485. sub execAlterTable {
  3486.     unless ($q->param('alter') or $q->param('saveas')){&loadAlterTable(); return}
  3487.     my $table             = deletespace($q->param('tables'));
  3488.     my $scl;
  3489.     my $newtablename     = deletespace($q->param('newtablename'));
  3490.     my $back            = {};
  3491.     $back->{page}         = 'tables';
  3492.     $back->{dbname}        = $database;
  3493.     $back->{func}        = $table ? 'alter' : 'create';
  3494.     $back->{tables}     = "$table" if $table;
  3495.     if (my $action = $q->param('action')){$back->{action} = $action}
  3496.  
  3497.     my $saveas;
  3498.     my @drop_key        = ();
  3499.     my $rename;
  3500.     my @drop_column        = ();
  3501.     my @change_column    = ();
  3502.     my $add_column        = ();
  3503.     my $add_ind;
  3504.     my $options;
  3505.     my $order    = '';
  3506.     my $enkeys    = '';
  3507.     if ($table) {
  3508.     
  3509. #1) DROP KEYS
  3510.         my @dropind                 = $q->param('drop_key');
  3511.         foreach (@dropind){
  3512.              push @drop_key,((/^\s*primary\s*/i)? "\nDROP PRIMARY KEY" : "\nDROP INDEX $_");
  3513.         }
  3514.  
  3515. #2) RENAME OR SAVE AS
  3516.         if ($newtablename ne $table) {
  3517.             if ($q->param('saveas')){
  3518.                 my $include        = $q->param('savewhat');
  3519.                 $include        = 'both' if ($include eq 'data');
  3520.                 my $hashref     = {
  3521.                     newtablelist    => [$newtablename],
  3522.                     tablelist         => [$table],
  3523.                     include            => 'structure',
  3524.                     dropifexists    => '0',
  3525.                     back            => '$back',
  3526.                     comments        => '0',
  3527.                     lock            => '0'
  3528.                 };
  3529.                 $saveas            = getdatanstructure($hashref);
  3530.                 $saveas            =~ s/^(.*)\s*;$/$1/m;
  3531.                 
  3532.             }
  3533.             else{
  3534.                 $rename = "\nRENAME $newtablename";
  3535.             }
  3536.         }
  3537.         my @colname         = $q->param('colname');
  3538.         my @type             = $q->param('type');
  3539.         my @length             = $q->param('length');
  3540.         my @unsigned         = $q->param('unsigned');
  3541.         my @zerofill         = $q->param('zerofill');
  3542.         my @binary             = $q->param('binary');
  3543.         my @notnull         = $q->param('notnull');
  3544.         my @default         = $q->param('default');
  3545.         my @autoincrement     = $q->param('autoincrement');
  3546.     
  3547.         my $query             = "DESCRIBE $table";
  3548.         my ($sth, $res)     = prepare_execute($query,$back);
  3549.     $scl                = scalar @colname;
  3550.     if ($newtablename ne $table) {if ($scl > 4){bail_out ($demomsg1, $back)}}
  3551.         my $typeref         = sub  {
  3552.             my $type             = shift;
  3553.             $type                 =~ s/^\s*(\w*)(\(.*\))?(.*)/$1/;
  3554.             my $symbols         = $2; 
  3555.             my $therest         = $3;
  3556.             $symbols             =~ s/^\((.*)\)/$1/ if ($symbols);
  3557.             my $unsigned         = '';
  3558.             my $zerofill         = '';
  3559.             my $binary             = '';
  3560.             $symbols             = quoteit($symbols);
  3561.             $unsigned             = '1' if ($therest =~ /unsign/i);
  3562.             $zerofill             = '1' if ($therest =~ /zerofill/i);
  3563.             $binary             = '1' if ($therest =~ /binary/i);
  3564.             return ($type, $symbols, $unsigned, $zerofill, $binary);
  3565.         };
  3566.         my $i                 = 0;
  3567.         while (my @row = $sth->fetchrow_array()) {
  3568.             if ($q->param("drop_column_$row[0]")){
  3569.                 push @drop_column, "\nDROP COLUMN $row[0]";
  3570.             }
  3571.             else {
  3572.                 my ($type, $length, $unsigned, $zerofill, $binary) = &$typeref($row[1]);
  3573.                 my $autoincrement     = '1' if ($row[5] =~ /^.*auto.*increment.*$/i);
  3574.                    my $notnull         = '';
  3575.                 $notnull             = 1 unless ($row[2] =~ /yes/i);
  3576.                 my $default         = $row[4];
  3577.                 my $unsigned_         = (belongs(\@unsigned,$row[0]) and ($type[$i] =~ /int|decimal/i or (check_version('4.0.2') and $type[$i] =~/double|float/i)));
  3578.                 my $zerofill_         = (belongs(\@zerofill,$row[0]) and ($type[$i] =~ /int|decimal|double|float/i));
  3579.                 my $binary_         = (belongs(\@binary,$row[0]) and ($type[$i] =~ /char/i));
  3580.                 my $notnull_         = belongs(\@notnull,$row[0]);
  3581.                 my $autoincrement_     = belongs(\@autoincrement,$row[0]);
  3582.                 if ($type[$i] =~ /int|decimal|double|float|char|enum|set|year|timestamp/i){$length[$i] = deletespace($length[$i])}
  3583.                 else {$length[$i] = ''}
  3584.                 if ($type[$i] =~ /text|blob/i){$default[$i] = ''}
  3585.                 if (
  3586.                            ($colname[$i] ne $row[0]) 
  3587.                     or    ($type[$i] !~ /^($type)$/i)
  3588.                     or    ($length[$i]        ne $length)
  3589.                     or    ($default[$i]        ne $default)
  3590.                     or    ($unsigned_            xor $unsigned)
  3591.                     or    ($zerofill_            xor $zerofill)
  3592.                     or    ($binary_            xor $binary)
  3593.                     or    ($notnull_            xor $notnull)
  3594.                     or    ($autoincrement_     xor $autoincrement)
  3595.                     )
  3596.                 {
  3597.                     if ($unsigned_) {$unsigned_             = ' UNSIGNED'} else {$unsigned_ = ''}
  3598.                     if ($zerofill_) {$zerofill_             = ' ZEROFILL'} else {$zerofill_ = ''}
  3599.                     if ($binary_)   {$binary_                 = ' BINARY'}     else {$binary_ = ''}
  3600.                     if ($notnull_)  {$notnull_                 = ' NOT NULL'}    else {$notnull_ = ''}
  3601.                     if ($autoincrement_) {$autoincrement_     = ' AUTO_INCREMENT'} else {$autoincrement_ = ''}
  3602.                     if ($default[$i]) {$default = " DEFAULT ".$dbh->quote($default[$i])} else {$default = ''}; 
  3603.                     $length[$i] = '('.$length[$i].')' if ($length[$i] ne '');
  3604.                     push @change_column, "\nCHANGE COLUMN $row[0] $colname[$i] $type[$i]$length[$i]"."$unsigned_"."$zerofill_"."$binary_"."$notnull_"."$default"."$autoincrement_";
  3605.                 }        
  3606.                         
  3607.             }#unless
  3608.             $i++;
  3609.         }
  3610.         $sth->finish();
  3611. #ORDER BY
  3612.         if ($order = $q->param('orderby')){
  3613.             my $asc        = $q->param('order');
  3614.             $order        = "ORDER BY $order $asc";
  3615.         }
  3616. #ENABLE / DISABLE KEYS
  3617.         if ($enkeys = $q->param('enkeys')){
  3618.             $enkeys .= ' KEYS' 
  3619.         }
  3620.     } #if table
  3621. #OPTIONS
  3622.         if (check_version("3.23.00")){
  3623.             my $errmsg = '';
  3624.             my $tabletype    = $q->param('tabletype');
  3625.             my $tabletype_    = $q->param('tabletype_');
  3626.             if ($tabletype){
  3627.                 if ($tabletype_ !~ /^$tabletype$/i){$options = "TYPE=$tabletype "}
  3628.             }
  3629.             my $MIN_ROWS        = deletespace($q->param('MIN_ROWS'));
  3630.             my $MIN_ROWS_        = $q->param('MIN_ROWS_');
  3631.             if ($MIN_ROWS =~ /\D/){$errmsg .= "Parameter MIN_ROWS must contain integer values only\n"}
  3632.             elsif ($MIN_ROWS ne $MIN_ROWS_){
  3633.                 unless ($MIN_ROWS){$options .= "MIN_ROWS=0 "}
  3634.                 else{$options .= "MIN_ROWS=$MIN_ROWS "}
  3635.             }
  3636.             my $MAX_ROWS        = deletespace($q->param('MAX_ROWS'));
  3637.             my $MAX_ROWS_        = $q->param('MAX_ROWS_');
  3638.             if ($MAX_ROWS =~ /\D/){$errmsg .= "Parameter MAX_ROWS must contain integer values only\n"}
  3639.             elsif ($MAX_ROWS ne $MAX_ROWS_){
  3640.                 unless ($MAX_ROWS){$options .= "MAX_ROWS=0 "}
  3641.                 else{$options .= "MAX_ROWS=$MAX_ROWS "}
  3642.             }
  3643.             my $AVG_ROW_LENGTH        = deletespace($q->param('AVG_ROW_LENGTH'));
  3644.             my $AVG_ROW_LENGTH_        = $q->param('AVG_ROW_LENGTH_');
  3645.             if ($AVG_ROW_LENGTH =~ /\D/){$errmsg .= "Parameter AVG_ROW_LENGTH must contain integer values only\n"}
  3646.             elsif ($AVG_ROW_LENGTH ne $AVG_ROW_LENGTH_){
  3647.                 unless ($AVG_ROW_LENGTH){$options .= "AVG_ROW_LENGTH=0 "}
  3648.                 else{$options .= "AVG_ROW_LENGTH=$AVG_ROW_LENGTH "}
  3649.             }
  3650.             if (    ($tabletype =~ /MyISAM/i)
  3651.                  or (!$tabletype and $tabletype_ =~ /MyISAM/i) 
  3652.                  or (
  3653.                      check_version("4.1.0") and 
  3654.                         ($tabletype =~ /HEAP/i 
  3655.                     or    (!$tabletype and $tabletype_ =~ /HEAP/i))
  3656.                     )
  3657.                 ){
  3658.                 my $AUTO_INCREMENT        = deletespace($q->param('auto_increment'));
  3659.                 my $AUTO_INCREMENT_        = $q->param('AUTO_INCREMENT_');
  3660.                 if ($AUTO_INCREMENT =~ /\D/){$errmsg .= "Parameter AUTO_INCREMENT must contain integer values only\n"}
  3661.                 elsif (($AUTO_INCREMENT ne $AUTO_INCREMENT_) and ($AUTO_INCREMENT ne '')){
  3662.                     $options .= "AUTO_INCREMENT=$AUTO_INCREMENT "
  3663.                 }
  3664.             }
  3665.             if ($errmsg){bail_out($errmsg, $back)}
  3666.  
  3667.             my $ROW_FORMAT        = $q->param('ROW_FORMAT');
  3668.             my $ROW_FORMAT_        = $q->param('ROW_FORMAT_');
  3669.             if ((!$ROW_FORMAT_ and $ROW_FORMAT ne 'DEFAULT') or ($ROW_FORMAT_ and $ROW_FORMAT ne $ROW_FORMAT_)){
  3670.                 $options .= "ROW_FORMAT=$ROW_FORMAT "
  3671.             }
  3672.  
  3673.             my $PACK_KEYS        = $q->param('PACK_KEYS');
  3674.             my $PACK_KEYS_        = $q->param('PACK_KEYS_');
  3675.             if (($PACK_KEYS_ eq '' and $PACK_KEYS ne 'DEFAULT' and $PACK_KEYS ne '') or ($PACK_KEYS_ ne '' and $PACK_KEYS ne $PACK_KEYS_)){
  3676.                 $options .= "PACK_KEYS=$PACK_KEYS "
  3677.             }
  3678.             
  3679.             my $CHECKSUM        = $q->param('CHECKSUM');
  3680.             my $CHECKSUM_        = $q->param('CHECKSUM_');
  3681.             if (($CHECKSUM or $CHECKSUM_) and ($CHECKSUM ne $CHECKSUM_)){
  3682.                 unless ($CHECKSUM){$options .= "CHECKSUM=0 "}
  3683.                 else{$options .= "CHECKSUM=$CHECKSUM "}
  3684.             }
  3685.             my $DELAY_KEY_WRITE        = $q->param('DELAY_KEY_WRITE');
  3686.             my $DELAY_KEY_WRITE_        = $q->param('DELAY_KEY_WRITE_');
  3687.             if (($DELAY_KEY_WRITE or $DELAY_KEY_WRITE_) and ($DELAY_KEY_WRITE ne $DELAY_KEY_WRITE_)){
  3688.                 unless ($DELAY_KEY_WRITE){$options .= "DELAY_KEY_WRITE=0 "}
  3689.                 else{$options .= "DELAY_KEY_WRITE=$DELAY_KEY_WRITE "}
  3690.             }
  3691.             my $comment        = deletespace($q->param('comment'));
  3692.             my $COMMENT_    = $q->param('COMMENT_');
  3693.             if (($comment or $COMMENT_) and ($comment ne $COMMENT_)){
  3694.                 $comment = $dbh->quote($comment);
  3695.                 $options .= "COMMENT=$comment";
  3696.             }
  3697.         }
  3698.         
  3699. # NEW COLUMN
  3700.     if (my $newcolname         = $q->param('newcolname')) {
  3701.         my $newcoltype             = $q->param('newcoltype');
  3702.         my $newcollength         = $q->param('newcollength');
  3703.         $newcollength             = '('.$newcollength.')' if $newcollength;
  3704.         
  3705.         my $unsigned_new         = ' UNSIGNED' if ($q->param('unsigned_new'));
  3706.         my $zerofill_new         = ' ZEROFILL' if ($q->param('zerofill_new'));
  3707.         my $binary_new             = ' BINARY'     if ($q->param('binary_new'));
  3708.         my $notnull_new         = ' NOT NULL'  if ($q->param('notnull_new'));
  3709.         my $newcoldefault         = ' DEFAULT '.$dbh->quote($q->param('newcoldefault')) if ($q->param('newcoldefault'));
  3710.  
  3711.  
  3712.         my $addwhere             = $q->param('firstafter');
  3713.         if ($table) {
  3714.                 if ($addwhere eq 'AFTER') {
  3715.                     $addwhere             .= " ".$q->param('firstafterwhat');
  3716.                 }
  3717.                 if ($scl < 5){
  3718.                     $add_column = "\nADD COLUMN $newcolname $newcoltype$newcollength$unsigned_new$zerofill_new $binary_new$notnull_new$newcoldefault $addwhere";
  3719.             }
  3720.             else {bail_out ($demomsg1, $back)}
  3721.         }
  3722.         else {$add_column = " ($newcolname $newcoltype$newcollength$unsigned_new$zerofill_new $binary_new$notnull_new$newcoldefault) "}
  3723.     }
  3724.     
  3725. # ADD NEW INDEX:
  3726.     my $keyname                 = $q->param('keyname');
  3727.     my $keytype                 = $q->param('keytype');
  3728.     my $indcolname                 = $q->param('indcolname');
  3729.     if ($keytype){
  3730.         if ($scl > 4){bail_out ($demomsg1, $back)}
  3731.         if ($keytype =~ /^primary$/i) {
  3732.             $add_ind            .= "\nADD PRIMARY KEY "
  3733.         }
  3734.         else {
  3735.             $add_ind            .= "\nADD $keytype $keyname ";
  3736.         }
  3737. #        $query                     .= "UNIQUE $keyname " if ($keytype =~ /^unique$/i);
  3738. #        $query                     .= "INDEX $keyname " if ($keytype =~ /^index$/i);
  3739.         
  3740.         $add_ind                .= "($indcolname)";
  3741.     }
  3742.     
  3743. #ASSEMBLE THE QUERY
  3744.     my @queries                 = ();
  3745.     if ($table) {
  3746.         if ($saveas){
  3747.             if ($scl > 4){bail_out ($demomsg1, $back)}
  3748.             push @queries, $saveas ;
  3749.             $table = $newtablename;
  3750.         }
  3751. #    my $rename;
  3752.         my @alter = ();
  3753.         push @alter, @drop_key        if @drop_key;
  3754.         push @alter, @drop_column    if @drop_column;
  3755.         push @alter, $enkeys        if $enkeys;
  3756.         push @alter, @change_column    if @change_column;
  3757.         push @alter, $add_column    if $add_column;
  3758.         push @alter, $add_ind        if $add_ind;
  3759.         push @alter, "\n$options"    if $options;
  3760.         push @alter, $rename        if $rename;
  3761.         push @alter, $order            if $order;
  3762.         
  3763.         if (@alter){
  3764.             my $ignore = ' IGNORE' if $q->param('ignore');
  3765.             $query    = "ALTER$ignore TABLE $table ";
  3766.             $query    .= join ', ', @alter;
  3767.             push @queries, $query;
  3768.         }
  3769.  
  3770.     }
  3771.     else {
  3772.         $query     = "CREATE TABLE $newtablename $add_column";
  3773.         $query    .= "\n$options\n";
  3774.         
  3775.         push @queries, $query;
  3776.     }
  3777.     
  3778.     
  3779.     if ($q->param('preview') and @queries) {
  3780.         my $func    = ($page eq 'create') ? 'create' : $q->param('func');
  3781.         my $back = {
  3782.             page            => "alterAfterPreview",
  3783.             func            => "$func",
  3784.             newtablename    => "" . $q->param('newtablename'),
  3785.             alter            => 1,
  3786.             preview            => "" . $q->param('preview')
  3787.         };
  3788.         printpreview(\@queries, $back);
  3789.         return;
  3790.     }
  3791.     else {
  3792.         foreach (@queries) {
  3793.             $dbh->do($_) or bail_out("ALTER FAIL\nQUERY: $_", $back);
  3794.            }
  3795.     }
  3796.     my $msg;
  3797.     unless (@queries){$msg = qq?<FONT COLOR="#FF0000">No Changes!</FONT>?}
  3798.     &loadAlterTable({msg => $msg})
  3799. }
  3800. sub execDeleteFromTable {
  3801.     print "<!-- DeleteFromTable Procedure starts here -->";
  3802.     my $back = {
  3803.         page        => 'select_db',
  3804.         dbname        => "$database",
  3805.     };
  3806.     if ($q->param('delete')) {
  3807.         my @tabs = $q->param('tables');
  3808.         if (@tabs == 0){print "<p><b>DELETE ERROR:</B> Table is not specified.<P>\n"}
  3809.         elsif  (@tabs >= 2) {print "<p><b>DELETE ERROR:</B> TOO MANY TABLES.<P>\n"}
  3810.         else {
  3811.             my $where = $q->param('wheredelete');
  3812.             my $query;
  3813.             if ($where) {$query = "DELETE FROM $tabs[0] WHERE $where"}
  3814.             else {$query = "DELETE FROM $tabs[0] WHERE 1=1"}
  3815.             my $res = $dbh -> do($query) or bail_out ("ERROR: CAN NOT DELETE FROM $_ \nQUERY: $query", $back);
  3816.         }
  3817.     }
  3818.     &loadSelectTables();
  3819.     print "<!-- DeleteFromTable Procedure ends here -->";
  3820.     return;
  3821. }
  3822. sub getCreateTableSQL {
  3823.     my $text;
  3824.     my $hash            = shift;
  3825.     my $tabsref         = $hash->{tabsref};
  3826.     my $dropifexists     = $hash->{dropifexists};
  3827.     my $back            = $hash->{back};
  3828.     my @newtabs         = @{$hash->{newtabs}} if defined $hash->{newtabs};
  3829.     my @tabs             = @$tabsref;
  3830.     my $newtabind        = 0;
  3831.     if (check_version('3.23.20')){
  3832.         foreach my $table (@tabs) {
  3833.             $text                     .= "DROP TABLE IF EXISTS $table; \n" if  $dropifexists;
  3834.             my $query                 = "SHOW CREATE TABLE $table";
  3835.             my ($sth, $res)         = prepare_execute($query, $back);
  3836.             my @opt                   = $sth->fetchrow_array();
  3837.             $sth->finish();
  3838.             if ($newtabs[$newtabind]){
  3839.                 if ($opt[1] =~ /^CREATE TABLE (\S?)(\w+)\1(.*)$/si){$opt[1] = "CREATE TABLE $1$newtabs[$newtabind]$1 $3"}
  3840.             }
  3841.             $text                    .= "$opt[1];\n\n";
  3842.             $newtabind++;
  3843.         }
  3844.         return $text;
  3845.     }
  3846.     foreach my $table (@tabs) {
  3847.         $text                     .= "DROP TABLE IF EXISTS $table; \n" if  $dropifexists;
  3848.         my $col_declaration     = '';
  3849.         my @col_declaration     = ();        
  3850.         
  3851.         my $query                 = "DESCRIBE $table";
  3852.         my ($sth, $res)         = prepare_execute($query, $back);
  3853.         my $i = 0;
  3854.         while (my @column = $sth->fetchrow_array()) {
  3855.               
  3856.               $col_declaration[$i] .= "\t$column[0] $column[1]";
  3857.               $col_declaration[$i] .= " NOT NULL" unless ($column[2] eq 'YES');
  3858.               $col_declaration[$i] .= " DEFAULT ".$dbh->quote($column[4]) unless  ($column[4] eq '');
  3859.               $col_declaration[$i] .= " AUTO_INCREMENT" if  ($column[5] =~ /AUTO_INCREMENT/i);
  3860.               $i++;
  3861.         }
  3862.         $sth->finish or ErrMessage("Cannot finish STH (DDL-describe)");
  3863.         $col_declaration = join (",\n", @col_declaration);
  3864.         $query = "SHOW INDEX FROM $table";
  3865.         ($sth, $res) = prepare_execute($query, $back);
  3866.         
  3867.         my $index;
  3868.         my $fulltext; 
  3869.         my %primary;
  3870.         my $unique;
  3871.         
  3872.         while (my @opt = $sth->fetchrow_array) {
  3873.  
  3874.             if ($opt[1] eq '0'){
  3875.                   if ($opt[2] =~ /^PRIMARY$/i){
  3876.                       $primary{$opt[3]} = $opt[4];
  3877.                     $primary{$opt[3]} .= "($opt[7])" if ($opt[7]);
  3878.                 }
  3879.                 else{
  3880.                     my $colname = $opt[4];
  3881.                     $colname .= "($opt[7])" if ($opt[7]);
  3882.                       $unique->{$opt[2]}{$opt[3]}=$colname;
  3883.                 }
  3884.             }
  3885.             else {
  3886.                 my $colname = $opt[4];
  3887.                 $colname .= "($opt[7])" if ($opt[7]);
  3888.                 if ($opt[9] =~ /FULLTEXT/i){$fulltext->{$opt[2]}{$opt[3]}=$colname;}
  3889.                 else {$index->{$opt[2]}{$opt[3]}=$colname;}
  3890.             }
  3891.         }
  3892.         $sth->finish or ErrMessage("Cannot finish STH (DDL-show index)");
  3893.  
  3894.         my @primary_key;
  3895.         my @unique;
  3896.         my @index;
  3897.         my @fulltext; 
  3898.         
  3899.         foreach (sort keys (%primary)){
  3900.             push @primary_key, $primary{$_};
  3901.         }
  3902.         my $unique_key;
  3903.         foreach (keys %$unique) {
  3904.             my $hash = $unique->{$_};
  3905.             $unique_key .= ",\n\tUNIQUE $_ ";
  3906.             
  3907.             foreach (sort keys %$hash){
  3908.                  push @unique, $hash->{$_};
  3909.             } 
  3910.             $unique_key .= "(".join(', ', @unique).")";
  3911.             @unique = ();
  3912.         }
  3913.         my $index_key;
  3914.         foreach (keys %$index) {
  3915.             my $hash = $index->{$_};
  3916.             $index_key .= ",\n\tINDEX $_ ";
  3917.             
  3918.             foreach ( sort keys %$hash){
  3919.                 push @index, $hash->{$_};
  3920.             } 
  3921.             $index_key .= "(".join(', ', @index).")";
  3922.             @index = ();
  3923.         }
  3924.         my $fulltext_key;
  3925.         foreach (keys %$fulltext) {
  3926.             my $hash = $fulltext->{$_};
  3927.             $fulltext_key .= ",\n\tFULLTEXT $_ ";
  3928.             
  3929.             foreach ( sort keys %$hash){
  3930.                 push @fulltext, $hash->{$_};
  3931.             } 
  3932.             $fulltext_key .= "(".join(', ', @fulltext).")";
  3933.             @fulltext = ();
  3934.         }
  3935.         
  3936.         my $primary_key = ",\n\n\tPRIMARY KEY (".join(', ',@primary_key).")" if (scalar(%primary));
  3937.         my $create_definition = 
  3938.             $col_declaration.
  3939.             $primary_key.
  3940.             $index_key.
  3941.             $fulltext_key.
  3942.             $unique_key
  3943.             ;
  3944.  
  3945.        my $table_options = "";
  3946.          if (check_version('3.23.00')) {
  3947.    
  3948.             $query = "SHOW TABLE STATUS";
  3949.             ($sth, $res) = prepare_execute($query, $back);
  3950. LABLE1:    while (my @row = $sth->fetchrow_array()) {
  3951.                 if ($table eq $row[0]){
  3952.                    if ($row[1]) {$table_options .= "\tTYPE=$row[1]\n" unless ($row[1] =~ /myisam/i)}
  3953.                    my $opt = $row[-2];
  3954.                    my $i = 0;
  3955.                    while ($opt =~ /^\s*(\S*=\S*)\s*(.*)$/){
  3956.                          my $first = $1;
  3957.                          my $second = $2;
  3958.                          if ($first =~ /^\s*format\s*=/) {$first = "ROW_$first"}
  3959.                          $table_options .= "\t$first\n";
  3960.                          $opt = $second;
  3961.                          if ($i++ > 100) {
  3962.                              $table_options = '';
  3963.                             print "Table_options fail! ($i)<br>";
  3964.                             last LABLE1;
  3965.                          }
  3966.                    }#while
  3967.                    if ($row[-1]) {$table_options .= "\tCOMMENT=\"$row[-1]\"\n";}
  3968.                 }#if        
  3969.             }#while
  3970.             $sth->finish();
  3971.         } #if version = 3.23#
  3972.         $table = $newtabs[$newtabind] if $newtabs[$newtabind];
  3973.         $text .= <<EOT
  3974. CREATE TABLE $table 
  3975. (
  3976.  $create_definition
  3977. )
  3978.  $table_options
  3979. ;
  3980.  
  3981. EOT
  3982. ;
  3983.     $newtabind++;
  3984.     }
  3985.     return $text;
  3986. }
  3987. sub execGenerateDDL {
  3988.  
  3989.     print "<!-- GenerateDDL procedure starts here -->";
  3990.     my @tabs = $q->param('tables');
  3991.     my $back = {page => 'select_db', dbname => "$database"};
  3992.     bail_out ("Table is not specified.", $back) unless @tabs;
  3993.     my $dropifexists = $q->param('dropifexists');
  3994.     my @text;
  3995.     foreach(@tabs){
  3996.         my $fk = 0;
  3997.         my $text = getCreateTableSQL({tabsref =>[$_], dropifexists => "$dropifexists", back => $back});
  3998.         if ($text =~ /FOREIGN KEY/si){push @text, $text} else {unshift @text, $text}
  3999.     }
  4000.     
  4001.     ($user, $password, $MySQLhost, $usedefault) = $q->cookie('db_manager');
  4002.     my $textsize        = $agent ? 17 : 25;
  4003.     my $textareasize    = $agent ? 45 : 70;
  4004.     my $dbname = $database;
  4005.     print <<DDLTable
  4006. <FORM METHOD=POST ACTION="$full_url">
  4007. <TABLE BORDER=1 CELLPADDING=4>
  4008.        <TR>
  4009.               <TD><TEXTAREA WRAP=OFF ROWS=22 COLS=$textareasize NAME="SQL">@text</TEXTAREA></TD>
  4010.            <TD VALIGN=TOP><P><CODE>APPLY TO:</CODE><P>
  4011.         <!--     User name:<BR>
  4012.          <INPUT TYPE=TEXT SIZE=$textsize NAME="user" VALUE="$user"><BR>
  4013.            Password:<BR>
  4014.            <INPUT TYPE=PASSWORD SIZE=$textsize NAME="password" VALUE="$password"><BR> -->
  4015.            Database Name:<BR>
  4016.            <INPUT TYPE=TEXT SIZE=$textsize NAME="dbname" VALUE="$database"><BR>
  4017.           <!--   host [localhost]<BR>
  4018.            <INPUT TYPE=TEXT SIZE=$textsize NAME="host" VALUE=""> --><P>
  4019.            <INPUT TYPE=SUBMIT SIZE=$textsize NAME="apply" VALUE="Apply">
  4020.            <INPUT TYPE=RESET><BR>
  4021.            <INPUT TYPE=CHECKBOX NAME="abortsql" TITLW="Abort execution if error occurs">Abort on error
  4022.            </TD>
  4023.         </TR>
  4024. </TABLE>
  4025. <INPUT TYPE=HIDDEN NAME="page" VALUE="ddl">   
  4026. <INPUT TYPE=HIDDEN NAME="database" VALUE="$database">   
  4027. <!-- <INPUT TYPE=HIDDEN NAME="login" VALUE="1">   -->
  4028. </FORM>
  4029. DDLTable
  4030. ;
  4031.     print "\n\n<!-- GenerateDDL procedure ends here -->\n\n";
  4032.  
  4033. return;
  4034. }
  4035. sub execInsertData  {
  4036.     my $table = $q->param('tables');
  4037.     my $back = {dbname => $database, tables => $table};
  4038.  
  4039.     if ($page =~ /insert/i){
  4040.         $back->{func} = "INSERT";
  4041.         $back->{page} = "tables";
  4042.     }
  4043.     elsif ($page =~ /update/i) {
  4044.         $back->{page} = "tables";
  4045.         $back->{func} = "UPDATE";
  4046.         $back->{updateStart} = $q->param('start');
  4047.         $back->{updateRows} = $q->param('rows');
  4048.         $back->{updateWhere} = $q->param('where');
  4049.         $back->{updateOrder} = $q->param('order');
  4050.  
  4051.       }
  4052.     elsif ($page eq 'searchresult'){
  4053.         my @fields = $q->param('fields');
  4054.         $back->{page} = "searchresult";
  4055.         $back->{func} = "new";
  4056.         $back->{where} = $q->param('where').'';
  4057.         $back->{start} = $q->param('start').'';
  4058.         $back->{rows} = $q->param('rows').'';
  4059.         $back->{order} = $q->param('order').'';
  4060.         $back->{count} = $q->param('count').'';
  4061.         $back->{fields} = \@fields;
  4062.     }
  4063.  
  4064.     my $count1 = count_rows($table, $back);
  4065.     
  4066.     my $query = "SELECT * FROM $table LIMIT 0";
  4067.     my($sth, $res)= prepare_execute ($query, $back);
  4068.  
  4069.     my (@insert_list, @insert_data, $set, $data); #test it
  4070.     my @names = @{$sth->{NAME}};
  4071.     
  4072. #++++++++++++++++++++++++++++++++++++++
  4073.     
  4074.     $sth->finish();
  4075.  
  4076.     foreach (@names) {
  4077.         my @up_list = $q->param('upload');
  4078.         if (belongs(\@up_list,$_)){
  4079.             $data = $q->param($_.'_data_upload');
  4080.             my $buf;
  4081.             binmode $data;
  4082.             my $line = '';
  4083.             while (read ($data, $buf, 1024)) {$line .= $buf}
  4084.             close $data or bail_out("$!", $back);
  4085.             $data = $line;
  4086.         }
  4087.         else {$data = $q->param($_.'_data')};
  4088.         if ($data ne ''){
  4089.             push @insert_list, $_;        
  4090.  
  4091. #++++++++++++++++++++++++++++++++++++++
  4092.  
  4093.             my @unquote = $q->param('unquote');
  4094.             $data = $dbh->quote($data) unless belongsb(\@unquote, $_);
  4095.             push @insert_data, $data;
  4096.         }#if ($data...
  4097.  
  4098. #++++++++++++++++++++++++++++++++++++++
  4099.         
  4100.     }#foreach...
  4101.     
  4102. #++++++++++++++++++++++++++++++++++++++
  4103.     if (@insert_list == 0){
  4104.         my @datum;
  4105.         foreach (@names) {push @datum, "''"}    
  4106.         $query = $q->param('insmethod')." ".$q->param('insert_option1')." ".$q->param('insert_option2').
  4107.                " INTO $table \n (".join (', ', @names).") \n VALUES (".join (', ', @datum).")";
  4108.     }#End   -  empty @insert_list
  4109.     
  4110.     else {
  4111.         $set = "\n".$insert_list[0].'='.$insert_data[0];
  4112.         for (my $i=1; $i<@insert_list; $i++){
  4113.             $set = $set.",\n".$insert_list[$i].'='.$insert_data[$i]
  4114.         }
  4115.         $query = $q->param('insmethod')." ".$q->param('insert_option1')." ".$q->param('insert_option2')." INTO $table \n SET $set";
  4116.     }
  4117.  
  4118.     if ($q->param('preview')) {printpreview([$query]); return }
  4119.     else {bail_out($demomsg, $back)} 
  4120. #++++++++++++++++++++++++++++++++++++++
  4121.     return()
  4122. }
  4123. sub getwhere {
  4124.     my ($pri, @queryArray, @pri, @priNum);
  4125.     my $input        = shift;
  4126.     my $count        = $input->{count};
  4127.     my $table        = $input->{table};
  4128.     my $start        = $input->{start};
  4129.     my $rows        = $input->{rows};
  4130.     my $query        = $input->{query};
  4131.     my $back        = $input->{back};
  4132.     my $returnarray    = $input->{returnarray}; # 1 => return WHERE conditions as an array reference
  4133.     $query .= ' LIMIT '.$start.', '.$rows            if ($start and $rows);
  4134.     $query .= ' LIMIT '.$rows                         if (!$start and $rows);
  4135.     $query .= ' LIMIT '.$start.', '.($count-$start)    if ($start and !$rows);
  4136.     my ($sth,$res) = prepare_execute($query, $back);
  4137.     my $primary = get_mysql_pri($sth);
  4138.     unless (defined $primary){$primary = []}
  4139.     for (my $i=0; $i<@$primary; $i++){
  4140.         if ($primary->[$i]){push @priNum,$i; push @pri, $sth->{NAME}[$i]}
  4141.     }
  4142.     if (@pri == 0){
  4143.         @pri = @{$sth->{NAME}};
  4144.         @priNum = (0..(scalar(@pri)-1));
  4145.     }
  4146.     my $i = $start;
  4147.     my @selectrows = $q->param('SelectRow');
  4148.     my @where;
  4149.     while (my @ary = $sth->fetchrow_array ()) {
  4150.         my $where;
  4151.         if (&belongs(\@selectrows, $i)) {
  4152.             my @where_;
  4153.             my $data = $dbh->quote($ary[$priNum[0]]);
  4154.                for (my $jj = 0; $jj < @pri; $jj++) {
  4155.                 my $data = $dbh->quote($ary[$priNum[$jj]]);
  4156.                 if (uc($data) eq 'NULL'){push @where_, "$pri[$jj] IS NULL"}
  4157.                 else {push @where_, "$pri[$jj] = $data"}
  4158.             }
  4159.             $where = join ") AND (", @where_;
  4160.             $where = "($where)" if @where_ > 1;
  4161.             push @where, $where;
  4162.         }
  4163.         $i++
  4164.     }
  4165.     $sth->finish();
  4166.     if ($returnarray){
  4167.         return \@where
  4168.     }
  4169.     else{
  4170.         my $where = join ") OR (", @where;
  4171.         $where = "($where)" if @where > 1;
  4172.         return $where;
  4173.     }
  4174. 1;
  4175. } # end of getwhere
  4176.  
  4177. sub execUpdateData {
  4178.     my $rows = $q->param('rows');
  4179.     my $start = $q->param('start')+0;
  4180.     my $where = $q->param('where');
  4181.     my $order = $q->param('order');
  4182.     my $count = &count_rows($q->param('tables'));
  4183.     my $table = $q->param('tables');
  4184.     my $back = {
  4185.             dbname            => "$database",
  4186.             tables            => "$table",
  4187.             page            => "tables",
  4188.             func            => "UPDATE",
  4189.             updateStart        => "$start",
  4190.             updateRows        => "$rows",
  4191.             updateWhere        => "$where",
  4192.             updateOrder        => "$order"
  4193.     };
  4194.     my @hidfields         = $q->param('fields');
  4195. #    if ($q->param('update') eq 'Update'){
  4196. #        @hidfields                 = $q->param('$table\_fields');
  4197. #        $back->{updateStart}     = $q->param('updateStart');
  4198. #        $back->{updateRows}     = $q->param('updateRows');
  4199. #    }
  4200.  
  4201.     $back->{"$table\_fields"}    = \@hidfields;
  4202.     my $wrongparam = qq?<FONT COLOR="#FF0000"><B>WRONG PARAMETERS!</B></FONT>?;
  4203.  
  4204.     if ($q->param('insert')) {
  4205.         my $insert_result;
  4206.         unless ($q->param('error')) {
  4207.             $insert_result = execInsertData();
  4208.             return if $q->param('preview');
  4209.         }
  4210.         else {$insert_result = $wrongparam}
  4211.         &loadUpdateForm($insert_result);
  4212.         return;    
  4213.     }
  4214.     if ($q->param('reload')) {
  4215.         &loadUpdateForm;
  4216.         return;    
  4217.     }
  4218.     if ($q->param('zoom')){
  4219.  
  4220.         if ($q->param('error')){&loadUpdateForm($wrongparam); return}
  4221.  
  4222.         unless ($q->param('zoomselect') and defined $q->param('SelectRow')) { # if nothing was selected to zoom
  4223.             my $msg = qq!<FONT COLOR="#FF0000"><B>PLEASE SELECT ONE ROW AND ONE COLUMN TO ZOOM</B></FONT>!;
  4224.             &loadUpdateForm($msg)
  4225.         }
  4226.         else {&loadZoom()}
  4227.        return;
  4228.     }
  4229.  
  4230.     my ($pri, @queryArray, @pri, @priNum);
  4231.  
  4232.     if ($q->param('delete')) {
  4233.         if ($q->param('error')){&loadUpdateForm($wrongparam); return}
  4234.         unless (defined $q->param('SelectRow')) {
  4235.                  my $msg = qq!<FONT COLOR="#FF0000"><B>Nothing was selected</B></FONT>!;
  4236.                  &loadUpdateForm($msg);
  4237.               return;
  4238.         }
  4239.  
  4240.         my $query = "SELECT * FROM $table";        
  4241.         my $where =$q->param('where');
  4242.         $query .= " WHERE $where" if $where;
  4243.         $query .= " ORDER BY $order" if $order;
  4244.         my $calldelete = {
  4245.             count => "$count", table => "$table", start => "$start", rows => "$rows", query => "$query", back => $back
  4246.         };
  4247.         $query = "DELETE ".$q->param('delete_option1')." FROM  $table WHERE ";
  4248.         $query .= getwhere($calldelete);
  4249.  
  4250.         if ($q->param('preview')) {
  4251.            printpreview([$query]);
  4252.         }
  4253.  
  4254.          else {    
  4255.             $dbh->do($query) or &bail_out("$query", $back);    
  4256.             &loadUpdateForm;
  4257.         }
  4258.         return;    
  4259.     
  4260.     }
  4261.  
  4262. #update
  4263.     if ($q->param('error')){&loadUpdateForm($wrongparam); return}
  4264.  
  4265.     my @fields = $q->param('fields');
  4266.     my $fields = join (', ', @fields);
  4267.     if (@fields == 0) {$fields = '*'}
  4268.     my $query = '';
  4269.     $query = "SELECT * FROM $table";        
  4270.     $query .= " WHERE $where" if $where;
  4271.     $query .= " ORDER BY $order" if $order;
  4272.     $query .= " LIMIT $start, $rows"            if ($start and $rows);
  4273.     $query .= " LIMIT $rows"                     if (!$start and $rows);
  4274.     $query .= " LIMIT $start, ".($count-$start)    if ($start and !$rows);
  4275.  
  4276.     my ($sth, $res) = prepare_execute($query, $back);
  4277.     
  4278.     my $primary = get_mysql_pri($sth);
  4279.     unless (defined $primary){$primary = []}
  4280.     for (my $i=0; $i<@$primary; $i++){
  4281.         if ($primary->[$i]){push @priNum, $i; push @pri, $sth->{NAME}[$i]}
  4282.     }
  4283. #---selected---------
  4284.     my $i = 0;        #Rows
  4285.     my $j;            #Columns
  4286.     my $k = 0;
  4287.     my @queries; 
  4288.       if (@pri == 0){
  4289.        @pri = @{$sth->{NAME}};
  4290.        @priNum = (0..(scalar(@pri)-1));
  4291.     }
  4292.     
  4293.  
  4294. #++++++++++++++++++++++++++++++++++++++
  4295.     while (@ary = $sth->fetchrow_array ()) {
  4296.         $query = "UPDATE ".$q->param('update_option1')." ".$q->param('update_option2')." $table SET ";
  4297.         my $ii = 0;
  4298.         for ($j=0; $j<@ary; $j++) {
  4299.             next unless(belongs(\@fields,${$sth->{NAME}}[$j]) or $fields eq '*');
  4300.             my $value = $q->param('n'.$i.'_'.$ii);
  4301.             $ii++;
  4302. #++++++++++++++++++++++++++++++++++++++
  4303.             if ($ary[$j] ne $value) {
  4304.                 push @queryArray, ${$sth->{NAME}}[$j]." = ".$dbh->quote($value);
  4305.                 $k=1;
  4306.             }
  4307.         }#for
  4308.         if ($queryArray[0]){
  4309.             my $data = $dbh->quote($ary[$priNum[0]]);
  4310.             my $where;
  4311.             if (uc($data) eq 'NULL'){$where = " WHERE $pri[0] IS NULL"}
  4312.             else {$where = " WHERE $pri[0] = $data"}
  4313.             my $jj;
  4314.             for ($jj = 1; $jj < @pri; $jj++) {
  4315.                 my $data = $dbh->quote($ary[$priNum[$jj]]);
  4316.                 if (uc($data) eq 'NULL'){$where .= " AND $pri[$jj] IS NULL"}
  4317.                 else {$where .= " AND $pri[$jj] = $data"}
  4318.             }
  4319.             $query .= join(", ",@queryArray)." $where";
  4320.             push @queries, $query;
  4321.         }#if($query...
  4322.         else {$query = ''}
  4323.         $i++;
  4324.         @queryArray = ();
  4325.     }#while
  4326.     $sth->finish ();
  4327.     if ($k==0) {
  4328.         my $nochanges = "<FONT COLOR=\"#FF0000\"><b>Nothing was changed</b></FONT>";
  4329.         &loadUpdateForm($nochanges);    
  4330.     }
  4331.     #UPDATE
  4332.     elsif ($q->param('update')) {
  4333. #++++++++++++++++++++++++++++++++++++++
  4334.     
  4335.     if ($q->param('preview')) {
  4336.            printpreview(\@queries);
  4337.         }# end preview
  4338.     else {bail_out($demomsg, $back)}      }
  4339.     return;
  4340.  
  4341. } # END UPDATE
  4342.  
  4343. #++++++++++++++++++++++++++++++++++++++
  4344.  
  4345. sub execUpdateAfterPreview {
  4346.     if ($q->param('back')){&loadUpdateForm(qq!<font color="#cc0000"><b>Changes were lost</b></font>!); return}
  4347.     my $res;
  4348.     my $msg;
  4349.     my @queries = $q->param('queries');
  4350.     my $i = 0;
  4351.     my $table = $q->param('tables');
  4352.     my $back = {
  4353.             dbname            => "$database",
  4354.             tables            => "$table",
  4355.             page            => "tables",
  4356.             func            => "UPDATE",
  4357.             updateStart        => $q->param('updateStart')."",
  4358.             updateRows        => $q->param('updateRows')."",
  4359.             updateWhere        => $q->param('updateWhere')."",
  4360.             updateOrder        => $q->param('updateOrder')."",
  4361.     };
  4362.     bail_out($demomsg, $back);
  4363.     return;
  4364. }
  4365. sub execAlterAfterPreview {
  4366.     if ($q->param('back')){&loadAlterTable({msg => qq!<font color="#cc0000">Changes were lost!}); return}
  4367.     my $table    = $q->param('tables');
  4368.     my $dbname    = $q->param('dbname');
  4369.     my $func    = $q->param('func');
  4370.     unless ($func eq 'create'){$func = 'alter'}
  4371.     my $back     = {
  4372.         page     => 'tables',
  4373.         func     => "$func",
  4374.         dbname     => "$dbname",
  4375.         tables     => "$table"
  4376.     };
  4377.     my $msg;
  4378.     my @queries = $q->param('queries');
  4379. #++++++++++++++++++++++++++++++++++++++
  4380.  
  4381.     foreach $query (@queries) {
  4382.         next unless ($query =~ /\w/);
  4383.         $dbh->do($query) or bail_out("ALTER FAIL.\nQUERY:\n$query", $back);
  4384.     }
  4385.     if (@queries==0) {
  4386.             $msg = qq?<B><FONT COLOR="#FF0000">No query was selected</FONT></B>? ;
  4387.     }
  4388.  
  4389.            &loadAlterTable({msg => $msg});    
  4390.     return;
  4391. }
  4392.  
  4393. sub logout {
  4394.     my @value = ('','','','');
  4395.     my $cookies = $q->cookie(-name=>'db_manager',
  4396.                              -value=>\@value,
  4397.                              -secure=>0);
  4398.     print     $q->header(-cookie=>$cookies);
  4399.     &startpage();
  4400.     print <<IndexBody
  4401. <BR>
  4402.  
  4403. <FORM METHOD=POST ACTION="$full_url">
  4404. <INPUT TYPE=HIDDEN NAME="page" VALUE="connect">
  4405. <INPUT TYPE=HIDDEN NAME="login" VALUE="1">
  4406. <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0>
  4407.     <TR HEIGHT=100>
  4408.      <TD WIDTH=20 HEIGHT=100> </TD>
  4409.      <TD WIDTH=150 HEIGHT=100> </TD>
  4410.         <TD WIDTH=120 HEIGHT=100> </TD>
  4411.         <TD WIDTH=201 HEIGHT=100> </TD>
  4412.     </TR>
  4413.  
  4414.     <TR>
  4415.      <TD WIDTH=20> </TD>
  4416.      <TD WIDTH=150> </TD>
  4417.         <TD WIDTH=120>USER</TD>
  4418.         <TD WIDTH=201>
  4419.             <INPUT  TYPE=TEXT NAME="user" VALUE="" SIZE=23 MAXLENGTH=23 TITLE="User name" style="width: 160px"> </TD>
  4420.     </TR>
  4421.     <TR>
  4422.      <TD WIDTH=20> </TD>
  4423.      <TD WIDTH=150> </TD>
  4424.         <TD WIDTH=120>PASSWORD</TD>
  4425.         <TD WIDTH=201><INPUT TYPE=PASSWORD NAME="password" VALUE="" SIZE=23 MAXLENGTH=23 TITLE="Password" style="width: 160px"> </TD>
  4426.     </TR>
  4427.     <TR>
  4428.      <TD WIDTH=20> </TD>
  4429.      <TD WIDTH=150> </TD>
  4430.         <TD WIDTH=120>DATABASE</TD>
  4431.         <TD WIDTH=201><INPUT TYPE=TEXT NAME="dbname" VALUE="" SIZE=23 TITLE="Database name" style="width: 160px"> </TD>
  4432.     </TR>
  4433.     <TR>
  4434.      <TD WIDTH=20> </TD>
  4435.      <TD WIDTH=150> </TD>
  4436.         <TD WIDTH=120>HOST:PORT</TD>
  4437.         <TD WIDTH=201><INPUT TYPE=TEXT NAME="host" VALUE="" SIZE=23 TITLE="Host name:Port number" style="width: 160px"> </TD>
  4438.     </TR>
  4439.  
  4440.     <TR>
  4441.      <TD WIDTH=20> </TD>
  4442.      <TD WIDTH=150> </TD>
  4443.         <TD WIDTH=120> </TD>
  4444.         <TD WIDTH=201> </TD>
  4445.     </TR>
  4446.     <TR>
  4447.      <TD WIDTH=20> </TD>
  4448.      <TD WIDTH=150> </TD>
  4449.         <TD WIDTH=120> </TD>
  4450.         <TD WIDTH=201><INPUT TYPE=SUBMIT VALUE=SUBMIT TITLE="Log in"  style="width: 160px"></TD>
  4451.     </TR>                                                
  4452.     
  4453. </TABLE>
  4454. </FORM>
  4455.  
  4456. </TD></TR></TABLE>
  4457.  
  4458. </BODY>
  4459. </HTML>    
  4460. IndexBody
  4461. ;
  4462.     
  4463.  
  4464. return;
  4465.  
  4466. }
  4467.  
  4468.  
  4469. sub printpreview {
  4470. # QUERIES_ref = $_[0];
  4471. # WAY BACK = $_[1];
  4472.     print $q->start_multipart_form(-action=>$full_url, -method=>"POST");
  4473.     print <<EndPreviewHeader
  4474. <TABLE WIDTH="100%" BORDER=0 CELLSPACING=0 CELLPADDING=0>
  4475.        <TR><TH COLSPAN=2 ALIGN=LEFT>PREVIEW</TH></TR>
  4476.        <TR><TD COLSPAN=2 HEIGHT=8></TD></TR>
  4477. EndPreviewHeader
  4478. ;
  4479.      my $queriesref = $_[0];
  4480.     foreach (@$queriesref) {
  4481.         my $count;
  4482.         while(/\n/g){$count++; last if $count > 8}
  4483.         my $rows = $count+1;
  4484.         if ($rows < 3){$rows = 3}
  4485.         my $cols = $agent ? 65 : 90;
  4486.         $_ = quoteit($_);
  4487.         print <<EndPreviewHere
  4488.           <TR>
  4489.                 <TD VALIGN=BOTTOM><B>Statement: </B><BR>
  4490.         <TEXTAREA NAME="queries" COLS=$cols ROWS=$rows WRAP=ON>$_</TEXTAREA></TD>
  4491.             <TD VALIGN=BOTTOM>  <!--  <INPUT TYPE=CHECKBOX NAME="ok" VALUE="ok">Ok? --> </TD>
  4492.            </TR>
  4493.            <TR>
  4494.                <TD COLSPAN=2 HEIGHT=8></TD>
  4495.           </TR>
  4496. EndPreviewHere
  4497. ;
  4498.     }
  4499.  
  4500.  
  4501.     print qq!
  4502.            <TR>
  4503.                   <TD HEIGHT=35 VALIGN=BOTTOM><INPUT TYPE=SUBMIT VALUE="Submit"><INPUT TYPE=SUBMIT NAME="back" VALUE="CANCEL"></TD>
  4504.                <TD HEIGHT=35 VALIGN=BOTTOM></TD>
  4505.            </TR>
  4506. </TABLE>
  4507.  
  4508. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="!, $q->param('dbname'), qq!">
  4509. <INPUT TYPE=HIDDEN NAME="tables" VALUE="!, $q->param('tables'), qq!">
  4510. !;
  4511.     unless ($_[1]){
  4512.         my $updateWhere = quoteit($q->param('where'));
  4513.         my $updateOrder = quoteit($q->param('order'));
  4514.         print qq!
  4515. <INPUT TYPE=HIDDEN NAME="page" VALUE="updateAfterPreview">
  4516. <INPUT TYPE=HIDDEN NAME="updateStart" VALUE="!, $q->param('start'), qq!">
  4517. <INPUT TYPE=HIDDEN NAME="updateRows" VALUE="!, $q->param('rows'), qq!">    
  4518. <INPUT TYPE=HIDDEN NAME="updateWhere" VALUE="$updateWhere">    
  4519. <INPUT TYPE=HIDDEN NAME="updateOrder" VALUE="$updateOrder">    
  4520.     !;}
  4521.     else {
  4522.         foreach (keys(%{$_[1]})){
  4523.             print $q->hidden(-name=>$_, -value=>$_[1]->{$_}, -override=>1),"\n";
  4524.         }
  4525.     }
  4526.     my $table = $q->param('tables');
  4527.     my @fields = $q->param('fields');
  4528.     foreach (@fields){
  4529.         print "<INPUT TYPE=HIDDEN NAME=\"fields\" VALUE=\"$_\">";
  4530.     }
  4531.     @fields = $q->param($table.'_fields');
  4532.     foreach (@fields){
  4533.         print "<INPUT TYPE=HIDDEN NAME=\"$table\_fields\" VALUE=\"$_\">";
  4534.     }
  4535.     print "\n</FORM>\n"
  4536. }
  4537.  
  4538. sub loadRestore {
  4539.     if ($q->param('gotobackup')){loadBackup(); return}
  4540.     my ($hostname,$port)     = myhost();
  4541.     my $userhost             = $hostname;
  4542.     $hostname                 .= ":$port" if $port;
  4543.     my ($targethost, $targetuser, $dberr);
  4544.     my $succeed;
  4545.     my $selectdbname_       = $q->param('selectdbname_');
  4546.     $selectdbname_          = $database unless $selectdbname_;
  4547.     
  4548.     #my $userhost = myhost();
  4549.     my $back                 = {page => "$page"};
  4550.     $back->{dbname}         = "$database" if $database;
  4551.     $back->{selectdbname_}    = "$selectdbname_" if $selectdbname_;
  4552.     if (my $errmsg = checkuserdir('backup')){bail_out("$errmsg\n$!", $back)}
  4553.     my $userdir                = "$USER_DIR$delim$user.$userhost$delim" . "backup";
  4554.     $back ->{func}             = 'restore';
  4555.     $back ->{userhost}         = "$userhost";
  4556.     
  4557.     if ($q->param('disconnect')){
  4558.         $dbh_ = $dbh;
  4559.         $selectdbname_  = $database
  4560.     }
  4561.     elsif ($q->param('targetconnect')){
  4562.         $targethost            = $q->param('targethost');
  4563.         $targetuser            = $q->param('targetuser');
  4564.         my $targetpassword     = $q->param('targetpassword');
  4565.         $selectdbname_        = $q->param('targetdb');
  4566.         unless ($targethost) {$targethost = $DEFAULTHOST}
  4567.         my $dsn                = "DBI:mysql:$selectdbname_;$targethost";
  4568.         $dbh_                 = DBI->connect($dsn, $targetuser, $targetpassword,\%attr)
  4569.             or bail_out("Cannot connect",$back);
  4570.         $succeed            = 1;
  4571.         $back->{target}        = 1;
  4572.     }
  4573.     elsif ($q->param('target')){
  4574.         ($targetuser, my $targetpassword, $targethost) = $q->cookie('target_db');
  4575.         my $dsn                = "DBI:mysql:$selectdbname_;$targethost";
  4576.         $dbh_                 = DBI->connect($dsn, $targetuser, $targetpassword,\%attr);
  4577.         if ($DBI::err){
  4578.             if ($DBI::errstr =~ /access denied/i){
  4579.                 $dsn        = "DBI:mysql:;$targethost";
  4580.                 $dbh_         = DBI->connect($dsn, $targetuser, $targetpassword,\%attr);
  4581.                 if ($DBI::err){
  4582.                     if ($DBI::errstr =~ /access denied/i){$dberr = 1}
  4583.                     else {bail_out("Cannot connect",$back) }
  4584.                 }
  4585.             }
  4586.             else {bail_out("Cannot connect",$back)}
  4587.         }
  4588.         $succeed            = 1;
  4589.         $back->{target}        = 1;
  4590.     }
  4591.     else {
  4592.         $dbh_ = $dbh
  4593.     }
  4594.  
  4595.     my @databases;
  4596.     unless ($dberr){
  4597.         my $databasesref    = getdblist($dbh_);
  4598.         if ($DBI::err and (not defined $databasesref)){$dberr = 1}
  4599.         else {@databases = @$databasesref} 
  4600.     } 
  4601.     my @files = $q->param('selectfilelist');
  4602.     if ((@files == 1)and !$files[0]){@files = ()}
  4603.     my $pageHead =  sub {
  4604.     print qq!
  4605. <FORM METHOD=POST ENCTYPE="multipart/form-data" ACTION="$full_url">
  4606. <TABLE BORDER=0 WIDTH=700 ID="BIG_TABLE">
  4607.     <TR><TH ALIGN=LEFT>RESTORE DB AND TABLES FROM DUMP FILES</TH>
  4608.     </TR>
  4609.     <TR><TD>
  4610. !;
  4611.     return undef;
  4612.     };
  4613.     
  4614.     my $pageBottom = <<EndOfBottom
  4615.         </TD>
  4616.     </TR>
  4617. </TABLE><!-- END OF BIG TABLE -->
  4618. <INPUT TYPE=HIDDEN NAME="func" VALUE="restore">
  4619. <INPUT TYPE=HIDDEN NAME="page" VALUE="$page">
  4620. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  4621. <INPUT TYPE=HIDDEN NAME="target" VALUE="$succeed">
  4622. </FORM>
  4623. EndOfBottom
  4624. ;
  4625.  
  4626.     if ($q->param('delete') and !$q->param('cancel')){
  4627.         bail_out("File(s) not selected", $back) unless @files;
  4628.         my @filestodelete;
  4629.         foreach (@files){
  4630.             s/^(.*)\s\/\d*\/\s.*/$1/;
  4631.             push @filestodelete, $_;            
  4632.         }
  4633.         unless ($q->param('deleteconfirm')) {
  4634.             &$pageHead(' -> DELETE FILE(S)');
  4635.             print qq!<BR><P TITLE="List of files to be deleted"><B>THESE FILES WILL BE DELETED:</B></P>\n!;
  4636.             foreach (@filestodelete){
  4637.                 $_ = quoteit($_);
  4638.                 print qq!<INPUT TYPE=CHECKBOX NAME="selectfilelist" VALUE="$_" CHECKED TITLE="Uncheck to keep this file"> $_ <BR>\n!;
  4639.             }
  4640.             print qq!<BR><INPUT TYPE=SUBMIT NAME="deleteconfirm" VALUE="DELETE" TITLE="Delete selected files"> \n!;
  4641.             print qq!<INPUT TYPE=SUBMIT NAME="cancel" VALUE="CANCEL" TITLE="Go back to previous page without deletion">\n!;
  4642.             print qq!<INPUT TYPE=HIDDEN NAME="delete" VALUE="1">\n!;
  4643.             print qq!<INPUT TYPE=HIDDEN NAME="selectdbname_" VALUE="$selectdbname_">\n!;
  4644.             print $pageBottom;
  4645.             return;            
  4646.         }
  4647.         else {
  4648.             foreach (@files){
  4649.                 my $file = "$userdir/$_";
  4650.                 unlink ($file) ||bail_out("Could not unlink $_ : $!", $back) ;
  4651.                 
  4652.             }
  4653.         }
  4654.     }
  4655.     if ($q->param('downloadFile')){
  4656.         if (scalar @files > 1){
  4657.             bail_out("Too many files", $back);
  4658.         }
  4659.         elsif (!@files){
  4660.             bail_out("Please select a file.", $back);
  4661.         }
  4662.         
  4663.         $files[0] =~ s/^(.*)\s\/\d*\/\s.*/$1/;
  4664.         my $file = "$userdir$delim$files[0]";
  4665. #        $| = 1; 
  4666. #        $SIG{CHLD} = 'IGNORE';
  4667.         if (my $errmsg = download($userdir, $files[0])){bail_out($errmsg, $back)}
  4668.         $dbh->disconnect if defined $dbh;
  4669.         exit 0;
  4670.     }
  4671.     if ($q->param('upload')){
  4672.         my $back = {
  4673.             page            => "$page",
  4674.             func            => 'restore',
  4675.             selectdbname_    => "$selectdbname_",
  4676.             dbname            => "$database",
  4677.             userhost        => "$userhost"
  4678.         };
  4679.         
  4680.         if (my $sourse = $q->param('localfile')) {
  4681.             my $dest = $sourse;
  4682.             $dest =~ s/^(.*[\/|\\])*(.*)/$2/;
  4683.             my $dest_ = $dest;
  4684.             if ($dest =~ /^(.*)\.([a-zA-Z]*)$/){
  4685.                 $dest_ =$1 if (($2 eq 'gz') or($2 eq 'gzip') or($2 eq 'zip'));
  4686.             }
  4687.             my $filexist = sub {
  4688.                 if ($q->param('overwrite')){
  4689.                     unlink $_[0]
  4690.                 }
  4691.                 else {
  4692.                     close $sourse or bail_out("$!");
  4693.                     bail_out("File $dest_ already exists",$back)
  4694.                 }    
  4695.             };
  4696.             my $size_ = 0;
  4697.             if (-e "$userdir$delim$dest_") 
  4698.             {&$filexist("$userdir$delim$dest_"); $size_ = -s "$userdir$delim$dest_"}
  4699.             if (-e "$userdir/$dest_.gz")
  4700.             {&$filexist("$userdir$delim$dest_.gz"); $size_ = -s "$userdir$delim$dest_.gz"}
  4701.             if (-e "$userdir/$dest_.gzip")
  4702.             {&$filexist("$userdir$delim$dest_.gzip"); $size_ = -s "$userdir$delim$dest_.gzip"}
  4703.             if (-e "$userdir/$dest_.zip")
  4704.             {&$filexist("$userdir$delim$dest_.zip"); $size_ = -s "$userdir$delim$dest_.zip"}
  4705.  
  4706.             if ($MAX_BACKUP_SIZE){
  4707.                 my $size = dirsize($userdir);
  4708.                 $size += (-s $sourse) - $size_;
  4709.                 if ($size > ($MAX_BACKUP_SIZE*1024)) {
  4710.                     my $errmsg = "Total size of backup files is limited to $MAX_BACKUP_SIZE kb.";
  4711.                     $errmsg .= "\nPlease delete some files before uploading.";            
  4712.                     bail_out("$errmsg",$back);
  4713.                 }
  4714.             }
  4715.  
  4716.             $dest = "$userdir$delim$dest";
  4717.             open (DEST, ">$dest") || bail_out ("$! $dest_", $back);
  4718.             flock (DEST,2) unless $WIN32;
  4719.             #if (-B $sourse and $WIN32) {binmode $sourse; binmode DEST;};
  4720.             binmode $sourse; binmode DEST;
  4721.             my $data;
  4722.             while (read $sourse,$data,1024) {
  4723.                 print DEST $data;
  4724.             }
  4725.             flock (DEST,8) unless $WIN32;
  4726.             close DEST;
  4727.             close $sourse or bail_out($!);
  4728.         }
  4729.         else {bail_out("Please select file to upload", $back)}
  4730.         
  4731.     }
  4732.     if ($q->param('compressFile')){
  4733.         my @files_;
  4734.         bail_out("File(s) not selected", $back) unless @files;
  4735.         foreach(@files){
  4736.             s/^(.*)\s\/\d*\/\s.*/$1/;
  4737.             my $file = "$userdir/".$_;
  4738.             my @stat = stat;
  4739.             my $size = $stat[7];
  4740.             /^.*\.([a-zA-Z]*)$/;
  4741.             my $ext = $1;
  4742.             bail_out("File $_ is already comressed", $back) if (($ext eq 'gz')or($ext eq 'zip'));
  4743.             push @files_,$file;
  4744.         }
  4745.         foreach (@files_){
  4746.             if (($COMPRESS eq 'zip') and $ALLOW_ZIP){
  4747.                 my $outfile = $_.'.zip';
  4748.                 if (system ("$ZIP $outfile $_ $ZIPLOG")){
  4749.                     bail_out("ZIP FAILED: $? $!", $back);
  4750.                 }
  4751.                 unlink $_ if (-e and (-e $outfile)) || bail_out("Could not unlink the sourse $!", $back);            
  4752.             }
  4753.             elsif (($COMPRESS eq 'gzip') and $ALLOW_GZIP){
  4754.                 if (system ("gzip -fq $_")){
  4755.                     bail_out("GZIP FAILED: $? $!", $back);
  4756.                 }
  4757.             }
  4758.             else {bail_out("\$COMPRESS Variable was not set up properly.", $back)}
  4759.         }
  4760.  
  4761.     } #COMPRESS
  4762.     if ($q->param('preview') or $q->param('runremote')){
  4763.     
  4764.         if (@files >1){bail_out "Too many files.", $back}
  4765.         if (@files == 0){bail_out "Please select a file", $back}
  4766.         my ($ext, $file, $ungzip, $unzip);
  4767.         $files[0] =~ s/^(.*)\s\/\d*\/\s.*/$1/;
  4768.         if ($files[0] =~ /^(.*)\.([a-zA-Z]*)$/){
  4769.            $file = $1; $ext = $2
  4770.         }
  4771.         elsif ($files[0] =~ /^(.*)\.$/){
  4772.            $file = $files[0]; $ext = '';
  4773.         }
  4774.         else {$file = $files[0]}
  4775.         #my @all = <$userdir/*>;
  4776.         my $filename = "$userdir$delim$file";
  4777.         my $fullname = "$userdir$delim$files[0]";
  4778.         bail_out ("File $files[0] not found", $back) unless (-e $fullname);
  4779.         if ($ext =~ /^gz$/i){
  4780.             if (system ("gzip -fdv $fullname")) {bail_out("Failed to ungzip $fullname - $? . $! ", $back)} 
  4781.             $ungzip = 1;
  4782.         }
  4783.         elsif ($ext =~ /^zip$/i){
  4784. #check for available temp. file name    - 
  4785.             my $i="0E0";
  4786.             my $tempcopy;
  4787.             my $tempzip;
  4788.             do {
  4789.                 $tempcopy = $userdir.$delim.'temcopy'.$i;
  4790.                 $tempzip = $tempcopy.'.zip';
  4791.                 $i++; bail_out("Overcycled! ($i). Please contact support\@edatanew.com", $back) if ($i>999);
  4792.             }
  4793.             while ((-e "$tempzip") or (-e "$tempcopy\.gz") or (-e "$tempcopy"));
  4794.  
  4795.             File::Copy::copy("$fullname", "$tempzip") or bail_out("Cannot copy file $files[0] to tempcopy\.zip $!", $back);
  4796.             if (system ("gzip -df -S .zip $tempzip")) {
  4797.                 unlink "$tempzip" if -e $tempzip;
  4798.                 my $message = 
  4799.                 "Failed to uncompress temporary file. $! \n".
  4800.                 "Be sure that ZIP archive contains only ONE compressed file";
  4801.                 bail_out($message, $back);
  4802.             } 
  4803.             
  4804.             $unzip = 1;
  4805.             $filename = $tempcopy;
  4806. #            chmod 0777, "$filename";
  4807.         }
  4808.         else {$filename = $fullname}
  4809. # now the file of any format is prepared to read.    
  4810.         preview($filename,$file.".$ext",$back, $pageHead, $targethost, $selectdbname_) if $q->param('preview');
  4811.         
  4812. #runremote
  4813.         my $result = runremote($filename) if ($q->param('runremote'));
  4814.         
  4815.         if ($ungzip){
  4816.             if (system ("gzip -fq $filename")) {
  4817.                 bail_out("Failed to gzip $file. $? . $! ", $back)
  4818.             } 
  4819.         }
  4820.         if ($unzip){
  4821.             unlink $filename if (-e $filename);
  4822.         }
  4823.         
  4824.         bail_out($result, $back) if $result;
  4825.         
  4826.         if ($q->param('preview')){print qq!
  4827. <INPUT TYPE=SUBMIT NAME="runremote" VALUE="APPLY TO SELECTED DATABASE" TITLE="Apply this file to database "$selectdbname_""> 
  4828. <INPUT TYPE=SUBMIT NAME="back" VALUE="BACK" TITLE="Go back to previous page">
  4829. <INPUT TYPE=HIDDEN NAME="selectdbname_" VALUE="!  . $q->param('selectdbname_') . qq!">
  4830. <INPUT TYPE=HIDDEN NAME="selectfilelist" VALUE="! . quoteit($q->param('selectfilelist')). qq!">
  4831. !
  4832. ;
  4833.         print $pageBottom;
  4834.         return;
  4835.         }
  4836.     }
  4837.     my    $selectDBlist;
  4838.     if ($dberr) {
  4839.         $selectDBlist = $q->scrolling_list(
  4840.                         -name=>'selectdbname_',
  4841.                         -values=>[''],
  4842.                         -default=>[''],
  4843.                         -size=>1,
  4844.                         -title=>'Databases available on this server',
  4845.                         -labels=>{''=>'ACCESS DENIED'}
  4846.                     );
  4847.     }
  4848.     else {
  4849.         unshift @databases, "" unless (belongs(\@databases, $selectdbname_) and $q->param('selectdbname_'));
  4850.         $selectDBlist = qq!<SELECT name="selectdbname_" size=1  onChange="this.form.submit()" title="Databases available on this server">\n!;
  4851.         foreach (@databases){
  4852.             my $selected    = 'SELECTED' if ($_ eq $selectdbname_);
  4853.             $selectDBlist .= "<OPTION VALUE=\"$_\" $selected>$_\n";
  4854.         }
  4855.         $selectDBlist .= "</SELECT>\n";
  4856.     }
  4857.     my $back_ = $back;
  4858.     undef $back_->{selectdbname_};
  4859.  
  4860.     my $query             = "SHOW TABLES";
  4861.     $query                 .= " FROM $selectdbname_" if $selectdbname_;
  4862.     my $tablelistref    = $dbh_->selectcol_arrayref($query) if $selectdbname_;
  4863.     if ($DBI::err){
  4864.         if ($DBI::errstr =~ /Access\sdenied/i){$tablelistref = ['ACCESS DENIED']}
  4865.         else {bail_out("Failed to execute:\n$query", $back)}
  4866.     }
  4867.     my $tablelist; 
  4868.     {
  4869.         my $values = (defined $tablelistref) ? $tablelistref : ['NO DATABASE SELECTED'];
  4870.         unless (@$values){$values = ['Table list is empty']}
  4871.         {
  4872.             $tablelist = $q->scrolling_list(
  4873.                         -name        =>'',
  4874.                         -values        =>$values,
  4875.                         -default    =>[''],
  4876.                         -size        =>10,
  4877.                         -style        => "color: #bbbbbb",
  4878.                         -title        =>'Tables in selected database')
  4879.         }
  4880.     };
  4881.     unless ((-e $userdir) and (-d $userdir)) {
  4882.         mkdir $userdir, 0777 or bail_out("Cannot create directory. $!", {page => 'connect'})
  4883.     }
  4884.     my $tsize;
  4885.     @files = ();
  4886.     
  4887.     opendir DIR, $userdir; 
  4888.     my @filenames    = readdir (DIR) or print "Cannot read this directory: $userdir<br>";
  4889.     closedir DIR;
  4890.     
  4891.     foreach (@filenames){
  4892.         next if (($_ eq '.') or ($_ eq '..'));
  4893.         my $file  = "$userdir$delim$_";
  4894.         unless (-d $file){
  4895.             my @stat = stat $file;
  4896.             my $size = $stat[7];
  4897.             $tsize += $size;
  4898.             my $date = scalar localtime ($stat[9]);
  4899.             $date =~ s/^\s*\w\w\w\s*(.*)/$1/;
  4900.             s/^(.*\/)*(.*)$/$2/;
  4901.             $_ .= " /$size/ $date";
  4902.             push @files, $_;
  4903.         }
  4904.     }
  4905.     $tsize = int($tsize / 1024 * 100) / 100;
  4906.     
  4907.     my $selectfilelist = qq!\n<SELECT NAME="selectfilelist" SIZE=8 MULTIPLE  TITLE="Select file">\n!;
  4908.     if (@files == 0){$selectfilelist .=  qq!\t<OPTION VALUE="">FILE LIST IS EMPTY!}
  4909.     else{foreach (@files) {$_ = quoteit($_); $selectfilelist .= qq!\t<OPTION VALUE="$_">$_\n!} }
  4910.     $selectfilelist .= "<SELECT>\n";
  4911.     
  4912.     print "\n<!-- Admin (Restore)procedure starts here -->\n\n";
  4913.  
  4914.     &$pageHead();
  4915.     my $max_size = "Max. allowed size $MAX_BACKUP_SIZE kb" if $MAX_BACKUP_SIZE;
  4916.     my $compress_button = qq!<INPUT TYPE=SUBMIT NAME="compressFile" VALUE="COMPRESS" TITLE="Compress selected file">! if ($ALLOW_GZIP or $ALLOW_ZIP);
  4917.  
  4918. #++++++++++++++++++++++++++++++++++++++
  4919.  
  4920. my $textsize = $agent ? 15 : 22 ;
  4921. my $location = $succeed ? <<EOT
  4922.     <TABLE WIDTH="100%" BORDER=0 CELLPADDING=4 CELLSPACING=0 BGCOLOR="#AAAAAA">
  4923.         <TR>
  4924.             <TD BGCOLOR="#CCCCCC" TITLE="Status"><P>CONNECTED TO FOREIGN HOST:</TD>
  4925.         </TR>
  4926.         <TR>
  4927.             <TD BGCOLOR="#CCCCCC" TITLE="Connected host name"><P><NOBR> <I>$targethost</I></NOBR></TD>
  4928.         </TR>
  4929.         <TR>
  4930.             <TD BGCOLOR="#CCCCCC" TITLE="User name"><P><NOBR>AS USER: <I>$targetuser</I></NOBR></TD>
  4931.         </TR>
  4932.         <TR>
  4933.             <TD BGCOLOR="#CCCCCC" TITLE="Click to disconnect"><P><INPUT TYPE=SUBMIT NAME="disconnect" VALUE="Disconnect">
  4934.             </TD>
  4935.         </TR>
  4936.     </TABLE>
  4937. EOT
  4938. : <<EOT
  4939.  
  4940.     <TABLE WIDTH="100%" BORDER=0 CELLPADDING=4 CELLSPACING=0 BGCOLOR="#AAAAAA">
  4941.         <TR VALIGN=MIDDLE>
  4942.             <TD BGCOLOR="#CCCCCC" TITLE="Click to connect to Target Location" COLSPAN=2 VALIGN=MIDDLE><P>CHANGE TARGET HOST <INPUT TYPE=SUBMIT NAME="targetconnect" VALUE="Connect">
  4943.             </TD>
  4944.         </TR>
  4945.         <TR>
  4946.             <TD BGCOLOR="#CCCCCC" TITLE="User name on the target location"><P>User Name:</TD>
  4947.             <TD BGCOLOR="#CCCCCC" TITLE="User name on the target location"><P><INPUT TYPE=TEXT VALUE="" NAME="targetuser" TITLE="User name on the target location" SIZE=$textsize></TD>
  4948.         </TR>
  4949.         <TR>
  4950.             <TD BGCOLOR="#CCCCCC" TITLE="Password on the target location"><P>Password:</TD>
  4951.             <TD BGCOLOR="#CCCCCC" TITLE="Password on the target location"><P><INPUT TYPE=PASSWORD VALUE="" NAME="targetpassword" TITLE="Password on the target location" SIZE=$textsize></TD>
  4952.         </TR>
  4953.         <TR>
  4954.             <TD BGCOLOR="#CCCCCC" TITLE="Target Database"><P>Database</TD>
  4955.             <TD BGCOLOR="#CCCCCC" TITLE="Target Database"><P><INPUT TYPE=TEXT VALUE="" NAME="targetdb" TITLE="Target database" SIZE=$textsize></TD>
  4956.         </TR>
  4957.         <TR>
  4958.             <TD BGCOLOR="#CCCCCC" TITLE="Target Location"><P>Host:Port</TD>
  4959.             <TD BGCOLOR="#CCCCCC" TITLE="Target Location"><P><INPUT TYPE=TEXT NAME="targethost" VALUE="" TITLE="Target Host" SIZE=$textsize></TD>
  4960.         </TR>
  4961.     </TABLE>
  4962. EOT
  4963. ;
  4964.  
  4965.     print <<ENDOFRESTORE
  4966.     
  4967.             <INPUT TYPE=SUBMIT VALUE="RELOAD" TITLE="Update page"><INPUT TYPE=SUBMIT NAME="gotobackup" VALUE="CREATE BACKUP">
  4968.     
  4969. <TABLE WIDTH="100%" BORDER=0 ID="FRAMES" CELLPADDING=4 >
  4970.     <TR VALIGN=TOP>
  4971.         <TD VALIGN=TOP>
  4972.  
  4973. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%" >
  4974.             <TR>
  4975.                 <TD width="100%"><!-- BORDER START -->
  4976.  
  4977. <TABLE WIDTH="100%" BORDER=0 ID="REMOTE_LOCATION" CELLPADDING=4 CELLSPACING=0 BGCOLOR="#AAAAAA">
  4978.     <TR>
  4979.         <TD BGCOLOR="#CCCCCC">
  4980.             <NOBR>
  4981.             <INPUT TYPE=SUBMIT NAME="runremote" VALUE="       RUN SCRIPT       " TITLE="Apply selected file to database "$selectdbname_"">
  4982.             <INPUT TYPE=SUBMIT NAME="preview" VALUE="PREVIEW HEADER" TITLE="Preview header of selected file"></NOBR><BR>
  4983. <I>Run plain text, .zip and .gz files only</I>
  4984.         </TD>
  4985.     </TR>
  4986.     <TR>
  4987.         <TD BGCOLOR="#CCCCCC">
  4988.         <TABLE BORDER=0>
  4989.             <TR>
  4990.                 <TD VALIGN=TOP TITLE="Select file"><P>
  4991. $selectfilelist</TD>
  4992.                 <TD VALIGN=TOP><P>Total size:<BR>$tsize kb<P>
  4993.                 $max_size</TD>                
  4994.             </TR>
  4995.         </TABLE>
  4996.         </TD>
  4997.     </TR>
  4998.     <TR>
  4999.         <TD BGCOLOR="#CCCCCC">
  5000. <INPUT TYPE=SUBMIT NAME="delete" VALUE="DELETE" TITLE="DELETE SELECTED FILE">
  5001. <INPUT TYPE=SUBMIT NAME="downloadFile" VALUE="DOWNLOAD" TITLE="Download selected file">
  5002. $compress_button
  5003.         </TD>
  5004.     </TR>
  5005. </TABLE>
  5006.                 
  5007.                 </TD><!-- BORDER END -->
  5008.             </TR>
  5009. </TABLE>    <BR>    
  5010. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" width="100%">
  5011.             <TR>
  5012.                 <TD width="100%"><!-- BORDER START -->
  5013.  
  5014. <TABLE WIDTH="100%" BORDER=0 CELLPADDING=4 CELLSPACING=0 BGCOLOR="#AAAAAA">
  5015.     <TR>
  5016.         <TD BGCOLOR="#CCCCCC">
  5017.         <INPUT TYPE=FILE NAME="localfile" TITLE="Select file to upload">
  5018.         <INPUT TYPE=SUBMIT NAME="upload" VALUE="UPLOAD FILE" TITLE="Upload file">
  5019.         <BR><INPUT TYPE=CHECKBOX NAME="overwrite" TITLE="Overwrite existing file">Overwrite if exists.</TD>
  5020.     </TR>
  5021.  
  5022. </TABLE></TD><!-- BORDER END -->
  5023.             </TR>
  5024. </TABLE><BR>
  5025.         
  5026.         
  5027.         </TD><TD VALIGN=TOP><!-- END OF FIRST COLUMN -->
  5028.         
  5029.         
  5030.  
  5031. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%" >
  5032.             <TR>
  5033.                 <TD width="100%"><!-- BORDER START -->
  5034.  
  5035. <TABLE WIDTH="100%" BORDER=0 CELLPADDING=4 CELLSPACING=0 BGCOLOR="#AAAAAA">
  5036.     <TR>
  5037.         <TD BGCOLOR="#CCCCCC" TITLE="Databases available on the server"><P><nobr>APPLY TO DATABASE:<BR>
  5038. $selectDBlist <INPUT TYPE=SUBMIT VALUE="<-" TITLE="Show tables in selected database"></nobr></TD>
  5039.         
  5040.     </TR>
  5041.     <TR>
  5042.         <TD BGCOLOR="#CCCCCC" TITLE="Tables in selected database" COLSPAN=2><P><U>TABLE LIST:</U><BR>
  5043. $tablelist
  5044.         </TD>
  5045.     </TR>
  5046.     <TR>
  5047.         <TD BGCOLOR="#CCCCCC"><P>
  5048. <HR SIZE=1 WIDTH="100%">
  5049. $location
  5050.         </TD>
  5051.     </TR>
  5052.  
  5053. </TABLE>
  5054.                 
  5055.                 </TD><!-- BORDER END -->
  5056.             </TR>
  5057. </TABLE>
  5058.  
  5059.         </TD>
  5060.     </TR>
  5061. </TABLE><!-- END OF FRAME TABLE -->
  5062.  
  5063.  
  5064.         </TD>
  5065.     </TR>
  5066.     <TR>
  5067.         <TD> 
  5068. $pageBottom        
  5069.  
  5070.  
  5071. <!-- Admin (Restore) procedure ends here -->
  5072.  
  5073.         
  5074. ENDOFRESTORE
  5075. ;
  5076. }
  5077. sub loadAdmin {
  5078.     my $back        = $_[0];
  5079.     my $query;
  5080.     my $func = $q->param('func');
  5081.     my $version = get_version();
  5082.     if ($q->param('show')) {
  5083.         my $errmsg;
  5084.         my $like        = $q->param('LIKE');
  5085.         my $show = $q->param('showparam');
  5086.         if (($show eq 'STATUS') and  ($like ne '')) {
  5087.             $errmsg = "Current version (".get_version().") of MYSQL SERVER does not support SHOW STATUS LIKE syntax."
  5088.              unless check_version('3.23.00');
  5089.         }
  5090.         elsif ($show eq 'CHARACTER SET') {
  5091.             $errmsg = "Current version ($version) of MYSQL SERVER does not support SHOW CHARACTER SET syntax." unless check_version('4.1');
  5092.         }
  5093.         elsif ($show eq 'COLUMN TYPES') {
  5094.             $errmsg = "Current version (".get_version().") of MYSQL SERVER does not support SHOW COLUMN TYPES syntax." unless check_version('4.1');
  5095.         }
  5096.         elsif ($show eq 'INNODB STATUS') {
  5097.             $errmsg = "Current version (".get_version().") of MYSQL SERVER does not support SHOW INNODB STATUS syntax."
  5098.             unless check_version('3.23.52');
  5099.         }
  5100.         elsif ($show eq 'LOGS') {
  5101.             $errmsg = 
  5102.             "Current version ($version) of MYSQL SERVER does not support SHOW LOGS syntax."
  5103.             unless check_version('3.23.29');
  5104.         }
  5105.         elsif ($show eq 'PRIVILEGES') {
  5106.             $errmsg = 
  5107.             "Current version ($version) of MYSQL SERVER does not support SHOW PRIVILEGES syntax."
  5108.             unless check_version('4.1');
  5109.         }
  5110.         elsif ($show eq 'SHOW FULL PROCESSLIST') {
  5111.             $errmsg = 
  5112.             "Current version ($version) of MYSQL SERVER does not support SHOW SHOW FULL PROCESSLIST syntax."
  5113.             unless check_version('3.23.7');
  5114.         }
  5115.         elsif ($show eq 'TABLE TYPES') {
  5116.             $errmsg = 
  5117.             "Current version ($version) of MYSQL SERVER does not support SHOW TABLE TYPES syntax."
  5118.             unless check_version('4.1');
  5119.         }
  5120.         elsif ($show eq 'OPEN TABLES') {
  5121.             $errmsg = 
  5122.             "Current version ($version) of MYSQL SERVER does not support SHOW OPEN TABLES syntax."
  5123.             unless check_version('3.23.33');
  5124.         }
  5125.         elsif ($show eq 'SESSION VARIABLES') {
  5126.             $errmsg = 
  5127.             "Current version ($version) of MYSQL SERVER does not support SHOW SESSION VARIABLES syntax."
  5128.             unless check_version('4.0.3');
  5129.         }
  5130.         elsif ($show eq 'GLOBAL VARIABLES') {
  5131.             $errmsg = 
  5132.             "Current version ($version) of MYSQL SERVER does not support SHOW GLOBAL VARIABLES syntax."
  5133.             unless check_version('4.0.3');
  5134.         }
  5135.         elsif ($show eq 'VARIABLES') {
  5136.             $errmsg = 
  5137.             "Current version ($version) of MYSQL SERVER does not support SHOW GRANTS syntax."
  5138.             unless check_version('3.22.0');
  5139.         }
  5140. #++++++++++++++++++++++++++++++++++++++
  5141.         bail_out($errmsg, $back) if $errmsg; 
  5142.         $query = "SHOW ".$show;
  5143.         if ($show eq 'TABLE STATUS'){
  5144.             my $db = $q->param('dbname_');
  5145.             $query .= " FROM $db" if $db;
  5146.         }
  5147.         if (belongs(['STATUS', 'TABLE STATUS', 'OPEN TABLES', 'VARIABLES', 'SESSION VARIABLES', 'GLOBAL VARIABLES'], $show)){
  5148.             unless ($like =~ /%/){$like .= '%' if $like ne ''}
  5149.             $query .= ' LIKE '.$dbh->quote($like) if ($like ne '');
  5150.         }
  5151.     }
  5152.     elsif($func eq 'RESET QUERY CACHE'){
  5153.         bail_out ("Current version ($version) of MYSQL SERVER does not support RESET QUERY CACHE syntax.", $back) unless check_version('4.0.1');
  5154.         $dbh->do($func) || bail_out("Cannot RESET QUERY CACHE", $back);
  5155.     }
  5156.  
  5157.     if ($query){
  5158.         my ($sth,$res) = prepare_execute($query, $back);
  5159.         $query = quoteit($query);
  5160.         print "<P>Executed query: $query <BR>";
  5161.         print &printresult(\$sth);
  5162.         ErrMessage ("Print Result Error. $DBI::errstr") if $DBI::err;
  5163.         print qq!<FORM ACTION="$full_url" METHOD=POST>\n!;
  5164.         print qq!<P><INPUT TYPE=SUBMIT VALUE="Back">\n!;
  5165.         foreach (keys %$back){print qq!<INPUT TYPE=HIDDEN NAME="$_" VALUE="$back->{$_}">\n!}
  5166.         print "</FORM>";
  5167.         return;
  5168.     }
  5169.     
  5170.  
  5171.  
  5172.  
  5173.  
  5174.  
  5175.     my @databases;
  5176.     my $selectdbname_   = $q->param('selectdbname_');
  5177.     $selectdbname_  = $database unless $selectdbname_;
  5178.     my $databasesref = getdblist($dbh);
  5179.     my $DBlist; my $selectDBlist;
  5180.     if ($DBI::err and !$database){
  5181.         $DBlist = $q->scrolling_list(
  5182.                         -name        =>'dbname_',
  5183.                         -values        =>[''],
  5184.                         -size        =>1,
  5185.                         -labels        =>{'' => 'ACCESS DENIED'},
  5186.                         -title        => 'Select database to use with TABLE STATUS option'
  5187.                     );
  5188.         $selectDBlist = $q->scrolling_list(
  5189.                         -name   =>'selectdbname_',
  5190.                          -labels    =>{'' => 'ACCESS DENIED'},
  5191.                            -values =>[''],
  5192.                         -size   =>1,
  5193.                     );
  5194.     }
  5195.     else {
  5196.         @databases = @$databasesref;
  5197.         $DBlist = $q->scrolling_list(
  5198.                         -name        =>'dbname_',
  5199.                         -values        =>[@databases,''],
  5200.                         -default    =>[$database],
  5201.                         -size        =>1,
  5202.                         -title        => 'Select database to use with TABLE STATUS option'
  5203.                     );
  5204.                     
  5205.         push @databases,'' unless $selectdbname_;                    
  5206.         $selectDBlist = $q->scrolling_list(
  5207.                         -default=>[$database],
  5208.                         -name=>'selectdbname_',
  5209.                         -values=>[@databases],
  5210.                         -size=>1,
  5211.                         -onChange=>'this.form.submit()'
  5212.                     );
  5213.     }
  5214.     
  5215.     my $tablelist = qq!\n<SELECT NAME="tablelist" SIZE=13 MULTIPLE>\n!;
  5216.     my $tablelistref;
  5217.     if ($selectdbname_) {
  5218.         $tablelistref = $dbh->selectcol_arrayref("SHOW TABLES FROM $selectdbname_");
  5219.         if (! defined $tablelistref ) {
  5220.             if ($DBI::err){
  5221.                 if ($DBI::errstr =~ /access/i){
  5222.                     $tablelist .= qq!<OPTION VALUE="">ACCESS DENIED\n!;
  5223.                 }
  5224.                 else{
  5225.                     $tablelist .= qq!<OPTION VALUE="">CANNOT SHOW TABLES\n!;
  5226.                     $tablelist .= qq!<OPTION VALUE="">Check database name\n!;
  5227.                 }
  5228.             }
  5229.             else {$tablelist .= qq!<OPTION VALUE="">CANNOT SHOW TABLES\n!}
  5230.         }
  5231.         elsif (@$tablelistref == 0){
  5232.             $tablelist .= qq!<OPTION VALUE="">Table list is empty\n!;
  5233.         }
  5234.         else{
  5235.             my @tblist = $q->param('tablelist');
  5236.             foreach (@$tablelistref){
  5237.                 my $selected = 'SELECTED' if belongs(\@tblist, $_);
  5238.                 $tablelist .= qq!<OPTION VALUE="$_" $selected>$_!
  5239.             }
  5240.         }
  5241.     }
  5242.     else {
  5243.         $tablelist .= qq!<OPTION VALUE="">SELECT DATABASE\n!;
  5244.     }
  5245.     $tablelist .= "</SELECT>\n";
  5246.     
  5247.  
  5248.     my  $buttonwidth     = '110px';
  5249.     my  $buttonsmall     = '50px';
  5250.     my  $buttonwidth2     =  ($buttonwidth * 2) + 15;
  5251.     my $style;
  5252.     my $showselect = qq!<SELECT NAME="showparam">\n!;
  5253.     $showselect .= qq!<OPTION VALUE="" SELECTED>!;
  5254.     $showselect .= qq!<OPTION VALUE="PROCESSLIST">PROCESSLIST\n!;
  5255.     $showselect .= qq!<OPTION VALUE="STATUS">STATUS\n!;
  5256.     unless (check_version("3.22.00")){$style = qq!style="color: #bbbbbb"!}
  5257.     $showselect .= qq!<OPTION VALUE="VARIABLES" $style>VARIABLES\n!;
  5258.     unless (check_version("3.22.00")){$style = qq!style="color: #bbbbbb"!}
  5259.     $showselect .= qq!<OPTION VALUE="TABLE STATUS" $style>TABLE STATUS\n!;
  5260.     unless (check_version("3.23.29")){$style = qq!style="color: #bbbbbb"!}
  5261.     $showselect .= qq!<OPTION VALUE="LOGS" $style>LOGS\n!;
  5262.     unless (check_version("3.23.33")){$style = qq!style="color: #bbbbbb"!}
  5263.     $showselect .= qq!<OPTION VALUE="OPEN TABLES" $style>OPEN TABLES\n!;
  5264.     unless (check_version("3.23.52")){$style = qq!style="color: #bbbbbb"!}
  5265.     $showselect .= qq!<OPTION VALUE="INNODB STATUS" $style>INNODB STATUS\n!;
  5266.     unless (check_version("4.0.3")){$style = qq!style="color: #bbbbbb"!}
  5267.     $showselect .= qq!<OPTION VALUE="SESSION VARIABLES" $style>SESSION VARIABLES\n!;
  5268.     $showselect .= qq!<OPTION VALUE="GLOBAL VARIABLES" $style>GLOBAL VARIABLES\n!;
  5269.     unless (check_version("4.1")){$style = qq!style="color: #bbbbbb"!}
  5270.     $showselect .= qq!<OPTION VALUE="CHARACTER SET" $style>CHARACTER SET\n!;;
  5271.     $showselect .= qq!<OPTION VALUE="COLUMN TYPES" $style>COLUMN TYPES\n!;
  5272.     $showselect .= qq!<OPTION VALUE="TABLE TYPES" $style>TABLE TYPES\n!;
  5273.     $showselect .= qq!<OPTION VALUE="PRIVILEGES" $style>PRIVILEGES\n!;
  5274.  
  5275.     $showselect .= qq!</SELECT>    \n!;
  5276.  
  5277.     $style = '';
  5278.     unless (check_version("3.23.18")){$style = qq!style="color: #bbbbbb"!}
  5279.     my $flashselect = qq!<OPTION VALUE="TABLES WITH READ LOCK" $style>TABLES WITH READ LOCK!;
  5280.     unless (check_version("4.0.1")){$style = qq!style="color: #bbbbbb"!}
  5281.     $flashselect .= qq!<OPTION VALUE="DES_KEY_FILE" $style>DES KEYS!;
  5282.     $flashselect .= qq!<OPTION VALUE="QUERY CACHE" $style>QUERY CACHE!;
  5283.     
  5284.     unless (check_version("4.0.2")){$style = qq!style="color: #bbbbbb"!}
  5285.     $flashselect .= qq!<OPTION VALUE="USER_RESOURCES" $style>USER RESOURCES!;
  5286.     
  5287.     
  5288.     print <<ENDOFADMIN    
  5289. <!-- Admin procedure starts here -->
  5290.  
  5291. <FORM METHOD=POST ACTION="$full_url">
  5292. <TABLE BORDER=0>
  5293.     <TR><TH ALIGN=LEFT COLSPAN=3>ADMINISTRATION</TH></TR>
  5294.     <TR><TD VALIGN=TOP>
  5295.     
  5296.  
  5297.     
  5298. <!-- ACCESS CONTROL    -->
  5299. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA">
  5300.             <TR>
  5301.                 <TD WIDTH=300><!-- BORDER START -->
  5302.     <TABLE BORDER=0 CELLPADDING=4 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH=100%>
  5303.         <TR>
  5304.             <TD BGCOLOR="#CCCCCC"><INPUT TYPE=SUBMIT NAME="func" VALUE="  ACCESS CONTROL  " style="width: $buttonwidth2"></TD>
  5305.         </TR>
  5306.     </TABLE>
  5307.                 </TD><!-- BORDER END -->
  5308.             </TR>
  5309. </TABLE>
  5310.  
  5311. <BR>    
  5312.  
  5313.  
  5314. <!-- -------------------- SHOW--------------- -->
  5315.  
  5316. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" >
  5317.             <TR>
  5318.                 <TD width=300><!-- BORDER START -->
  5319.  
  5320. <TABLE WIDTH=100% BORDER=0 ID="FUNC_TABLE1" CELLPADDING=3 CELLSPACING=0 BGCOLOR="#AAAAAA">
  5321.     <TR>
  5322.         <TD BGCOLOR="#CCCCCC" TITLE="Show selected option">
  5323.         <INPUT TYPE=SUBMIT NAME="show" VALUE="   SHOW   " TITLE="Show selected option" style="width: $buttonwidth"></TD></TR>
  5324.     <TR BGCOLOR="#CCCCCC">
  5325.         <TD BGCOLOR="#CCCCCC" HEIGHT=20 VALIGN=TOP TITLE="Select option to show">
  5326. $showselect
  5327. <BR></TD>
  5328.     </TR>
  5329.     <TR>
  5330.         <TD BGCOLOR="#CCCCCC">[LIKE] <BR><INPUT TYPE=TEXT NAME="LIKE" SIZE=10 TITLE="Specify pattern to show result"></TD>
  5331.     </TR>
  5332.     <TR>
  5333.         <TD BGCOLOR="#CCCCCC" TITLE="Select database to use with TABLE STATUS option">[FROM DATABASE]<BR>
  5334. $DBlist
  5335.        </TD>
  5336.     </TR>
  5337.  
  5338. </TABLE>
  5339.  
  5340.  
  5341.                 </TD><!-- BORDER END -->
  5342.             </TR>
  5343. </TABLE><BR>
  5344. <!-- FLUSH -->
  5345. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" >
  5346.             <TR>
  5347.                 <TD width=300><!-- BORDER START -->
  5348.                 
  5349. <TABLE BORDER=0 BGCOLOR="#AAAAAA" CELLSPACING=0 CELLPADDING=3 WIDTH=100%>
  5350.     <TR VALIGN=TOP>
  5351.         <TD BGCOLOR="#CCCCCC" HEIGHT=25 TITLE="Select option to flush" VALIGN=TOP>
  5352.         <INPUT TYPE=SUBMIT NAME="func" VALUE="   FLUSH   " TITLE="Flush selected option" style="width: $buttonwidth"><BR></TD>
  5353.         <TD HEIGHT=15  BGCOLOR="#CCCCCC"  TITLE="Select option to flush">
  5354. <SELECT NAME="flush" TITLE="Select option to flush">
  5355. <OPTION VALUE="" SELECTED>
  5356. <OPTION VALUE="HOSTS">HOSTS
  5357. <OPTION VALUE="LOGS">LOGS
  5358. <OPTION VALUE="PRIVILEGES">PRIVILEGES
  5359. <OPTION VALUE="TABLES">TABLES
  5360. <OPTION VALUE="STATUS">STATUS
  5361. $flashselect
  5362. </SELECT></TD>
  5363.     </TR>
  5364. </TABLE>
  5365.  
  5366.  
  5367.                 </TD><!-- BORDER END -->
  5368.             </TR>
  5369. </TABLE><br>
  5370.  
  5371. <!-- RESET -->
  5372. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" >
  5373.             <TR>
  5374.                 <TD width=300><!-- BORDER START -->
  5375.                 
  5376. <TABLE BORDER=0 BGCOLOR="#AAAAAA" CELLSPACING=0 CELLPADDING=3 WIDTH=100%>
  5377.     <TR VALIGN=TOP>
  5378.         <TD BGCOLOR="#CCCCCC" HEIGHT=25 TITLE="Select option to flush" VALIGN=TOP>
  5379.         <INPUT TYPE=SUBMIT NAME="func" VALUE="RESET QUERY CACHE" TITLE="Flush selected option" style="width: $buttonwidth2"><BR></TD>
  5380.     </TR>
  5381. </TABLE>
  5382.  
  5383.  
  5384.                 </TD><!-- BORDER END -->
  5385.             </TR>
  5386. </TABLE>
  5387.  
  5388.             <!-- COLUMN 1 END -->
  5389.             </TD>
  5390.             <TD WIDTH=10>  </TD>
  5391. <!-- -----select database, select tables-------- -->
  5392.             
  5393.             <TD VALIGN=TOP>
  5394. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" ><!-- BORDER START -->
  5395.             <TR>
  5396.                 <TD width=260><!-- BORDER START -->
  5397.                 
  5398. <TABLE BORDER=0 BGCOLOR="#AAAAAA" CELLSPACING=0 CELLPADDING=3 WIDTH=100%>
  5399.     <TR>
  5400.         <TD BGCOLOR="#CCCCCC"><INPUT TYPE=SUBMIT NAME="func" VALUE="OPTIMIZE" TITLE="Optimize selected tables" style="width: $buttonwidth"></TD>
  5401.         
  5402.         <TD BGCOLOR="#CCCCCC"> </TD>
  5403.         
  5404.         <TD BGCOLOR="#CCCCCC"><INPUT TYPE=SUBMIT NAME="func" VALUE=" CHECK " TITLE="Check selected tables" style="width: $buttonwidth"></TD>
  5405.     </TR>
  5406.     <TR>
  5407.         <TD BGCOLOR="#CCCCCC"><INPUT TYPE=SUBMIT NAME="func" VALUE="ANALYZE " TITLE="Analyze selected tables" style="width: $buttonwidth"></TD>
  5408.         
  5409.         <TD BGCOLOR="#CCCCCC"> </TD>
  5410.         
  5411.         <TD BGCOLOR="#CCCCCC"><INPUT TYPE=SUBMIT NAME="func" VALUE=" REPAIR " TITLE="Repair selected tables" style="width: $buttonwidth"></TD>
  5412.     </TR>
  5413.     <TR>
  5414.     <TR><TD COLSPAN=3 BGCOLOR="#CCCCCC"> </TD></TR>
  5415.         <TD BGCOLOR="#CCCCCC" TITLE="Databases available on this server" COLSPAN=3>SELECT DATABASE:<BR><nobr>$selectDBlist <INPUT TYPE=SUBMIT VALUE="<-" TITLE="Show tables in selected database"></nobr></TD>
  5416.     </TR>
  5417.     <TR>
  5418.         <TD BGCOLOR="#CCCCCC"  COLSPAN=3 TITLE="Select tables to use with Check, Repair, Analyze or Optimize">SELECT TABLE:<BR>$tablelist</TD>
  5419.     </TR>
  5420.     <TR>
  5421.         <TD BGCOLOR="#CCCCCC"  COLSPAN=3 TITLE="Select all tables"><INPUT TYPE=CHECKBOX NAME="selectalltables" TITLE="Select all tables"> SELECT ALL TABLES</TD>
  5422.     </TR>
  5423. </TABLE>
  5424.                 
  5425.                 </TD><!-- BORDER END -->
  5426.             </TR>
  5427. </TABLE>
  5428.  
  5429.  
  5430.  
  5431.         </TD>
  5432.     </TR>
  5433. </TABLE><!-- END OF BIG TABLE -->
  5434.  
  5435. <INPUT TYPE=HIDDEN NAME="page" VALUE="admin">
  5436. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  5437. </FORM>
  5438.  
  5439.  
  5440. <!-- Admin procedure ends here -->
  5441.     
  5442. ENDOFADMIN
  5443. ;
  5444. }
  5445. sub execBackup {
  5446.  
  5447.     my $ERRMSG = <<EndERRMSG
  5448. THE FOLLOWING MUST BE SELECTED:
  5449.  
  5450. DATABASE,
  5451. TABLES,
  5452. BACKUP FILE DESTINATION (save and/or download),
  5453. BACKUP FILE TYPE (zip, gzip, plain text),
  5454. BACKUP FILE NAME
  5455. EndERRMSG
  5456. ;
  5457.     
  5458.     my $userhost = myhost();
  5459.     my $dbname                = $q->param('selectdbname_');
  5460.     my $back                = {page => "$page",
  5461.                               func => "backup"};
  5462.     $back->{dbname}            = "$database" if $database;
  5463.     $back->{selectdbname_}    = "$dbname" if $dbname;
  5464.     bail_out($ERRMSG,$back) unless $dbname;
  5465.     my $DOWNLOAD            = $q->param('downloadBackup');
  5466.     my $KEEPFILE            = $q->param('keep');
  5467.     bail_out($ERRMSG,$back) unless ($KEEPFILE or $DOWNLOAD);
  5468.     my $fyletype            = $q->param('type');
  5469.     bail_out($ERRMSG,$back) unless $fyletype;
  5470.     my $filename            = $q->param('remotefile');
  5471.     bail_out($ERRMSG,$back) unless $filename;    
  5472.     unless ($dbh->do("USE $dbname")){bail_out("Can not use $dbname", $back)}
  5473.     if (($filename =~ /[\\\/]/g) or ($filename =~ /[\/]/g)){
  5474.         bail_out("File name is incorrect", $back)
  5475.     }
  5476.     if (my $errmsg = checkuserdir('backup')){bail_out("$errmsg\n$!", $back)}
  5477.     my $userdir                = "$USER_DIR$delim$user.$userhost$delim" . "backup";
  5478.     my $file                 = "$userdir$delim$filename";
  5479.     bail_out ("File $filename already exists.", $back) if (-e $file);
  5480.     bail_out ("File $filename already exists.", $back) if (-e $file.'.gz');
  5481.     bail_out ("File $filename already exists.", $back) if (-e $file.'.zip');
  5482.  
  5483.     my $tablelistref;
  5484.     my @tablelist;
  5485.     if ($q->param('selectalltables')) {
  5486.         my $query = "SHOW TABLES";
  5487.         $tablelistref = $dbh->selectcol_arrayref($query) || bail_out("Cannot SHOW TABLE", $back);
  5488.         @tablelist = @$tablelistref;
  5489.     }
  5490.     else {@tablelist = $q->param('tablelist'); $tablelistref = \@tablelist}
  5491.     bail_out ($ERRMSG,$back) unless $tablelist[0];
  5492.     my $dropifexists = $q->param('dropifexists');
  5493.     my $include = $q->param('include');
  5494.     my $filecontent = "#\tDATABASE '$dbname' \n";
  5495.     $filecontent .= "#\tUser: $user\@$userhost\n#\n";
  5496.     $filecontent .= "#\tServer Version: ".get_version()."\n";
  5497.     $filecontent .= "#\tBACKUP CREATED ". scalar gmtime()." (GMT)\n";
  5498.     $filecontent .= "#\tby MYSQL DATA MANAGER (http://www.edatanew.com)\n";
  5499.     $filecontent .= "#\t----------------------------------------------------\n#\n";
  5500.     $filecontent .= "#\tOPTIONS:\n";
  5501.     $filecontent .= "#\t- \"DROP TABLE IF EXISTS\" added\n" if ($dropifexists and ($include ne 'data'));
  5502.     $filecontent .= "#\t- Only tables structure included\n" if ($include eq 'structure') ;
  5503.     $filecontent .= "#\t- Only data included\n" if ($include eq 'data');
  5504.     $filecontent .= "#\t----------------------------------------------------\n";
  5505.     $filecontent .= "#\n#\tTABLE LIST:\t\t\n#\t".join("\n#\t", @tablelist);
  5506.     $filecontent .= "\n#\n#\n#EndOfHeader\n\n";
  5507.     my $hashref     = {
  5508.         tablelist         => \@tablelist,
  5509.         include            => $include,
  5510.         dropifexists    => $dropifexists,
  5511.         back            => $back,
  5512.         comments        => 1,
  5513.         lock            => 0
  5514.     };
  5515.     $filecontent .= getdatanstructure($hashref);
  5516.     open (FH, "+> $file") || bail_out ("Can not open $file $!", $back);
  5517.     #binmode FH;
  5518.     flock(FH, 2) unless $WIN32;
  5519.     print FH $filecontent;
  5520.     flock(FH, 8) unless $WIN32;
  5521.     close FH;
  5522.     undef $filecontent;
  5523.     #chmod 0777, "$file";
  5524.     my ($outfile, $outfilename, $mimetype);
  5525.     my $i=0;
  5526.     if ($q->param('type') eq 'zip'){
  5527.         $outfile = $file.'.zip';
  5528.         $mimetype = 'application/zip';
  5529.         if (system ("$ZIP $outfile $file $ZIPLOG")){
  5530.             unlink $file if (-e $file);
  5531.             bail_out("$? zip $!", $back);
  5532.         }
  5533.         
  5534.         $outfilename = $filename.'.zip';
  5535.     }
  5536.     elsif ($q->param('type') eq 'gzip'){
  5537.     my $i=0;
  5538.         if (system ("gzip -fq $file")){
  5539.             unlink "$file" if (-e $file);
  5540.             bail_out("$? $! gzip ");
  5541.         }
  5542.         $outfile = $file.'.gz';
  5543.         $outfilename = $filename.'.gz';
  5544.         $mimetype = 'application/x-gzip';
  5545.     }
  5546.     else {
  5547.         $mimetype = 'application/x-perl';
  5548.         $outfile = $file;
  5549.         $outfilename = $filename;
  5550.     }
  5551. #    chmod 0777, "$outfile";
  5552.     unless ($q->param('type') eq 'text') {
  5553.         if (-e $file){unlink $file || bail_out("Cannot unlink $file $!", $back)}
  5554.     }    
  5555.     if ($q->param('keep') and $MAX_BACKUP_SIZE){
  5556.         my $size = dirsize($userdir);
  5557.         if ($size > ($MAX_BACKUP_SIZE*1024)) {
  5558.             my $errmsg = "Total size of backup files is limited to $MAX_BACKUP_SIZE kb.\n";
  5559.             $errmsg .= "New backup file can only be downloaded.\n";
  5560.             $errmsg .= "Please delete some files if you need to keep new backup file on the server.\n";            
  5561.             unlink $outfile || bail_out("Cannot unlink $outfilename $! \n$errmsg", $back);
  5562.             print "SIZE: $size<BR>";
  5563.             bail_out("$errmsg",$back);
  5564.         }
  5565.     }#if keep
  5566.  
  5567.     if ($q->param('downloadBackup')){
  5568.         $| = 1; 
  5569.         $SIG{CHLD}  = 'IGNORE';    
  5570.  
  5571.         my $size = -s "$outfile" or bail_out("$! $outfile", $back);
  5572.         open FHN, $outfile or bail_out("$! $outfile", $back);
  5573.         flock (FHN,2) unless $WIN32;
  5574.         binmode FHN;
  5575.         
  5576.         print "Content-disposition: inline; filename=$outfilename\n";
  5577.         print "Content-length: $size\n";
  5578.         print "Content-type: $mimetype; name=\"$outfilename\"\n\n";
  5579.  
  5580.         binmode STDOUT;
  5581.         my $data;
  5582.         while (read FHN, $data, 1024) {
  5583.             print $data
  5584.         }
  5585.         flock (FHN,8) unless $WIN32;
  5586.         close FHN;
  5587.     
  5588.         unless ($q->param('keep')) {unlink $outfile || bail_out("Cannot unlink $outfile $!", $back)}
  5589.         $dbh->disconnect if defined $dbh;
  5590.         exit 0;
  5591.     } # if download
  5592. }
  5593.  
  5594.  
  5595. sub execFlush {
  5596.     my $back = $_[0];
  5597.     if ($q->param('flush')) {
  5598.         my $flush = $q->param('flush');
  5599.         my $version = get_version();
  5600.         my $errmsg;
  5601.         if (($flush eq 'DES_KEY_FILE') or ($flush eq 'QUERY CACHE')) {
  5602.             $errmsg = 
  5603.             "Current version ($version) of MYSQL SERVER does not support SHOW GLOBAL VARIABLES syntax."    unless check_version('4.0.1');
  5604.         }
  5605.         elsif ($flush eq 'USER_RESOURCES') {
  5606.             $errmsg = 
  5607.             "Current version ($version) of MYSQL SERVER does not support SHOW GLOBAL VARIABLES syntax."    unless check_version('4.0.2');
  5608.         }
  5609.         elsif ($flush eq 'TABLES WITH READ LOCK') {
  5610.             $errmsg = 
  5611.             "Current version ($version) of MYSQL SERVER does not support SHOW GLOBAL VARIABLES syntax."    unless check_version('4.23.18');
  5612.         }
  5613.         bail_out($errmsg, $back) if $errmsg;
  5614.         my $query = "FLUSH $flush";
  5615.         unless ($dbh->do($query)){bail_out("Failed to Flush", $back)}
  5616.     }
  5617. #    else{bail_out("Can not Flush. Nothing was selected", $back)}
  5618. }
  5619.  
  5620. sub execCheckRepair {
  5621.     my $back = $_[0];
  5622.     my $func = $_[1];
  5623.     bail_out("Database is not selected.", $back) unless ($q->param('selectdbname_'));
  5624.     my @tablelist;
  5625.     if ($q->param('selectalltables')) {
  5626.         my $tablelistref = getTablelist($q->param('selectdbname_'), $back);
  5627.         @tablelist = @$tablelistref;
  5628.     }
  5629.     else {@tablelist = $q->param('tablelist')}
  5630.     bail_out("Table list is not selected.", $back) unless ($tablelist[0]);
  5631.     
  5632.     
  5633.     my $errmsg = 
  5634.     "Current version (".get_version().") of MYSQL SERVER does not support $func TABLES syntax.";    
  5635.     if ($func eq 'ANALYZE'){
  5636.          bail_out($errmsg,$back)    unless check_version('3.23.22')
  5637.     }
  5638.     elsif ($func eq 'CHECK'){
  5639.          bail_out($errmsg,$back)    unless check_version('3.23.13')
  5640.     }
  5641.     elsif ($func eq 'REPAIR'){
  5642.            bail_out($errmsg,$back)    unless check_version('3.23.14');
  5643.     }
  5644.     elsif ($func eq 'OPTIMIZE'){
  5645.            bail_out($errmsg,$back)    unless check_version('3.22.7');
  5646.         bail_out("Too many tables selected for current version Mysql (".get_version().")") 
  5647.                       if (!check_version('3.23.00') and (@tablelist > 1));
  5648.     }
  5649.     unless ($q->param('selectdbname_')){loadAdmin(); return}
  5650.     unless ($q->param('selectdbname_') eq $database){
  5651.         my $query = "USE ".$q->param('selectdbname_');
  5652.         $dbh->do($query) || bail_out ("Cannot use secected database.", $back);
  5653.     }
  5654.     unless (@tablelist) {loadAdmin(); return}
  5655.     my $query = "$func TABLE ";
  5656.     $query .= join (', ', @tablelist);
  5657.     my ($sth, $res) = prepare_execute($query, $back);
  5658.     print "<P>Executed query:\n$query <BR>";
  5659.     if (belongs(\@selectlike,$func)){
  5660.        print &printresult(\$sth);
  5661.        ErrMessage ("Print Result Error. $DBI::errstr") if $DBI::err;
  5662.     }
  5663.     print qq!<FORM ACTION="$full_url" METHOD=POST>\n!;
  5664.     print qq!<P><INPUT TYPE=SUBMIT VALUE="Back">\n!;
  5665.     foreach (keys %$back){print qq!<INPUT TYPE=HIDDEN NAME="$_" VALUE="$back->{$_}">\n!}
  5666.     print "</FORM>";
  5667. }
  5668. sub preview {
  5669.         my ($filename, $file, $back, $pageHead, $targethost, $selectdbname_) = @_;
  5670.         open (FH, "$filename") || bail_out("Can not open file$!", $back);
  5671.         flock (FH,2) unless $WIN32;
  5672.         $targethost = myhost($targethost)             if $targethost;
  5673.         my $onhost    = "  on $targethost"     if ($targethost and $selectdbname_);
  5674.         my $ondb    = "   Selected Database: <U><I>$selectdbname_</I></U>"     if $selectdbname_;
  5675.         &$pageHead("$ondb $onhost");
  5676.         print "<BR><B>FILE HEADER PREVIEW (",quoteit($file),")</B><BR>\n";
  5677.         print qq!<TEXTAREA COLS=70 ROWS=15 TITLE="Header of selected file">\n!;
  5678.         
  5679.         my $i;
  5680.         while(<FH>){
  5681.             last unless ((/^#/) or ($i<12));
  5682.             $_ = quoteit($_);
  5683.             print;
  5684.             if ($i++ > 10000) {bail_out("OVERCYCLED!", $back)} 
  5685.         }
  5686.         print "</TEXTAREA><BR>\n";
  5687.         flock (FH,8) unless $WIN32;
  5688.         close FH;
  5689. }
  5690.  
  5691. sub runremote  {
  5692.     my ($filename) = shift;
  5693.     return ("Database is not selected") unless (my $selectdbname_ = $q->param('selectdbname_'));
  5694.     if ($WIN32) {
  5695.         $filename =~ s/\//\\/g;
  5696.     }
  5697. # Syntax:
  5698. # DBI:mysql:db_name:host_name:port,user,password
  5699. # DBI:mysql:db_name;host=host_name:port,user,password
  5700. # DBI:mysql:database=db_name;host_name:port,user,password
  5701. # DBI:mysql:database=db_name;host=host_name:port,user,password
  5702. # DBI:mysql:database=db_name;host=host_name;port=port,user,password
  5703. # DBI:mysql:database=db_name;param_name=param_value;host=host_name;port=port,user,password
  5704.  
  5705. # other parameters:
  5706. # mysql_compression=1
  5707. # mysql_read_default_file=file_name;
  5708. # mysql_read_default_group=group_name;
  5709. # mysql_socket=socket_name
  5710. # 
  5711.         
  5712.         my ($hostname, $portnum, $username, $ppassword, $options);
  5713. #-----port:
  5714.         my $back = {
  5715.             page => 'admin',
  5716.             func => 'restore'
  5717.         };
  5718.         $back->{selectdbname_}    = $q->param('selectdbname_') if $q->param('selectdbname_');
  5719.         $back->{dbname}            = $q->param('dbname')         if $q->param('dbname');
  5720.         $back->{target}            = $q->param('target');
  5721.         if ($q->param('target')){
  5722.             my ($targetuser, $targetpassword, $targethost)    = $q->cookie('target_db');
  5723.             ($hostname, $portnum)                            = myhost($targethost);
  5724.             $username                                        = " -u $targetuser"        if $targetuser;
  5725.             $ppassword                                         = " -p$targetpassword"    if $targetpassword;
  5726.         }
  5727.         else{
  5728.             ($hostname, $portnum)                            = myhost();
  5729.             $username                                        = " -u $user"        if $user;
  5730.             $ppassword                                         = " -p$password"    if $password;
  5731.         }
  5732.         $hostname                = " -h $hostname"    if $hostname;
  5733.         $portnum                = " -P $portnum"    if $portnum;
  5734.         $options                 = $hostname         if $hostname;
  5735.         $options                 .= $portnum         if $portnum;
  5736.         $options                 .= $username         if $username;
  5737.         $options                 .= $ppassword         if $ppassword;
  5738.         $options                 .= " -S $SOCKET"     if $SOCKET;
  5739.         $options                 .= " $OTHER_MYSQL"     if $OTHER_MYSQL;
  5740.         my $command = "EXECUTED COMMAND:\n$MYSQL $options $selectdbname_ \< $filename";
  5741.  
  5742. #++++++++++++++++++++++++++++++++++++++
  5743.     CGI::Carp::carpout(\*STDOUT);
  5744.     if (system("$MYSQL $options $selectdbname_ \< $filename")){return ("ERROR: $DBI::errstr\n$command\n")}
  5745.     
  5746.     return undef;
  5747.  
  5748. }
  5749.  
  5750. #++++++++++++++++++++++++++++++++++++++
  5751.  
  5752. sub loadexecscript  {
  5753.  
  5754. # attempt to create directory if not exist
  5755.  
  5756.     my $script            = $q->param('script');
  5757.     if ($script eq 'print'){execExecuteQuery(); return}
  5758.     my $userhost        = myhost();
  5759.     my $userdir         = "$USER_DIR$delim$user.$userhost";
  5760.     my $errmsg            = "";
  5761.     unless ((-e $userdir) and (-d $userdir)) {mkdir $userdir, 0777 || {$errmsg = $!}}
  5762.     unless ($errmsg ){
  5763.         unless ((-e $userdir) and (-d $userdir)){$errmsg = $!}
  5764.         unless ($errmsg ){
  5765.             $userdir .= $delim."sql";
  5766.             unless ((-e $userdir) and (-d $userdir)) {mkdir $userdir, 0777 || {$errmsg = $!}}
  5767.             unless (!$errmsg and (-e $userdir) and (-d $userdir)) {$errmsg = $!}
  5768.         }
  5769.     }
  5770.     my $selectscript;
  5771.     my $selectedscript = $q->param('selectedscript') unless $q->param('script') eq 'Close';
  5772.     my $back = {
  5773.             dbname                => "$database",
  5774.             page                => "tables",
  5775.             func                => 'script',
  5776.             selectedscript        => $selectedscript,
  5777.             SQL                    => $q->param('SQL')
  5778.     };
  5779.     my $readscript = sub {
  5780.         my $script;
  5781.         my $file     = "$userdir$delim$_[0]";
  5782.         open (FH, "$file") || bail_out("Can not open file $_[0]\n$!", $back);
  5783.         flock (FH,2) unless $WIN32;
  5784.         my $i;
  5785.         while(<FH>){
  5786.             $script .= $_;
  5787.             if ($i++ > 10000) {bail_out("The script is too big", $back)} 
  5788.         }
  5789.         flock (FH,8) unless $WIN32;
  5790.         close FH;
  5791.         return $script;
  5792.     };
  5793.     my @files                 = $q->param('selectscript');
  5794.     my $SQL;
  5795.     
  5796.     if ($script        =~ /(Edit)|(Open)/i ){
  5797.         bail_out("Too many files", $back) if (@files > 1);
  5798.         bail_out("Please select a file", $back) if (@files == 0);
  5799.         bail_out("Script list is empty",$back) unless ($files[0]);
  5800.         $selectedscript                = $files[0];
  5801.         $SQL                        = &$readscript($selectedscript);
  5802.     }
  5803.     else {
  5804.         $SQL = $q->param('SQL');
  5805.     }
  5806.     $SQL =~ s/^\s*(.*)$/$1/m;
  5807.     $SQL =~ s/^(.*?)\s*$/$1/s;
  5808.     my $SQL_ = quoteit($SQL);
  5809.     $back->{SQL} = $SQL;
  5810. #    if ($errmsg){bail_out("$errmsg iiiii", $back)}
  5811.     
  5812.     
  5813.  
  5814.     my $printSaveAs = sub {
  5815.         my $file = quoteit($_[0]);
  5816.         my $var = qq!\n<FORM METHOD=POST ACTION="$full_url">\n!;
  5817.         $var .= qq!<BR><P><INPUT TYPE=SUBMIT NAME="script" VALUE="SAVE AS"> \n!;
  5818.         $var .= qq!<INPUT TYPE=TEXT NAME="saveasname" SIZE=40 VALUE="$file"><P>\n!;
  5819.         $var .= qq!<INPUT TYPE=SUBMIT NAME="script" VALUE=" CANCEL">\n!;
  5820.         $var .= qq!<INPUT TYPE=HIDDEN NAME="overwrite" VALUE="1">\n!    if ($_[1] eq '1');    
  5821.         $var .= qq!<INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">\n!;
  5822.         $var .= qq!<INPUT TYPE=HIDDEN NAME="page" VALUE="tables">\n!;
  5823.         $var .= qq!<INPUT TYPE=HIDDEN NAME="func" VALUE="script">\n!;
  5824.         if ($SQL){$var .= qq!<INPUT TYPE=HIDDEN NAME="SQL" VALUE="$SQL_">\n! ;}
  5825.         $var .= qq!<INPUT TYPE=HIDDEN NAME="selectedscript" VALUE="!.quoteit($selectedscript).qq!">\n! if $selectedscript;
  5826.         $var .= qq!</FORM>!;
  5827.     };
  5828.     if ($script eq 'Rename'){
  5829.         bail_out("Too many files", $back) if (@files > 1);
  5830.         bail_out("Please select a file", $back) if (@files == 0);
  5831.         bail_out("Script list is empty",$back) unless ($files[0]);
  5832.         my $newname = $q->param('rename');
  5833.         $newname =~ s/^\s*(.*)$/$1/m;
  5834.         $newname =~ s/^(.*?)\s*$/$1/s;
  5835.         unless ($newname){bail_out("Please enter a name", $back)}
  5836.         checkfilename($newname, $back);
  5837.         rename "$userdir$delim$files[0]", "$userdir$delim$newname" or bail_out("Cannot rename $files[0].\n$!", $back);
  5838.         if ($files[0] eq $selectedscript){$selectedscript = $newname}
  5839.     }
  5840.     if ($script eq 'Save'){
  5841.         unless ($selectedscript) {
  5842.             print &$printSaveAs();
  5843.             return;
  5844.         }
  5845.         my $size = dirsize($userdir);
  5846.         $size += length $SQL; 
  5847.         $size -= -s "$userdir$delim$selectedscript";
  5848.         if ($MAX_SCRIPT_SIZE and ($size > ($MAX_SCRIPT_SIZE*1024))) {
  5849.             my $errmsg = "Total size of user scripts is limited to $MAX_SCRIPT_SIZE kb.\n";
  5850.             $errmsg .= "Please delete some files or contact us ($CONTACT_EMAIL) if you need more disk space.\n";            
  5851.             bail_out("$errmsg",$back);
  5852.         }
  5853.         open (FH, ">$userdir$delim$selectedscript") || bail_out ("Can not open file $selectedscript\n$!", $back);
  5854.         flock(FH, 2) unless $WIN32;
  5855.         print FH $SQL;
  5856.         flock(FH, 8) unless $WIN32;
  5857.         close FH;
  5858.     }
  5859.     elsif ($script    =~ /Save as/i ){
  5860.         my $size = dirsize($userdir);
  5861.         $size += length $SQL; 
  5862.         if ($MAX_SCRIPT_SIZE and ($size > ($MAX_SCRIPT_SIZE*1024))) {
  5863.             my $errmsg = "Total size of user scripts is limited to $MAX_SCRIPT_SIZE kb.\n";
  5864.             $errmsg .= "Please delete some files or contact us ($CONTACT_EMAIL) if you need more disk space.\n";            
  5865.             bail_out("$errmsg",$back);
  5866.         }
  5867.         my $filename    = $q->param('saveasname');
  5868.         checkfilename($filename, $back);
  5869.         my $file             = "$userdir$delim$filename";
  5870.         $filename        =~ s/^\s*(.*)/$1/;
  5871.         $filename        =~ s/^(.*)\s*$/$1/;
  5872.         unless ($filename) {
  5873.             print "<BR><B>PLEASE SELECT FILE NAME</B><P>";
  5874.             print &$printSaveAs();
  5875.             return;
  5876.         }
  5877.         elsif ((-e $file) and !$q->param('overwrite')){
  5878.             print "<BR><B>THIS FILE NAME ALREADY EXISTS</B><P>";
  5879.             print "<B>CLICK <U>'SAVE AS'</U> TO OVERWRITE</B><P>";
  5880.             print &$printSaveAs($filename,'1');
  5881.             return;
  5882.         }
  5883.         else{
  5884.             open (FH, ">$file") || bail_out ("Can not open file $filename\n$!", $back);
  5885.             flock(FH, 2) unless $WIN32;
  5886.             print FH $SQL;
  5887.             flock(FH, 8) unless $WIN32;
  5888.             close FH;
  5889.         }
  5890.         $selectedscript        = quoteit($q->param('saveasname')) if (-e "$file");
  5891.     }
  5892.     elsif ($script    =~ /close/i ){$selectedscript = ''; $SQL = $SQL_ = ''}
  5893.     elsif ($script    =~ /Back/i ){loadSelectTables(); return}
  5894.     elsif ($script    =~ /delete/i){
  5895.         unless($q->param('cancel')){
  5896.             if ($q->param('confirm')){
  5897.                 my @filedelete = $q->param('filedelete');
  5898.                 my @couldnot;
  5899.                 foreach (@filedelete){
  5900.                     my $filedelete = $userdir.$delim.$_;
  5901.                     unless (unlink $filedelete) {push @couldnot, $_}
  5902.                 }
  5903.                 if (belongs(\@filedelete, $selectedscript) and ! belongs(\@couldnot, $selectedscript)){
  5904.                     $selectedscript        = '';
  5905.                 }
  5906.                 if (@couldnot) {my $files = join (@couldnot, "\n"); bail_out("Can not delete files: $files\n $!", $back)}
  5907.             }
  5908.             else {
  5909.                  bail_out("Please select a file", $back) if (@files == 0);
  5910.                 bail_out("Script list is empty",$back) unless ($files[0]);
  5911.                 print qq!\n<FORM METHOD=POST ACTION="$full_url">\n!;
  5912.                 print "<BR><P><B>THESE FILES WILL BE DELETED:</B><P>\n";
  5913.                 foreach (@files){
  5914.                     s/^(.*[\/|\\])*(.*)/$2/;
  5915.                     $_ = quoteit($_);
  5916.                     print "<INPUT TYPE=CHECKBOX NAME=\"filedelete\" VALUE=\"$_\" CHECKED> $_ <BR>\n";
  5917.                 }
  5918.                 print qq!<BR>!;
  5919.                 print qq!<INPUT TYPE=SUBMIT NAME="confirm" VALUE="DELETE"> \n!;
  5920.                 print qq!<INPUT TYPE=SUBMIT NAME="cancel" VALUE="CANCEL">\n!;
  5921.                 print qq!<INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">\n!;
  5922.                 print qq!<INPUT TYPE=HIDDEN NAME="script" VALUE="delete">\n!;
  5923.                 print qq!<INPUT TYPE=HIDDEN NAME="page" VALUE="tables">\n!;
  5924.                 print qq!<INPUT TYPE=HIDDEN NAME="SQL" VALUE="$SQL_">\n!;
  5925.                 print qq!<INPUT TYPE=HIDDEN NAME="func" VALUE="script">\n!;
  5926.                 print qq!<INPUT TYPE=HIDDEN NAME="selectedscript" VALUE="!.quoteit($selectedscript).qq!">\n!;
  5927.                 print qq!</FORM>!;
  5928.                 return
  5929.             }
  5930.         }
  5931.     }
  5932.  
  5933.     if ($errmsg){$selectscript = qq!\t<OPTION VALUE="">CANNOT CREATE DIRECTORY\n\t<OPTION VALUE="">$errmsg\n!;}
  5934.     my ($tsize, @filelist);
  5935.     unless ($errmsg){
  5936.         opendir DIR, $userdir;
  5937.         my @filenames    = readdir (DIR) or print "Cannot read this directory: $userdir<br>";
  5938.         closedir DIR;
  5939.         foreach (@filenames){
  5940.             next if (($_ eq '.') or ($_ eq '..'));
  5941.             my $file  = "$userdir$delim$_";
  5942.             my @stat = stat $file;
  5943.             unless (-d _){
  5944.                 my $size = $stat[7];
  5945.                 $tsize += $size;
  5946.                 s/^(.*\/)*(.*)$/$2/;
  5947.                 $_ = quoteit($_);
  5948. #                $selectscript .= qq!\t<OPTION VALUE="$_">$_ \/$size\/ $date\n!;
  5949.                 push @filelist, [$_, $size, $stat[9]];
  5950.             }
  5951.         }
  5952.     }
  5953.  
  5954.     my $sort_ = $q->param('sort');
  5955.     my @orderedfiles;
  5956.     if ($sort_ eq 'name'){                      
  5957.         @orderedfiles    = sort {
  5958.                 uc $a->[0] cmp uc $b->[0]    # sort by names
  5959.                         ||
  5960.                 uc $a->[2] <=> uc $b->[2]    # then by date
  5961.             } @filelist;
  5962.     }
  5963.     elsif ($sort_ eq 'size') {                     
  5964.         @orderedfiles    = sort {
  5965.                 uc $a->[1] <=> uc $b->[1]    # sort by size
  5966.                         ||
  5967.                 uc $a->[0] cmp uc $b->[0]    #then by name
  5968.             } @filelist;
  5969.     }
  5970.     elsif($sort_ eq 'date')
  5971.      {
  5972.         @orderedfiles    = sort {
  5973.                 $a->[2] <=> $b->[2] #sort by date
  5974.                         ||
  5975.                 uc $a->[0] cmp uc $b->[0]      # then by name
  5976.             } @filelist ;
  5977.     }
  5978.     else {@orderedfiles = @filelist}
  5979. #    if ($order){@orderedfiles = reverse @orderedfiles}
  5980.  
  5981.     foreach my $element (@orderedfiles){
  5982.         my $date = scalar localtime ($element->[2]);
  5983.         $date =~ s/^\s*\w\w\w\s*(.*)/$1/;
  5984.  
  5985.         $selectscript .= qq!\t<OPTION VALUE="$element->[0]">$element->[0] : $element->[1] : $date\n!;
  5986.     }
  5987.     my $ch_name = 'CHECKED' if $sort_ eq 'name';
  5988.     my $ch_size = 'CHECKED' if $sort_ eq 'size';
  5989.     my $ch_date = 'CHECKED' if $sort_ eq 'date';
  5990.     
  5991.     my $sortby = <<EOT
  5992.     <TR>
  5993.         <TD><INPUT TYPE=SUBMIT NAME="script" VALUE="Sort by" style="width: 70px;" TITLE="SORT FILES BY NAME, SIZE OR DATE"></TD>
  5994.         <TD><NOBR> Name<INPUT TYPE=RADIO NAME="sort" VALUE="name" $ch_name> Size<INPUT TYPE=RADIO NAME="sort" VALUE="size" $ch_size> Date<INPUT TYPE=RADIO NAME="sort" VALUE="date" $ch_date></NOBR></TD>
  5995.     </TR>
  5996. EOT
  5997. ;
  5998.  
  5999.     unless ($selectscript){$selectscript = qq!\t<OPTION VALUE="">Script list is empty\n!}
  6000.     $selectscript = qq!<SELECT NAME="selectscript" MULTIPLE SIZE=12 TITLE="Select a script">\n!.$selectscript;
  6001.     $selectscript .= "</SELECT>\n";
  6002.     $tsize = int($tsize / 1024 * 100) / 100;
  6003.     
  6004.     my $selectedscriptname        = "LOADED SCRIPT: <B><U>". quoteit($selectedscript) ."</U></B>" if $selectedscript;
  6005.     my $closebutton                = qq!<INPUT TYPE=SUBMIT NAME="script" VALUE=" Close " style="width: 60px" TITLE="Close the script "$selectedscript"">! if $selectedscript;
  6006.  
  6007.     my $abort = $q->checkbox(    -name=>'abortsql', -label=>'',  -title=>"Check to abort execution if error occurs. (For multiple queries)");
  6008.     
  6009.     my ($textareasize, $saveassize) = $agent ?
  6010.         (50, 12) :
  6011.         (80, 34) ;
  6012.     my $buttonwidth     = '123px';
  6013.     my $buttonwidth2    = $buttonwidth * 2;
  6014.     
  6015.     
  6016.     my $renamesize = $agent ? 19 : 29;
  6017.     print <<EOT
  6018. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH=285>
  6019. <FORM METHOD=POST ACTION="$full_url">
  6020. <INPUT TYPE=HIDDEN NAME=page VALUE=tables>
  6021. <INPUT TYPE=HIDDEN NAME=func VALUE=scripts>
  6022. <INPUT TYPE=HIDDEN NAME=dbname VALUE=$database>
  6023. <INPUT TYPE=HIDDEN NAME="selectedscript" VALUE="$selectedscript">
  6024.  
  6025.     <TR>
  6026.         <TH ALIGN=LEFT COLSPAN=2 ><p>SQL SCRIPTS<p></TH>
  6027.     </TR>
  6028.     <TR>
  6029.         <TD VALIGN=TOP>
  6030.         <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH=285>            
  6031.                 <TR>
  6032.                     <TD>
  6033. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>            
  6034.     <TR>
  6035.         <TD><INPUT TYPE=SUBMIT NAME="script" VALUE="Rename" style="width: 70px" TITLE="RENAME SELECTED FILE"></TD><TD><INPUT TYPE=TEXT SIZE="$renamesize" NAME="rename" VALUE=""></td>
  6036.     </TR>
  6037. $sortby
  6038. </TABLE>
  6039. $selectscript
  6040.                      </TD>
  6041.                 </TR>
  6042.             </TABLE>
  6043.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  6044.                 <TR>
  6045.                     <TD VALIGN=BOTTOM><INPUT TYPE=SUBMIT NAME="script" VALUE=" Edit " style="width: 60px" TITLE="Load selected script to view and edit"></TD>
  6046.                     <TD VALIGN=BOTTOM><INPUT TYPE=SUBMIT NAME="script" VALUE="  Open " style="width: 60px" TITLE="Execute selected script"></TD>
  6047.                     <TD VALIGN=BOTTOM>$closebutton</TD>
  6048.                     <TD VALIGN=BOTTOM><INPUT TYPE=SUBMIT NAME="script" VALUE=" Delete " style="width: 60px; color=#CC0000" TITLE="DELETE SELECTED SCRIPT"></TD>
  6049.                 </TR>
  6050.                 
  6051.             </TABLE><p>$selectedscriptname
  6052.         </TD>
  6053.         <TD VALIGN=TOP><p>
  6054. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%">    
  6055.     <TR>            
  6056.         <TD>
  6057.         <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  6058.             <TR>
  6059.                 <TD><TEXTAREA WRAP=PHYSICAL NAME="SQL" ROWS=15 COLS=$textareasize TITLE="SQL script editor">$SQL_</TEXTAREA></TD>
  6060.             </TR>
  6061.             <TR>
  6062.                 <TD><P>
  6063.                     <TABLE BORDER=0  CELLPADDING=0 CELLSPACING=0>
  6064.                         <TR>
  6065.                             <TD><P><INPUT TYPE=SUBMIT VALUE="     Back     " style="width: 100px" NAME=script TITLE="Go back to previous page"></TD>
  6066.                             <TD><P><INPUT TYPE=RESET VALUE="   Reset   " style="width: 100px" TITLE="Reset form"></TD>
  6067.                             <TD><P><INPUT TYPE=SUBMIT NAME="script" VALUE="Execute Query" style="width: 100px" TITLE="Execute SQL script"></TD>
  6068.                             <TD TITLE="Check to abort execution if error occurs. (For multiple queries)"><P>$abort Abort on error</TD>
  6069.                         </TR>
  6070.                     </TABLE></TD>
  6071.             </TR>
  6072.         </TABLE></TD>
  6073.     </TR>                
  6074.     <TR>
  6075.         <TD HEIGHT=2></TD>
  6076.     </TR>
  6077.     <TR>            
  6078.         <TD><P>
  6079.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  6080.                 <TR VALIGN=BOTTOM>
  6081.                     <TD VALIGN=BOTTOM><INPUT TYPE=SUBMIT NAME="script" VALUE="Save" style="width: 100px" TITLE="Save SQL script "$selectedscript""></TD>
  6082.                     <TD VALIGN=BOTTOM><INPUT TYPE=SUBMIT NAME="script" VALUE="Save as" style="width: 100px" TITLE="Save SQL script as ..."></TD>
  6083.                     <TD VALIGN=BOTTOM> <INPUT TYPE=TEXT NAME="saveasname" SIZE=30 TITLE="Type name to save as"></TD>
  6084.                     <TD> </TD>
  6085.                 </TR>
  6086.             </TABLE>
  6087.             </TD>
  6088.         </TR>
  6089.     </TABLE>
  6090. </TD></TR></form></TABLE>
  6091.  
  6092. EOT
  6093. ;
  6094.  
  6095.     if ($q->param('script') =~ /(Open)|(execute)/i){
  6096.         print "\n<hr size=1>\n";
  6097.         execExecuteQuery($back)
  6098.     }
  6099. }
  6100.  
  6101. sub execSearch {
  6102.     my ($table)        = $q->param('tables');
  6103.     my $back =           {
  6104.        page =>            'tables',
  6105.        dbname =>        "$database",
  6106.        tables =>        "$table",
  6107.        func =>            "search"     
  6108.     };
  6109. #        $back->{func}    = "return";
  6110. #        $back->{page}     = "searchresult";
  6111. #        $back->{order}    = "$order";
  6112. #        $back->{where}    = "$where";
  6113. #        $back->{fields}    = \@fields;
  6114. #        $back->{start}    = "$start";
  6115. #        $back->{rows}    = "$rows";
  6116.     my $query         = "SELECT * FROM $table WHERE 1=0";
  6117.     my ($sth,$res)    = prepare_execute($query, {page => 'select_db', dbname => "$database"});
  6118.     my @names         = @{$sth->{NAME}};
  6119.     my $null         = $sth->{NULLABLE};
  6120.     $sth->finish;
  6121.     my @fields        = $q->param('fields');
  6122.     my @where;
  6123.     my @unquote        = $q->param('unquote');
  6124.     my $j             = 0;
  6125.     sub regescape {
  6126.         $_ = shift;
  6127.         s{(.)}{
  6128.                 if ($1 eq '\\')            { '\\\\\\\\' }
  6129.                 elsif ($1 eq '%')        { '\%' }
  6130.                 elsif ($1 eq "'")        { "\\'" }
  6131.                 elsif ($1 eq '^')        { '\^' }
  6132.                 elsif ($1 eq '$')        { '\$' }
  6133.                 elsif ($1 eq '.')        { '\.' }
  6134.                 elsif ($1 eq '[')        { '\[' }
  6135.                 elsif ($1 eq ']')        { '\]' }
  6136.                 elsif ($1 eq '*')        { '\*' }
  6137.                 elsif ($1 eq '+')        { '\+' }
  6138.                 elsif ($1 eq '?')        { '\?' }
  6139.                 elsif ($1 eq '|')        { '\|' }
  6140.                 elsif ($1 eq '{')        { '\{' }
  6141.                 elsif ($1 eq '}')        { '\}' }
  6142.                 elsif ($1 eq ')')        { '\)' }
  6143.                 elsif ($1 eq '(')        { '\(' }
  6144.                 else                    { $1   }
  6145.             }gsex;
  6146.         return $_;
  6147.     }
  6148.     for(my $i=0; $i<@names; $i++){
  6149.         my $data     = $q->param("$names[$i]\_data");
  6150.         my $oper     = $q->param("operator\_$names[$i]");
  6151.         next if (($data eq '') and !$oper);
  6152.         my $not     = ' NOT'     if $q->param("not\_$names[$i]");
  6153.         my $case     = ' BINARY' if $q->param("case\_$names[$i]");
  6154.         my $unquote;
  6155.         my $likexpr = sub {
  6156.             if (belongsb(\@unquote,$names[$i])){
  6157.                 $unquote = 1;
  6158.                 return ['REGEXP', $case, '', $data, '', '']
  6159.             }
  6160.             else {
  6161.                 $case = '' unless check_version('3.23.4');
  6162.                 return ['LIKE', $case, "'%", regescape($data), "%'", "'"]
  6163.             }
  6164.         } ;#if (!$oper or ($oper eq 'AND') or ($oper eq 'OR'));
  6165.         if (!$oper) {
  6166.             my $expr    = &$likexpr;
  6167.             $where[$j]    = "$names[$i]$not $expr->[0]$expr->[1] $expr->[2]$expr->[3]$expr->[4]";
  6168.         }
  6169.         elsif ($oper eq 'start') {
  6170.             my $expr    = &$likexpr;
  6171.             my @data    = split ',', $expr->[3];
  6172.             my @where_;
  6173.             for(my $k=0; $k<@data; $k++){
  6174.                 $data[$k] =~ s/^\s*(.*)\s*$/$1/;
  6175.                 push @where_, "$names[$i]$not $expr->[0]$expr->[1] $expr->[5]$data[$k]$expr->[4]"; 
  6176.             }
  6177.             $where[$j]    = join " OR \n", @where_;
  6178.         }
  6179.         elsif ($oper eq 'end') {
  6180.             my $expr    = &$likexpr;
  6181.             my @data    = split ',', $expr->[3];
  6182.             my @where_;
  6183.             for(my $k=0; $k<@data; $k++){
  6184.                 $data[$k] =~ s/^\s*(.*)\s*$/$1/;
  6185.                 push @where_, "$names[$i]$not $expr->[0]$expr->[1] $expr->[2]$data[$k]$expr->[5]"; 
  6186.             }
  6187.             $where[$j]    = join " OR \n", @where_;
  6188.         }
  6189.         elsif (($oper eq 'AND') or ($oper eq 'OR')){
  6190.             my $expr    = &$likexpr;
  6191.             my @data    = split ',', $expr->[3];
  6192.             my @where_;
  6193.             for(my $k=0; $k<@data; $k++){
  6194.                 $data[$k] =~ s/^\s*(.*)\s*$/$1/;
  6195.                 push @where_, "$names[$i]$not $expr->[0]$expr->[1] $expr->[2]$data[$k]$expr->[4]"; 
  6196.             }
  6197.             $where[$j]    = join " $oper \n", @where_;
  6198.         }
  6199.         elsif ($oper eq '>'){
  6200.             $oper         = '<=' if $not;
  6201.             $data        = "'". regescape($data) ."'" unless (DBI::looks_like_number($data) or $unquote);
  6202.             $where[$j]    = "$case $names[$i] $oper $data ";
  6203.             
  6204.         }
  6205.         elsif ($oper eq '>='){
  6206.             $oper         = '<' if $not;
  6207.             if (($data eq '') and $null->[$i] and !$not) {$where[$j] = " OR $names[$i] IS NULL"}
  6208.             $data        = "'". regescape($data) ."'" unless (DBI::looks_like_number($data) or $unquote);
  6209.             $where[$j]    = "$case $names[$i] $oper $data $where[$j] ";
  6210.         }
  6211.         elsif ($oper eq '<'){
  6212.             $oper        = '>=' if $not;
  6213.             if (($data eq '') and $null->[$i] and $not) {$where[$j] = " OR $names[$i] IS NULL"}
  6214.             $data        = "'". regescape($data) ."'" unless (DBI::looks_like_number($data) or $unquote);
  6215.             $where[$j]    = "$case $names[$i] $oper $data $where[$j] ";
  6216.         }
  6217.         elsif ($oper eq '<='){
  6218.             $oper        = '>' if $not;
  6219.             $data        = "'". regescape($data) ."'" unless (DBI::looks_like_number($data) or $unquote);
  6220.             $where[$j]    = "$case $names[$i] $oper $data ";
  6221.         }
  6222.         elsif ($oper eq '='){
  6223.             $oper        = '<>' if $not;
  6224.             if (($data eq '') and $null->[$i] and !$not) {$where[$j] = " OR $names[$i] IS NULL"}
  6225.             $data        = "'". regescape($data) ."'" unless (DBI::looks_like_number($data) or $unquote);
  6226.             $where[$j]    = "$case $names[$i] $oper $data $where[$j] ";
  6227.         }
  6228.         elsif ($oper eq 'BETWEEN'){
  6229.             my @data    = split ',', $data;
  6230.             bail_out("\"BETWEEN\" option requires TWO arguments to be comma separated.",$back) 
  6231.                 if ((@data > 2) or (@data < 2));
  6232.             for(my $k=0; $k<2; $k++){
  6233.                 $data[$k]    =~ s/^\s*(\S*)\s*$/$1/g;
  6234.                 $data[$k]    = "'". regescape($data[$k]) ."'" unless (DBI::looks_like_number($data[$k]) or $unquote);
  6235.             }
  6236.             $where[$j] = "$case $names[$i]$not BETWEEN $data[0] AND $data[1]";
  6237.         }
  6238.         elsif ($oper eq 'IN'){
  6239.             my $expr     = &$likexpr;
  6240.             my @data    = split ',', $expr->[3];
  6241.             
  6242.             for(my $k=0; $k<@data; $k++){
  6243.                 $data[$k]    =~ s/^\s*(\S*)\s*$/$1/g;
  6244.                 $data[$k]    = "$expr->[5]$data[$k]$expr->[5]";
  6245.             }
  6246.             $where[$j]        = join ' ,',@data;
  6247.             $where[$j]        = "$case $names[$i]$not IN ($where[$j])";
  6248.          
  6249.         }
  6250.         elsif ($oper eq 'REGEXP'){
  6251.             my $expr        = &$likexpr;
  6252.             $where[$j]        = "$case $names[$i]$not REGEXP $expr->[5]$expr->[3]$expr->[5]";
  6253.         }
  6254.         elsif ($oper eq 'LIKE') {
  6255.             my $expr         = &$likexpr;
  6256.             $where[$j]         = "$names[$i]$not $oper$expr->[1] $expr->[5]$expr->[3]$expr->[5]";
  6257.         }
  6258.         elsif ($oper eq 'NULL'){
  6259.             $where[$j]         = "$names[$i] IS $not NULL";
  6260.         }
  6261.         elsif ($oper eq 'FUNCTION'){
  6262.             $where[$j]         = "$names[$i] $data";
  6263.         }
  6264.         $where[$j]    = "($where[$j])";
  6265.         $j++;
  6266.     } 
  6267.     my $andor            = $q->param('andor');
  6268.     my $where             = join " $andor ", @where;
  6269.     $where                 = "WHERE $where" if $where;
  6270.     my $sort             = $q->param('sort');
  6271.     my $sortorder         = $q->param('sortorder');
  6272.     my $order             = "ORDER BY $sort $sortorder" if $sort;
  6273.     searchresult($where, $order);
  6274.  
  6275. return;
  6276. }
  6277.  
  6278. sub searchresult {
  6279. #input:
  6280. # $_[0] - where
  6281. # $_[1] - order
  6282.  
  6283.     my $where         = defined $_[0] ? $_[0] : $q->param('where');
  6284.     my $order         = defined $_[1] ? $_[1] : $q->param('order');
  6285.     my ($table)        = $q->param('tables');
  6286.     my $start         = $q->param('start');
  6287.     my $rows         = $q->param('rows');
  6288.     my $func         = $q->param('func');
  6289.     my @fields        = $q->param('fields');
  6290.     my $selectfrom    = "SELECT ". join (', ', @fields). " FROM $table";
  6291.     my $query_         = "$selectfrom $where $order";
  6292.     my $deletepreview = '1' if (($func =~ /delete/i) and !$q->param('back') and !$q->param('confirm'));
  6293.     my $hidden        = $q->hidden(-name=>'fields', -value=>\@fields, -override=>1);
  6294.     my $back =     {
  6295.         tables         => "$table",
  6296.         dbname         => "$database"
  6297.     };
  6298.  
  6299.     if ($page eq 'search'){
  6300.         $back->{func}    = "search";
  6301.         $back->{page}     = "tables";
  6302.     }
  6303.     else {
  6304.         $back->{func}    = "return";
  6305.         $back->{page}     = "searchresult";
  6306.         $back->{order}    = "$order";
  6307.         $back->{where}    = "$where";
  6308.         $back->{fields}    = \@fields;
  6309.         $back->{start}    = "$start";
  6310.         $back->{rows}    = "$rows";
  6311.     }
  6312.     unless ($start =~ /^\s*\d*\s*$/){bail_out("Please check the 'Start' row number",$back)}
  6313.     unless ($rows =~ /^\s*\d*\s*$/){bail_out("Please check the number of 'hits' to be displayed",$back)}
  6314.     if    ($q->param('confirm') and ($func =~ /delete/i)){
  6315.         my $query = $q->param('deletequery');
  6316.         bail_out("Cannot delete records", $back) unless $dbh->do($query);
  6317.     }
  6318.  
  6319.     my $count        = count_rows("$table $where", $back);
  6320.     if (($func         =~ /next/i) and (($start + $rows)<$count)) {$start = ($start + $rows)}
  6321.     elsif (($func     =~ /prev/i) and ($start > $rows)) {$start = ($start - $rows)}
  6322.     elsif (($func    =~ /prev/i) and ($start <= $rows)) {$start = '0'}
  6323.     my $deletequery;
  6324.     my $limit;
  6325.     my ($controlbar, $title, $confirmation, $conftitle, $printpage, $pr_res_up, $pr_res_down);
  6326.     if ($deletepreview) {
  6327.         bail_out("Please select rows to delete!", $back) unless defined $q->param('SelectRow');
  6328.         my $query         = "SELECT *  FROM $table $where $order";
  6329.  
  6330.         my $calldelete = {
  6331.             count => "$count", table => "$table", start => "$start", rows => "$rows", query => "$query", back => $back
  6332.         };
  6333.         $deletequery         = "DELETE ".$q->param('delete_option1')." FROM  $table ";
  6334.         my $deletewhere     = getwhere($calldelete);
  6335.         if ($where and !$deletewhere){bail_out("Selected records where not found", $back)}
  6336.         $deletewhere         = "WHERE $deletewhere" if $deletewhere;
  6337.         $deletequery         .= $deletewhere;
  6338.         $query_                 = "$selectfrom $deletewhere $order";
  6339.         $deletequery         = quoteit($deletequery);
  6340.         $hidden .= qq!\n<INPUT TYPE=HIDDEN NAME="func" VALUE="DELETE">\n!;
  6341.         $hidden .= qq!\n<INPUT TYPE=HIDDEN NAME="deletequery" VALUE="$deletequery">\n!;
  6342.         $title = 'DELETE RECORDS';
  6343.         $confirmation = "Selected records will be deleted:";
  6344.         $controlbar = <<EOT
  6345.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  6346.                 <TR>
  6347.                     <TD><INPUT TYPE=SUBMIT NAME="confirm" VALUE=" CONFIRM " style="color=#CC0000" TITLE="Confirm deletion"></TD>
  6348.                     <TD><INPUT TYPE=SUBMIT NAME="back" VALUE="  BACK  " TITLE="Cancel and return back"></TD>
  6349.                 </TR>
  6350.                 <TR>
  6351.                     <TD COLSPAN=2 HEIGHT=6></TD>
  6352.                 </TR>
  6353.             </TABLE>        
  6354. EOT
  6355. ;
  6356.  
  6357.         
  6358.     }
  6359.     elsif ($q->param('printpage') ne 'full'){
  6360.         if ($start and ($rows ne ''))    {$limit = "LIMIT $start, $rows"}
  6361.         elsif ($start and ($rows eq '')){$rows = $count - $start; $limit = "LIMIT $start, $rows"}
  6362.         elsif (!$start and $rows ne '') {$limit    = "LIMIT $rows"}
  6363.         else {$rows = $count - $start}
  6364.         $query_             .= " $limit";    
  6365.     }
  6366.     $query                     = quoteit($query_);
  6367.     my ($sth,$res)             =     prepare_execute($query_, $back);
  6368.     if ($print) {print &printresult(\$sth, 0, 1);return}
  6369.     my ($sth_, $res_)          = prepare_execute("SELECT * FROM $table WHERE 1=0", $back);
  6370.     my $pri_                   = get_mysql_pri($sth_);
  6371.     my $offset                 = ($start + 0);
  6372.     my $i                     = 0;
  6373.     my $array;
  6374.     $array->[0][0]             = qq!<TD BGCOLOR="#CCCCCC">No</TH>!;
  6375.     $array->[0][1]            = qq!<TD BGCOLOR="#CCCCCC">Select</TD>! unless ($deletepreview);
  6376.     my $pri                 = get_mysql_pri($sth);
  6377.     unless (defined $pri){$pri = []}
  6378.     my $bgcolorH            = $print ? '#FFFFFF' : '#EEEEEE';
  6379.     my $bgcolor                = $print ? '#FFFFFF' : '#EEEEEE';
  6380.     my $pricolor             = $print ? '#000000' : '#ff0000';
  6381.     foreach (my $i = 0; $i < $sth->{NUM_OF_FIELDS}; $i++) {
  6382.         my $color = '#000000';
  6383.         if ($pri->[$i]){
  6384.             $array->[0][$i+2] = qq!<TH BGCOLOR="$bgcolorH"><FONT COLOR="$pricolor">$sth->{NAME}->[$i]</TH>!;
  6385.         }
  6386.         else {
  6387.             $array->[0][$i+2] = qq!<TH BGCOLOR="$bgcolor"><FONT COLOR="#000000">$sth->{NAME}->[$i]</TH>!;
  6388.         }
  6389.     }
  6390.     my $j=1;
  6391.     my @offset = $deletepreview ? $q->param('SelectRow') : ($start..($start+$rows));
  6392.     while (@ary = $sth->fetchrow_array)    {
  6393.         @ary     = quoteit(@ary);
  6394.         $offset = $offset[$j-1];
  6395.         unless ($print) {
  6396.             $array->[$j][0] = qq!<TD BGCOLOR="#CCCCCC">$offset</TD>!;
  6397.             $array->[$j][1] = qq!<TD BGCOLOR="#CCCCCC"><INPUT TYPE=CHECKBOX NAME="SelectRow" VALUE="$offset" TITLE="Select record"></TD>! unless
  6398.                     ($deletepreview);
  6399.         }
  6400.         for (my $i = 0; $i < @ary; $i++){
  6401.             $ary[$i] =~ s/(\r\n)|\n/<BR>/mg;
  6402.             $ary[$i] = ' ' if ($ary[$i] eq '' or !defined $ary[$i]);
  6403.             $array->[$j][$i+2]= qq!<TD BGCOLOR="$bgcolor">$ary[$i]</TD>!;
  6404.         }
  6405.         $j++;
  6406.         $offset++;
  6407.     }
  6408.     $where = quoteit($where);
  6409.  
  6410.     unless ($deletepreview){
  6411.         my $prev     = qq!<INPUT TYPE=SUBMIT NAME="func" VALUE="<<Prev" TITLE="Show previous hits">! if ($start > 0);
  6412.         my $next     = qq!<INPUT TYPE=SUBMIT NAME="func" VALUE="Next>>" TITLE="Show next hits">! if ((($start + $rows) < $count) and $rows);
  6413.         if ($prev or $next){
  6414.             $printpage = qq!Full result <INPUT TYPE=RADIO NAME="printpage" VALUE="full" TITLE="Print all found hits"> Current Page <INPUT TYPE=RADIO NAME="printpage" VALUE="this" CHECKED TITLE="Print only shown hits">!;
  6415.         }
  6416.         $title = 'SEARCH RESULT';
  6417.         $confirmation = "Records found: $count";
  6418.         $conftitle    =  qq!TITLE="Totally $count hits were found with given search criteria"!;
  6419.         $controlbar = <<EndOfControlbar
  6420.             <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH=650>
  6421.                 <TR>
  6422.                     <TD WIDTH=120>
  6423.                     <TABLE CELLPADDING=0 CELLSPACING=0 WIDTH=120 BORDER=0>
  6424.                         <TR>
  6425.                             <TD>
  6426.                                 <TABLE CELLPADDING=0 CELLSPACING=0 WIDTH=60 BORDER=0>
  6427.                                     <TR>
  6428.                                         <TD WIDTH=60>$prev</TD>
  6429.                                     </TR>
  6430.                                 </TABLE>
  6431.                             </TD>
  6432.                             <TD WIDTH=60>
  6433.                                 <TABLE CELLPADDING=0 CELLSPACING=0 WIDTH=60 BORDER=0>
  6434.                                     <TR>
  6435.                                         <TD WIDTH=60>$next</TD>
  6436.                                     </TR>
  6437.                                 </TABLE>
  6438.                             </TD>
  6439.                         </TR>
  6440.                     </TABLE>
  6441.                     </TD>
  6442.                     <TD WIDTH=20> </TD>
  6443.                     <TD>
  6444.                         <TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0>
  6445.                             <TR>
  6446.                                 <TD WIDTH=68><INPUT TYPE=SUBMIT NAME="func" VALUE="  BACK  " TITLE="Go back to select search criteria"></TD>
  6447.                                 <TD WIDTH=120 ALIGN=LEFT><INPUT TYPE=SUBMIT NAME="func" VALUE="EDIT RECORD " TITLE="Edit selected records"></TD>
  6448.                                 <TD WIDTH=120 ALIGN=LEFT><INPUT TYPE=SUBMIT NAME="func" VALUE=" NEW RECORD " TITLE="Insert new records"></TD>
  6449.                                 <TD WIDTH=118 ALIGN=LEFT><INPUT TYPE=SUBMIT NAME="func" VALUE="DELETE RECORD" TITLE="Delete selected records"></TD>
  6450.                             </TR>
  6451.                         </TABLE>
  6452.                     </TD>
  6453.                 </TR>
  6454.                 <TR>
  6455.                     <TD COLSPAN=3 HEIGHT=6></TD>
  6456.                 </TR>
  6457.             </TABLE>        
  6458.  
  6459. EndOfControlbar
  6460. ;
  6461.     my $titlesize = $agent ? 15 : 20;
  6462.     $pr_res_up = <<EOPR
  6463. <INPUT TYPE=SUBMIT NAME="print" VALUE="Print result" TITLE="Generate printer friendly report"></TD>
  6464.         <TD><nobr>$printpage</nobr></TD>
  6465.         <TD> </TD>
  6466.         <TD>Title: <INPUT TYPE=TEXT SIZE=$titlesize NAME="title" TITLE="Type page title to place on printout">
  6467. EOPR
  6468. ;
  6469. $pr_res_down = <<EOT
  6470. Height:</TD>
  6471.         <TD><nobr>Rows: <SELECT NAME="rowheight" TITLE="Select height of table rows for printout">
  6472.         <OPTION VALUE="" SELECTED>min
  6473.         <OPTION VALUE="HEIGHT=20">20
  6474.         <OPTION VALUE="HEIGHT=30">30
  6475. </SELECT> Header: <SELECT NAME="headerheight" TITLE="Select height of table header for printout">
  6476.         <OPTION VALUE="">min
  6477.         <OPTION VALUE="HEIGHT=20">20
  6478.         <OPTION VALUE="HEIGHT=30" SELECTED>30
  6479. </SELECT></nobr></TD>
  6480.         <TD> </TD>
  6481.         <TD><nobr>Align: <SELECT NAME="align" TITLE="Select alignment of page title">
  6482. <OPTION VALUE="LEFT" SELECTED>left
  6483. <OPTION VALUE="CENTER">center
  6484. <OPTION VALUE="RIGHT">right
  6485. </SELECT> <B>B</B> <INPUT TYPE=CHECKBOX NAME="style" 
  6486. VALUE="B" TITLE="Style of page title - Bold"> <B><I>I</I></B><INPUT TYPE=CHECKBOX NAME="style" 
  6487. VALUE="I" TITLE="Style of page title - Italic"> <B><U>U</U></B><INPUT TYPE=CHECKBOX NAME="style" VALUE="U" TITLE="Style of page title - Underline"></nobr>
  6488.  
  6489. EOT
  6490. ;
  6491. }
  6492.  
  6493.     my $export = <<EOT
  6494.     <TABLE BORDER=0>
  6495.     <FORM ACTION=$full_url METHOD=POST>
  6496. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  6497. <INPUT TYPE=HIDDEN NAME="page"             VALUE="tables">
  6498. <INPUT TYPE=HIDDEN NAME="count"         VALUE="$count">
  6499. <INPUT TYPE=HIDDEN NAME="tables"         VALUE="$table">
  6500. <INPUT TYPE=HIDDEN NAME="start"         VALUE="$start">
  6501. <INPUT TYPE=HIDDEN NAME="rows"             VALUE="$rows">
  6502. <INPUT TYPE=HIDDEN NAME="where"         VALUE="$where">
  6503. <INPUT TYPE=HIDDEN NAME="order"         VALUE="$order">
  6504. <INPUT TYPE=HIDDEN NAME="searchresult"     VALUE="1">
  6505. $hidden
  6506. <INPUT TYPE=HIDDEN NAME="query"         VALUE="$query">
  6507.     <TR>
  6508.         <TD><P><INPUT TYPE=SUBMIT NAME="func" VALUE="Export Result" style="width: 110"></TD>
  6509.         <TD> </TD>
  6510.         <TD>CSV File<INPUT TYPE=RADIO NAME="mode" VALUE="simple" CHECKED></TD>
  6511.         <TD> </TD>
  6512.         <TD>Advanced<INPUT TYPE=RADIO NAME="mode" VALUE="advanced"></TD>
  6513.         <TD> </TD>
  6514.     </TR>
  6515. </FORM>
  6516.     </TABLE>
  6517. EOT
  6518. unless $deletepreview;
  6519.  
  6520.     print <<EOT
  6521. <!-- Header Table -->
  6522. <TABLE BORDER=0>
  6523.     <TR>
  6524.         <TD VALIGN=TOP><P>
  6525.     <TABLE BORDER=0>
  6526.         <TR>
  6527.             <TH ALIGN=LEFT>$title</TH>
  6528.             <TD> </TD>
  6529.             <TD $conftitle> <CODE>$confirmation</CODE> </TD>
  6530.         </TR>
  6531.         <TR>
  6532.             <TD COLSPAN=3><CODE>TABLE "$table" </CODE></TD>
  6533.         </TR>
  6534.         <TR>
  6535.             <TD COLSPAN=3> </TD>
  6536.         </TR>
  6537.     </TABLE>
  6538.         </TD>
  6539.         <TD VALIGN=TOP><P>
  6540.     <TABLE BORDER=0>
  6541.     <FORM METHOD=POST ACTION="$full_url" TARGET=_blank>
  6542.         <TR>
  6543.             <TD>$pr_res_up</TD>
  6544.         </TR>
  6545.         <TR>
  6546.             <TD ALIGN=CENTER>$pr_res_down</TD>
  6547.         </TR>
  6548. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  6549. <INPUT TYPE=HIDDEN NAME="page" VALUE="searchresult">
  6550. <INPUT TYPE=HIDDEN NAME="count" VALUE="$count">
  6551. <INPUT TYPE=HIDDEN NAME="tables" VALUE="$table">
  6552. <INPUT TYPE=HIDDEN NAME="start" VALUE="$start">
  6553. <INPUT TYPE=HIDDEN NAME="rows" VALUE="$rows">
  6554. <INPUT TYPE=HIDDEN NAME="where" VALUE="$where">
  6555. <INPUT TYPE=HIDDEN NAME="order" VALUE="$order">
  6556. $hidden
  6557. </FORM>
  6558.     </TABLE>
  6559. $export
  6560.         </TD>
  6561.     </TR>
  6562. </TABLE>
  6563. <!-- End of Header Table -->
  6564. EOT
  6565. unless $print;
  6566.  
  6567.     my $bordercolor = '#AAAAAA';
  6568.     print <<EOT
  6569.           <!-- Search Result -->
  6570. <FORM METHOD=POST ACTION="$full_url">
  6571. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%">
  6572.     <TR>
  6573.         <TD WIDTH="100%">
  6574. <!-- Control Bar starts here -->
  6575. $controlbar
  6576. <!-- Control Bar ends here -->
  6577.         </TD>
  6578.     </TR>
  6579.     <TR>
  6580.         <TD WIDTH="100%">
  6581.             <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0>
  6582.                 <TR>
  6583.                     <TD BGCOLOR="$bordercolor">
  6584.                         <TABLE BORDER=0 CELLSPACING=1 CELLPADDING=2>
  6585. EOT
  6586. ;
  6587.  
  6588.     #my $firstrow  ;
  6589.     my $rowheight = $q->param('rowheight');
  6590.     my $headerheight = $q->param('headerheight');
  6591.     print qq!\t<TR $headerheight>!, @{shift (@$array)}, qq!</TR>\n!;
  6592.     foreach (@$array){print qq!\t<TR $rowheight>@{$_}</TR>\n!}
  6593.     print <<EOT
  6594.                         </TABLE>
  6595.                     </TD>
  6596.                 </TR>
  6597.             </TABLE>
  6598.         </TD>
  6599.     </TR>
  6600. </TABLE>
  6601. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  6602. <INPUT TYPE=HIDDEN NAME="page" VALUE="searchresult">
  6603. <INPUT TYPE=HIDDEN NAME="count" VALUE="$count">
  6604. <INPUT TYPE=HIDDEN NAME="tables" VALUE="$table">
  6605. <INPUT TYPE=HIDDEN NAME="start" VALUE="$start">
  6606. <INPUT TYPE=HIDDEN NAME="rows" VALUE="$rows">
  6607. <INPUT TYPE=HIDDEN NAME="where" VALUE="$where">
  6608. <INPUT TYPE=HIDDEN NAME="order" VALUE="$order">
  6609. $hidden
  6610. </FORM>
  6611.          <!-- end of printresult subroutine -->
  6612. EOT
  6613. ;
  6614.  
  6615.  
  6616. }
  6617. sub execSearchupdate {
  6618.     my ($back, $updatewhere) = @_;
  6619.     my $table         = $q->param('tables');
  6620.     my $err_msg;
  6621.     $updatewhere     = "WHERE $updatewhere" if $updatewhere;
  6622.     my $query         = "SELECT * FROM $table $updatewhere";
  6623.     my ($sth,$res)    = prepare_execute($query,$back);
  6624.     if ($res > 1){bail_out("Too many results. Check the code", $back)}
  6625.     my @names        = @{$sth->{NAME}};
  6626.     my @ary         = $sth->fetchrow_array();#||bail_out("",$back);
  6627.     my @unquote        = $q->param('unquote');
  6628.     my @upload        = $q->param('upload');
  6629.     my $num            = $sth->{NUM_OF_FIELDS};
  6630.     $sth->finish;
  6631.     my @setarray;
  6632.     for (my $i = 0; $i<$num; $i++) {
  6633.         my $data;
  6634.         if (belongs(\@upload, $names[$i])){
  6635.             $data = $q->param("$names[$i]\_data_upload")||bail_out("No file entered ('$names[$i]' column).",$back);
  6636.             my $buf;
  6637.             $err_msg .= "File not found or is empty. $! - column '$names[$i]'\n" unless (-s $data);
  6638. #            binmode $data if -B $data;
  6639.             binmode $data;
  6640.             my $line = '';
  6641.  
  6642.             while (read $data, $buf, 1024) {$line .= $buf; bail_out("$!", $back) if $! }
  6643.             close $data;
  6644.             bail_out("$!", $back) if $!;
  6645.             $data = $line;    
  6646.         }
  6647.         else {$data = $q->param("$names[$i]\_data").''}
  6648.  
  6649. #++++++++++++++++++++++++++++++++++++++
  6650.  
  6651.         if (belongs(\@unquote, $names[$i])){
  6652.             my $data_ = $data;
  6653.             my $sth     = $dbh->prepare("SELECT $data");
  6654.             my $res     = $sth->execute() || bail_out("CHECK YOUR INPUT. WRONG UNQUOTED PARAMETERS IN COLUMN: '$names[$i]'\n\n$data\n\n", $back);
  6655.             ($data_)    = $sth->fetchrow_array();
  6656.             if (($data_ ne $ary[$i]) or (!defined $data_) or (!defined $ary[$i])){
  6657.                 push @setarray, "$names[$i]=$data"; 
  6658.             }
  6659.         }
  6660.         else {
  6661.             unless ($data eq $ary[$i]){
  6662.                 $data = $dbh->quote($data);
  6663.                 push @setarray, "$names[$i]=$data";
  6664.             }
  6665.         }
  6666.     }#for
  6667.     bail_out($err_msg, $back) if $err_msg;
  6668.     unless (@setarray == 0) {
  6669.         bail_out($demomsg, $back);
  6670.     }#end update
  6671. }#execSearchupdate
  6672.  
  6673.  
  6674. sub printHeaderTable {
  6675.     my $headtab = $_[0];
  6676. # $_[0]->{name} - the name of proc.
  6677. # $_[0]->{title1} - table name
  6678. # $_[0]->{title2} - count rows
  6679. # $_[0]->{rows} - No of rows
  6680. # $_[0]->{table} - Table name
  6681.  
  6682.     my $total = qq!<CODE>$headtab->{rows}</CODE>! if (defined $headtab->{rows});
  6683.     my $table = qq!<CODE>$headtab->{table}</CODE>! if $headtab->{table};
  6684.     print <<EOT
  6685. <TABLE BORDER=0><!-- Header Table -->
  6686.     <TR><TH COLSPAN=5 ALIGN=LEFT>$headtab->{name}</TH><TR>
  6687.     <TR>
  6688.         <TD TITLE="$headtab->{title1}">$table</TD>
  6689.         <TD>   </TD>
  6690.         <TD TITLE="$headtab->{title2}">  $total  </TD>
  6691.         <TD>    </TD>
  6692.         <TD>$headtab->{msg}</TD>
  6693.     </TR>
  6694. </TABLE><!-- End of Header Table -->
  6695. EOT
  6696. ;
  6697. }
  6698. sub backtoselect {
  6699.         my $tables    = quoteit ($q->param('tables'));
  6700.         my @cols     = $q->param("fields_$tables");
  6701.         return {
  6702.             select                => "".$q->param('select'),
  6703.             tables                => "".$tables,
  6704.             where                => "".$q->param('where'),
  6705.             groupby                => "".$q->param('groupby'),
  6706.             orderby                => "".$q->param('orderby'),
  6707.             limit                => "".$q->param('limit'),
  6708.             "fields_$tables"    => \@cols
  6709.         }
  6710. }
  6711.  
  6712. sub printform {
  6713.     my $input = shift;
  6714.     my $hidden = qq!<INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">\n!;
  6715.     $hidden .= qq!<INPUT TYPE=HIDDEN NAME="page" VALUE="tables">\n!;
  6716.     my $query    = $input->{query};
  6717.     if ($q->param('func') =~ /^select/i){
  6718.         my $param = backtoselect();
  6719.         foreach (keys %$param){
  6720.             $hidden .= $q->hidden(-name=>$_, -value=>$param->{$_}, -override=>1)."\n";
  6721.         }
  6722.         $hidden             .= qq!<INPUT TYPE=HIDDEN NAME="query" VALUE="$query">\n!;
  6723.     }
  6724.     else {
  6725.         my $sql                .= quoteit ($input->{'SQL'});
  6726.         my $selectedscript    .= quoteit ($input->{'selectedscript'});
  6727.          $hidden             .= qq!<INPUT TYPE=HIDDEN NAME="SQL" VALUE="$sql">!;
  6728.         $hidden             .= qq!<INPUT TYPE=HIDDEN NAME="selectedscript" VALUE="$selectedscript">! if $selectedscript;
  6729.         $hidden             .= qq!<INPUT TYPE=HIDDEN NAME="query" VALUE="$query">\n!;
  6730.         $hidden             .= qq!<INPUT TYPE=HIDDEN NAME="script" VALUE="execute">\n!;
  6731. #        $hidden             .= qq!<INPUT TYPE=HIDDEN NAME="func" VALUE="script">!;
  6732.     }
  6733.     print <<EOT
  6734.     <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  6735.     <TR><TD><P>
  6736.  
  6737. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=1>
  6738. <FORM ACTION=$full_url METHOD=POST TARGET=_blank>
  6739. <INPUT TYPE=HIDDEN NAME="SQL" VALUE="$input->{query}">
  6740. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  6741. <INPUT TYPE=HIDDEN NAME="page" VALUE="tables">
  6742. <INPUT TYPE=HIDDEN NAME="script" VALUE="print">
  6743. <INPUT TYPE=HIDDEN NAME="func" VALUE="script">
  6744.     <TR>
  6745.         <TD><INPUT TYPE=SUBMIT NAME="print" VALUE="Print Result" TITLE="Generate printer friendly report"  style="width: 110"> </TD>
  6746.         <TD> Heights:</TD>
  6747.         <TD>Rows <SELECT NAME="rowheight" TITLE="Select height of table rows for printout">
  6748. <OPTION VALUE="" SELECTED>min
  6749. <OPTION VALUE="HEIGHT=20">20
  6750. <OPTION VALUE="HEIGHT=30">30
  6751. </SELECT></TD>
  6752.         <TD>Header <SELECT NAME="headerheight" TITLE="Select height of table header for printout">
  6753. <OPTION VALUE="">min
  6754. <OPTION VALUE="HEIGHT=20">20
  6755. <OPTION VALUE="HEIGHT=30" SELECTED>30
  6756. </SELECT></TD>
  6757.         <TD>Title: <INPUT TYPE=TEXT SIZE=20 NAME="title" TITLE="Type page title to place on printout"></TD>
  6758.         <TD><NOBR>Align: <SELECT NAME="align" TITLE="Select alignment of page title">
  6759. <OPTION VALUE="LEFT" SELECTED>left
  6760. <OPTION VALUE="CENTER">center
  6761. <OPTION VALUE="RIGHT">right
  6762. </SELECT> <B>B</B> <INPUT TYPE=CHECKBOX NAME="style" 
  6763. VALUE="B" TITLE="Style of page title - Bold"> <B><I>I</I></B><INPUT TYPE=CHECKBOX NAME="style" 
  6764. VALUE="I" TITLE="Style of page title - Italic"> <B><U>U</U></B><INPUT TYPE=CHECKBOX NAME="style" VALUE="U" TITLE="Style of page title - Underline"></NOBR></TD>
  6765.  
  6766.     </TR>
  6767. </FORM>    
  6768. </TABLE>
  6769.  
  6770. </TD></TR>
  6771. <TR><TD><P>
  6772.  
  6773. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=1>
  6774.     <FORM ACTION=$full_url METHOD=POST><TR>
  6775. $hidden
  6776.         <TD><P><INPUT TYPE=SUBMIT NAME="func" VALUE="Export Result" style="width: 110"></TD>
  6777.         <TD> </TD>
  6778.         <TD>CSV File<INPUT TYPE=RADIO NAME="mode" VALUE="simple" CHECKED></TD>
  6779.         <TD> </TD>
  6780.         <TD>Advanced<INPUT TYPE=RADIO NAME="mode" VALUE="advanced"></TD>
  6781.         <TD> </TD>
  6782.     </TR>
  6783. </FORM>
  6784. </TABLE>
  6785.  
  6786. </TD></TR></TABLE>
  6787. EOT
  6788. ;
  6789.  
  6790. }
  6791. sub removeUser {
  6792.     my $back = {page => 'admin', func =>'access', dbname => "$database"};
  6793.     bail_out("Access denied to database 'mysql'", $back) if defined $q->param('add');
  6794.     my @userlist = $q->param('userlist');
  6795.     unless (@userlist and ($userlist[0] =~/@/)){bail_out "Please select from user list", $back}
  6796.     if ($q->param('confirm')){
  6797.         my @tables = ('mysql.user', 'mysql.columns_priv', 'mysql.db', 'mysql.tables_priv');
  6798.         foreach (@tables) {
  6799.             my $query = "DELETE FROM $_ WHERE ";
  6800.             my @where = ();
  6801.             foreach (@userlist){
  6802.                 /^\s*('\S*.*')\@('.*\S*')\s*$/;
  6803.                 push @where, "((User = $1) AND (Host = $2))";
  6804.             }
  6805.             $query .= join (' OR ', @where);
  6806.             $dbh->do($query) || bail_out("Can not do query:/n$query",$back);
  6807.         }
  6808.         $dbh->do("FLUSH PRIVILEGES") || bail_out("Can not flush privileges",$back);
  6809.         return
  6810.     }
  6811.     else {
  6812.         my $accounts;
  6813.         foreach (@userlist){
  6814.             $accounts .= qq!<INPUT TYPE=CHECKBOX NAME="userlist" VALUE="$_" CHECKED> $_ <BR>\n!;
  6815.         }
  6816.         my $message;
  6817.         my $buttons;
  6818.         unless (@userlist){
  6819.             $message = "Please select from user list";
  6820.             $buttons = qq!<INPUT TYPE=SUBMIT NAME="" VALUE="Back">\n!;
  6821.         }
  6822.         else {
  6823.             $message = 'You are going to remove the folowing accounts';
  6824.             $buttons = qq!<INPUT TYPE=SUBMIT NAME="action" VALUE="REMOVE" style="color=#CC0000">!;
  6825.             $buttons .= qq! <INPUT TYPE=SUBMIT NAME="" VALUE="Cancel">\n!;
  6826.         }
  6827.         print <<EOT
  6828. <FORM ACTION="$full_url" METHOD=POST>
  6829. <B>$message</B><BR>
  6830. $accounts<P>
  6831. $buttons
  6832. <INPUT TYPE=HIDDEN NAME="page" VALUE="admin">
  6833. <INPUT TYPE=HIDDEN NAME="func" VALUE="access">
  6834. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  6835. <INPUT TYPE=HIDDEN NAME="confirm" VALUE="1">
  6836. </FORM>
  6837. EOT
  6838. ;
  6839.     }
  6840.  
  6841. }
  6842. sub showGrants {
  6843.     my $back = {page => 'admin', func =>'access', dbname => "$database"};
  6844.     unless (check_version('3.23.4')){
  6845.         my $version = get_version();
  6846.         bail_out("Current version of mysql server ($version) does not allow this operation.\nYou need to upgrade mysql installation.", $back);
  6847.     }
  6848.     my @userlist = get_user_host();
  6849.     if (@userlist == 0){bail_out ("Please select from user list", $back)}
  6850.     foreach (@userlist){
  6851.  
  6852.         print "SHOW GRANTS FOR $_ <BR>";
  6853.         my ($sth, $res) = prepare_execute("SHOW GRANTS FOR $_", $back);
  6854.         print &printresult(\$sth), "<BR>";
  6855.         ErrMessage ("<BR>Print Result Error. $DBI::errstr") if $DBI::err;
  6856.     }
  6857.     bail_out('',$back);
  6858. }
  6859. sub getAnotherUser {
  6860.     my $user_  = $q->param('user1');
  6861.     my $host_  = $q->param('host1');
  6862.     my $add       = ($host_ ne '') ? '@' : $q->param('add');
  6863.     $host_       = $dbh->quote($host_) if $add;
  6864.     $user_       = $dbh->quote($user_);
  6865.     return ($user_.$add.$host_)
  6866. }
  6867. sub get_user_host {
  6868.     my @userlist;
  6869.     if (defined $q->param('add')){
  6870.         $userlist[0] = getAnotherUser();
  6871.     }
  6872.     else {
  6873.         @userlist = $q->param('userlist');
  6874.     }
  6875.     return @userlist;
  6876. }
  6877. sub changePassword {
  6878.     my $back = {page => 'admin', func =>'access', dbname => "$database"};
  6879. #++++++++++++++++++++++++++++++++++++++
  6880.  
  6881.     my $new_password; 
  6882.     my $password_     = $q->param('new_password');
  6883.     if ($password_ =~/\S/){
  6884.         $password_ = $dbh->quote($password_);
  6885.         $new_password = "PASSWORD($password_)"
  6886.     }
  6887.     else {$new_password = "''"}
  6888.     my $for;
  6889.     my $message;
  6890.     unless ($q->param('for') eq 'self'){
  6891.         my @userlist = get_user_host;
  6892.         bail_out ("Please select only one user name", $back) if (@userlist > 1);
  6893.         bail_out ("Please select from user list", $back) if (@userlist == 0);
  6894.         $for = "FOR $userlist[0]";
  6895.         $message = quoteit("New password was set for $userlist[0]")
  6896.     }
  6897.     else {$message = "My password was changed"}
  6898.     my $query = "SET PASSWORD $for = $new_password";
  6899.     $dbh->do($query) || bail_out("Can not set password.\n$query",$back);
  6900.     print $query;
  6901. #++++++++++++++++++++++++++++++++++++++
  6902.     bail_out ($message, $back);
  6903.  
  6904. }
  6905. sub loadAccessControl {
  6906.  
  6907. #++++++++++++++++++++++++++++++++++++++
  6908.  
  6909.  
  6910.  
  6911.     my $action                = $q->param('action');
  6912.     my $back                = $_[0];
  6913.     if ($action =~ /SHOW/i){showGrants();return}
  6914.     elsif ($action =~ /REMOVE/i){removeUser();return unless $q->param('confirm')}
  6915.     elsif ($action =~ /(GRANT)|(REVOKE)|(NEXT)|(CREATE)/i){loadGrantTables(); return}
  6916.     elsif ($action =~ /CHANGE/i){changePassword();return unless $q->param('confirm')}
  6917.     my $show_grants_button = qq!<INPUT TYPE=SUBMIT NAME="action" VALUE="SHOW GRANTS" style="Width: 150px" TITLE="Show grants for selected users">!;
  6918.     my $selectdbname_         = $q->param('selectdbname_');
  6919.     my ($userlist, $labels) = getuserlist();
  6920. #    unshift @$userlist, ''; 
  6921.     my $num_of_acc; my $myuser;
  6922.     if ($userlist->[0] =~/@/){$num_of_acc  = "<B>".(scalar @$userlist)." accounts found</B>"}
  6923.     else {
  6924.         if ($userlist->[0] == 1){
  6925.             $myuser = <<EOT
  6926. <TABLE WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0>
  6927.     <TR>
  6928.         <TD ALIGN=CENTER>user</TD><TD> </TD><TD ALIGN=CENTER>host</TD>
  6929.     </TR>
  6930.     <TR>
  6931.         <TD><INPUT TYPE=TEXT NAME="user1" SIZE=10 TITLE="User name"></TD>
  6932.         <TD><SELECT NAME="add">
  6933.                     <OPTION VALUE="">
  6934.                     <OPTION VALUE="\@" SELECTED>@
  6935.             </SELECT></TD>
  6936.         <TD><INPUT TYPE=TEXT NAME="host1" SIZE=10 TITLE="Host name"></TD>
  6937.     </TR>
  6938. </TABLE>
  6939. EOT
  6940. ;
  6941.         }
  6942.         $num_of_acc = ''}
  6943.     
  6944.     my $SelectUser    = $q->scrolling_list(
  6945.                                                  -name        => 'userlist',
  6946.                                         -value        => $userlist,
  6947.                                         -labels        => $labels,
  6948.                                         -multiple    => 1,
  6949.                                         -size        => 8
  6950.                                 );
  6951.     my ($other_users, $alt_hostname, $reload);
  6952.     my $apply        = 'NEXT>>';
  6953.     my $new_num        = $q->param('new_num');
  6954.     my $uh             = $q->param('alt_hostname');
  6955.     $new_num =~ s/^\s*(.+)\s*$/$1/;
  6956.     if (($new_num =~ /\d+/) and ($new_num > 0)){
  6957.         $other_users = <<EOT
  6958.         <TABLE BORDER=0>
  6959.             <TR>
  6960.                 <TD> </TD><TD>USER</TD><TD>PASSWORD</TD><TD>HOST</TD><TD> </TD>
  6961.             </TR>
  6962. EOT
  6963. ;
  6964.         $reload            = qq!<INPUT TYPE=SUBMIT VALUE="Reload"><INPUT TYPE=RESET>!;
  6965.         my @un             = $q->param('user_name');
  6966.         my @up             = $q->param('user_password');
  6967.         my @uh;
  6968.         my $uh            = quoteit($uh);
  6969.         $apply            = 'Apply';
  6970.         if ($q->param('apply_alt_host')){for(1..$new_num){push @uh, $uh}}
  6971.         else {@uh = $q->param('user_host');@uh = quoteit @uh}
  6972.         @un     = quoteit @un;
  6973.         @up     = quoteit @up;
  6974.         for(0..$new_num-1){
  6975.             my $create_button = $_ ? " " : qq!<INPUT TYPE=SUBMIT NAME="action" VALUE="NEXT>>" TITLE="Show privileges">! ;
  6976.             my $n = $_ + 1;
  6977.             $other_users .= <<EOT
  6978.             <TR>
  6979.                 <TD>$n</TD><TD><INPUT TYPE=TEXT SIZE=20 NAME="user_name" VALUE="$un[$_]" TITLE="User name"></TD>
  6980.                 <TD><INPUT TYPE=TEXT SIZE=20 NAME="user_password" VALUE="$up[$_]" TITLE="Password"></TD>
  6981.                 <TD><INPUT TYPE=TEXT SIZE=20 NAME="user_host" VALUE="$uh[$_]" TITLE="Host name or IP"></TD>
  6982.                 <TD>$create_button</TD>
  6983.             </TR>
  6984. EOT
  6985. ;
  6986.  
  6987.         }
  6988.         $other_users .=    "\n\t\t</TABLE>\n";    
  6989.  
  6990.     }
  6991.     elsif($new_num =~ /\S/){
  6992.         $other_users .= qq!<FONT COLOR="#FF0000">"Number of accounts" field must contain a number > 0</FONT>!;
  6993.         $new_num = '';
  6994.     }
  6995.     else {$other_users = " "; $new_num = '';}
  6996.     unless (defined $new_num){$new_num = 1}
  6997.     my $textsize = $agent ? 15 : 20 ;
  6998.     $alt_hostname =<<EOT
  6999.    
  7000.             <I>Use this host name for all accounts</I> 
  7001.             <INPUT TYPE=TEXT NAME="alt_hostname" VALUE="$uh" SIZE=20 TITLE="Type host name and click '$apply'"> 
  7002.             <INPUT TYPE=SUBMIT NAME="apply_alt_host" VALUE="$apply" TITLE="Click here to apply this host name to all accounts">
  7003. $reload
  7004. EOT
  7005. ;
  7006.  
  7007.     print <<EOT
  7008.  
  7009. <!-- MAIN TABLE1 STARTS -->
  7010. <TABLE  BORDER=0>
  7011.     <TR><TH ALIGN=LEFT>ADMINISTRATION -> ACCESS CONTROL</TH></TR>
  7012.     <TR>
  7013.         <TD><FORM ACTION="$full_url" METHOD=POST>
  7014.     <TABLE WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0>
  7015.         <TR><!-- Grant, Revoke, Show -->
  7016.             <TD VALIGN=TOP ALIGN=RIGHT WIDTH="50%"><P>
  7017.         <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%" >
  7018.             <TR>
  7019.                 <TD width="100%"><!-- BORDER START -->
  7020.             <TABLE BORDER=0 CELLPADDING=3 CELLSPACING=0 ALIGN=LEFT BGCOLOR="#CCCCCC" WIDTH="100%" >
  7021.                    <TR><TD><P><BR><INPUT TYPE=SUBMIT NAME="action" VALUE="      GRANT     " style="Width: 150px" TITLE="Grant privileges to selected users"></TD><!-- BUTTONS -->
  7022.                     <TD ROWSPAN=5 TITLE="Select user"><!-- SELECT USER -->
  7023. $num_of_acc <BR>
  7024. $SelectUser
  7025. <BR>
  7026. $myuser
  7027.                        </TD>
  7028.                     </TR>
  7029.                     <TR><TD><P><INPUT TYPE=SUBMIT NAME="action" VALUE="     REVOKE     " style="Width: 150px" TITLE="Revoke privileges from selected users"></TD></TR>
  7030.                     <TR><TD><P><INPUT TYPE=SUBMIT NAME="action" VALUE="    REMOVE     " style="Width: 150px; color=#CC0000" TITLE="Remove selected users"></TD></TR>
  7031.                     <TR><TD><P>$show_grants_button</TD></TR>
  7032.                     <TR HEIGHT=25><TD HEIGHT=25 ><P> </TD></TR>
  7033.             </TABLE>
  7034.         </TD></TR></TABLE>
  7035.             </TD><!-- End of Grant, Revoke, Show --><TD>  </TD>
  7036.             <TD VALIGN=TOP WIDTH="50%"><!-- Change Password -->
  7037.             
  7038.             
  7039.             <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%" >
  7040.             <TR>
  7041.                 <TD width="100%"><!-- BORDER START -->
  7042.             <TABLE BORDER=0 CELLPADDING=3 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%">
  7043.                 <TR>
  7044.                     <TD VALIGN=BOTTOM >
  7045.                     <INPUT TYPE=SUBMIT NAME="action" VALUE="CHANGE PASSWORD" style="width: 180px" TITLE="Change password"></TD>
  7046.                     <TD VALIGN=BOTTOM>   New Password</B><BR>
  7047.                     <INPUT TYPE=TEXT NAME="new_password" SIZE=$textsize TITLE="Type new password"></TD>
  7048.                 </TR>
  7049.                 <TR>
  7050.                     <TD COLSPAN=2>
  7051.                     <INPUT TYPE=RADIO NAME="for" CHECKED TITLE="Change password for selected user">For selected user
  7052.                     <INPUT TYPE=RADIO NAME="for" VALUE="self" TITLE="Change my password">For myself
  7053.                     </TD>
  7054.                 </TR>
  7055.             </TABLE>
  7056.             </TD></TR></TABLE><BR>
  7057.             
  7058.         <!--    <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" WIDTH="100%">
  7059.             <TR>
  7060.                 <TD width="100%">
  7061.             <TABLE BORDER=0 CELLPADDING=3 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%">
  7062.                 <TR>
  7063.                     <TD VALIGN=BOTTOM >
  7064.                     <INPUT TYPE=SUBMIT NAME="host_priv" VALUE="  HOST PRIVILEGES " style="width: 180px" TITLE="Assign host privilege"></TD>
  7065.                 </TR>
  7066.             </TABLE>
  7067.             </TD></TR></TABLE> -->
  7068.             
  7069.             
  7070.             </TD>
  7071.         </TR><!-- End of Change Password -->
  7072.         
  7073.     </TABLE>
  7074.     
  7075. <INPUT TYPE=HIDDEN NAME="page" VALUE="admin">
  7076. <INPUT TYPE=HIDDEN NAME="func" VALUE="access">
  7077. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  7078. <INPUT TYPE=HIDDEN NAME="selectdbname_" VALUE="$selectdbname_">
  7079.  
  7080. </FORM>
  7081.         </TD>
  7082.     </TR>
  7083.     <TR>
  7084.         <TD><HR SIZE=1></TD>
  7085.     </TR>
  7086.     <TR>
  7087.         <TD><FORM ACTION="$full_url" METHOD=POST><P><B>
  7088. CREATE</B> <INPUT TYPE=TEXT SIZE=3 MAXLENGTH=3 NAME="new_num" VALUE="$new_num" TITLE="Type number of new accounts to be created"><B> ACCOUNTS</B>$alt_hostname<BR>
  7089.  
  7090.  
  7091. $other_users
  7092. <INPUT TYPE=HIDDEN NAME="page" VALUE="admin">
  7093. <INPUT TYPE=HIDDEN NAME="func" VALUE="access">
  7094. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  7095. <INPUT TYPE=HIDDEN NAME="selectdbname_" VALUE="$selectdbname_">
  7096.  
  7097. </FORM>
  7098.         </TD>
  7099.     </TR>
  7100. </TABLE>
  7101. <!-- MAIN TABLE ENDS -->
  7102.  
  7103.  
  7104.  
  7105. EOT
  7106. ;
  7107. return
  7108.  
  7109.  
  7110. }
  7111. sub loadGrantTables {
  7112. # $_[0] contains $back
  7113.     my $back = {page => 'admin', func =>'access', dbname => "$database"};
  7114.     my @userlist = get_user_host();
  7115.     my $action = $q->param('action');
  7116.     my $num;
  7117.     my ($hidden_userlist, $hidden_password, $hidden_glob, $hidden_db, $hidden_table, $hidden_column);
  7118.     my @global = $q->param('global');
  7119.     my %global_lables = (
  7120.     'SELECT'                    =>'Select_priv',
  7121.     'INSERT'                    =>'Insert_priv',
  7122.     'UPDATE'                    =>'Update_priv',
  7123.     'DELETE'                    =>'Delete_priv',
  7124.     'CREATE'                    =>'Create_priv',
  7125.     'DROP'                        =>'Drop_priv',
  7126.     'RELOAD'                    =>'Reload_priv',
  7127.     'SHUTDOWN'                    =>'Shutdown_priv',
  7128.     'PROCESS'                    =>'Process_priv',
  7129.     'FILE'                        =>'File_priv',
  7130.     'GRANT'                        =>'Grant_priv',
  7131.     'REFERENCES'                =>'References_priv',
  7132.     'INDEX'                        =>'Index_priv',
  7133.     'ALTER'                        =>'Alter_priv',
  7134.     'CREATE TEMPORARY TABLES'    =>'Create_tmp_table_priv',
  7135.     'EXECUTE'                    =>'Execute_priv' ,
  7136.     'LOCK TABLES'                =>'Lock_tables_priv' ,
  7137.     'REPLICATION CLIENT'        =>'Repl_client_priv',
  7138.     'REPLICATION SLAVE'            =>'Repl_slave_priv',
  7139.     'SHOW DATABASES'            =>'Show_db_priv',
  7140.     'SUPER'                        =>'Super_priv'
  7141.     );
  7142.     my @database_values = (
  7143.     'SELECT', 'INSERT','UPDATE','DELETE','CREATE', 'DROP', 'REFERENCES', 'INDEX', 'ALTER'
  7144.     );
  7145.     
  7146.     my $table_values = [
  7147.     'SELECT', 'INSERT','UPDATE','DELETE','CREATE', 'DROP', 'REFERENCES', 'INDEX', 'ALTER', 'GRANT', ''
  7148.     ];
  7149.     my $column_values = ['SELECT', 'INSERT','UPDATE','REFERENCES'];
  7150.     my ($textsize, $textareasize) = $agent ? (12, 70) : (19, 100) ;
  7151.     my @password = $q->param('user_password') if ($action =~ /next/i or $action =~ /create/i);
  7152.     if($action =~ /next/i){
  7153.         $action = 'create';
  7154.         my $userlist_     = getuserlist();
  7155.         @userlist            = ();
  7156.         my @username        = $q->param('user_name');
  7157.         my @host;
  7158.         @host = $q->param('user_host');
  7159.         $num                 = scalar @username;
  7160.         my @username_        = @username;
  7161.         my @password_        = @password;
  7162.         my @host_            = @host;
  7163.         $back->{new_num}    = $q->param('new_num');
  7164.         $back->{user_name} = \@username_;
  7165.         $back->{user_host} = \@host_;
  7166.         $back->{user_password} = \@password_;
  7167.         # do revike
  7168.         #return
  7169.         for (my $i = 0; $i<$num; $i++){
  7170.             $password[$i]     =~ s/^\s*(\S*.*\S)\s*$/$1/;
  7171.             $password[$i]     = $dbh->quote($password[$i]) if ($password[$i] ne '');
  7172.             $host[$i]         =~ s/^\s*(\S*.*\S)\s*$/$1/;
  7173.             bail_out("Illegal host name '$host[$i]'", $back) if $host[$i] =~ /\s/;
  7174.             $host[$i]        = $dbh->quote($host[$i]);
  7175.             $username[$i]     =~ s/^\s*(\S*.*\S)\s*$/$1/;
  7176.             bail_out("Illegal user name '$username[$i]'", $back) if $username[$i] =~ /\s/;
  7177.             $username[$i]    = $dbh->quote($username[$i]);
  7178.             if (belongs \@userlist, "$username[$i]\@$host[$i]") {
  7179.                 bail_out("The entry $username[$i]\@$host[$i] is duplicated.\nCheck user/host names.", $back);
  7180.             }
  7181.             if (belongs $userlist_, "$username[$i]\@$host[$i]") {
  7182.                 bail_out("The entry $username[$i]\@$host[$i] already exists.\nCheck user/host names.", $back);
  7183.             }
  7184.             push @userlist,"$username[$i]\@$host[$i]";
  7185.         }
  7186.     }
  7187.     elsif ($action =~/(grant)|(create)|(revoke)/i){
  7188.         $num = scalar @userlist
  7189.     }
  7190.  
  7191.     my $back_; my @query; 
  7192.     my @x = $q->param();
  7193.     foreach (@x){
  7194.         my @y         = $q->param($_);
  7195.         $back_->{$_} = [@y];
  7196.     }
  7197.     undef  $back_->{'create'};
  7198.     $action                    = uc $action;
  7199.     my $s                     = 'S' if $num > 1;
  7200.     my $num_                = $num;
  7201.     $num_                     = '' if $num == 1;
  7202.     my $actionDescr         = ($action eq "CREATE") ? "CREATE $num_ NEW ACCOUNT$s" : "$action PRIVILEGES" ;
  7203.     my $count = 0;
  7204.     
  7205.     if ($q->param('create') and !$q->param('after_preview')){
  7206.         my $v4opt;
  7207.         {
  7208.             $v4opt = sub {
  7209.                 return {} if $count;
  7210.                 my $with = shift || "\n";
  7211.                 my $errmessage;
  7212.                 my $grant_opt;
  7213.                 my $queriesph = deletespace($q->param('queriesph'));
  7214.                 if ($queriesph ne ''){
  7215.                     if (($queriesph =~ /^\d+$/) or ($queriesph =~ /^\d*\.?\d+e?\d+$/i) or ($queriesph =~ /^\d+\.?\d*e?\d+$/i)){
  7216.                         $grant_opt    .= "$with  MAX_QUERIES_PER_HOUR $queriesph ";
  7217.                         $with        = '';
  7218.                     }
  7219.                     else{
  7220.                         $errmessage .= "Value MAX_QUIRIES_PER_HOUR must be Numeric\n"
  7221.                     }
  7222.                 }
  7223.                 my $updatesph        = deletespace($q->param('updatesph'));
  7224.                 if($updatesph ne ''){
  7225.                     if (($updatesph =~ /^\d+$/) or ($updatesph =~ /^\d*\.?\d+e?\d+$/i) or ($updatesph =~ /^\d+\.?\d*e?\d+$/i)){
  7226.                         $grant_opt    .= "$with MAX_UPDATES_PER_HOUR $updatesph ";
  7227.                         $with        = '';
  7228.                     }
  7229.                     elsif(!$errmessage){
  7230.                         $errmessage .= "Value MAX_UPDATES_PER_HOUR must be Numeric\n"
  7231.                     }
  7232.                 }
  7233.                 my $connectionsph    = deletespace($q->param('connectionsph'));
  7234.                 if ($connectionsph ne ''){
  7235.                     if (($connectionsph =~ /^\d+$/) or ($connectionsph =~ /^\d*\.?\d+e?\d+$/i) or ($connectionsph =~ /^\d+\.?\d*e?\d+$/i)){
  7236.                         $grant_opt    .= "$with MAX_CONNECTIONS_PER_HOUR $connectionsph ";
  7237.                     }
  7238.                     elsif(!$errmessage){
  7239.                         $errmessage .= "Value MAX_CONNECTIONS_PER_HOUR must be Numeric\n"
  7240.                     }
  7241.                 }
  7242.                 if ($errmessage){bail_out($errmessage, $back_)}
  7243.                 my $v4output;
  7244.                 $v4output->{max} = "$grant_opt";
  7245.                 
  7246.         
  7247.                 my $require;
  7248.                 if ($q->param('require')){
  7249.                     if ($q->param('require_opt') eq 'none'){$require = "\nREQUIRE NONE"}
  7250.                     if ($q->param('require_opt') eq 'ssl'){$require = "\nREQUIRE SSL"}
  7251.                     if ($q->param('require_opt') eq 'x509'){$require = "\nREQUIRE X509"}
  7252.                     if ($q->param('require_opt') eq 'other'){
  7253.                         my $req = "\nREQUIRE";
  7254.                         if (my $cipher    = deletespace($q->param('cipher'))){$require .= qq!$req CIPHER "$cipher"!; $req = "\n\t"}
  7255.                         if (my $issuer    = deletespace($q->param('issuer'))){$require .= qq!$req ISSUER "$issuer"!; $req = "\n\t"}
  7256.                         if (my $subject    = deletespace($q->param('subject'))){$require .= qq!$req SUBJECT "$subject"!}
  7257.                     }
  7258.                 }
  7259.                 $v4output->{req} = "$require";
  7260.                 return $v4output;
  7261.             };
  7262.         }
  7263.         my $ident;
  7264.         my $with = "\nWITH";
  7265.         my $global_priv    = $q->param('global_priv');
  7266.         my $db_priv        = $q->param('db_priv');
  7267.         my $table_priv    = $q->param('table_priv');
  7268.         my $column_priv    = $q->param('column_priv');
  7269.         if ($global_priv and ($global[0]  or !($db_priv or $table_priv or $column_priv))){
  7270.             my $priv_type;
  7271.             my $grant_opt;
  7272.             my @privileges        = @global;
  7273.             my @to                = @userlist;
  7274.             $ident                = 1;
  7275.             shift @privileges         if ($privileges[0]    eq '');
  7276.             my $t;
  7277.             until($privileges[-1]){pop @privileges; last unless @privileges}
  7278.             my $max = check_version('4.0.2') ? 20 : 13;
  7279.             if ($action =~ /revoke/i){
  7280.                 if  ($privileges[-1] eq 'GRANT'){
  7281.                     $privileges[-1] = 'GRANT OPTION';
  7282.                     $priv_type = join (', ', @privileges)
  7283.                 }
  7284.                 elsif (scalar @privileges == $max){$priv_type = ' ALL'}
  7285.                 elsif (scalar @privileges == 0) {$priv_type = ' USAGE'}
  7286.                 else {$priv_type = join (', ', @privileges)}
  7287.                 my $to = join ', ', @to;
  7288.                 push @query, "REVOKE $priv_type ON *.* FROM \n$to$grant_opt\n";
  7289.             }
  7290.             else {
  7291.                 if ($privileges[-1] eq 'GRANT'){
  7292.                     $grant_opt = "$with GRANT OPTION";
  7293.                     pop @privileges;
  7294.                     $with = '';
  7295.                 }
  7296.                 my $v4output = &$v4opt($with);
  7297.                 $count = 1;
  7298.                 $grant_opt .= $v4output->{max};
  7299.                 my $require = $v4output->{req};
  7300.                 if (scalar @privileges == $max){$priv_type = ' ALL'}
  7301.                 elsif (scalar @privileges == 0) {
  7302.                     $priv_type = ' USAGE'
  7303.                 }
  7304.                 else {$priv_type = join (', ', @privileges)}
  7305.                 for(my $i=0; $i < $num; $i++){
  7306.                     $to[$i]    .= " IDENTIFIED BY $password[$i]" if $password[$i];
  7307.                 }
  7308.                 my $to = join ', ', @to;
  7309.                 push @query, "GRANT $priv_type \nON *.* TO $to $require$grant_opt\n";
  7310.             }
  7311.         }
  7312.         if ($db_priv){
  7313.             my @query3                 = (); #
  7314.             my $priv_type;
  7315.             my $grant_opt;
  7316.             my @db                    = $q->param('d_db');
  7317.             shift @db unless $db[0];
  7318.             my @other_db            = split ',', $q->param('d1_db');
  7319.             my @db3;
  7320.             my $i;
  7321.             foreach(@other_db){
  7322.                 my $db = $_;
  7323.                 $db = deletespace($db);
  7324.                 next if ($db eq '');
  7325.                 next if belongsb (\@db, $db);
  7326.                 my $chars;
  7327.                 while($db =~ /(?=(\W)(.?))/g){
  7328.                     if ($1 eq "\\"){
  7329.                         $chars .= $1 unless ($2 eq '_')
  7330.                     }
  7331.                     elsif(($1 ne '?') and ($1 ne '%')){
  7332.                         if ($1 eq ' '){$chars .= 'SPACE '}    
  7333.                         elsif ($1 eq "\t"){$chars .= 'TAB '}
  7334.                         else {$chars .= $1}
  7335.                     }
  7336.                 }
  7337.                         bail_out("Illegal characters $chars in database name '$db'.\n", $back_) if $chars;
  7338.                 
  7339.                 my $db_temp = $db;
  7340.                 $db_temp =~ s/\?//ig;
  7341.                 if ($db =~ /^[a-zA-Z0-9_\$]*$/){push @db, $db}            # legal db names
  7342.                 elsif ($db !~ /\?/){push @db, "`$db`"}                     # db names with non-alphanumeric chars but the `?'
  7343.                 elsif ($db_temp =~ /^[a-zA-Z0-9_\$]*$/){push @db3,$db}  # legal db names with `?' variable
  7344.                 else {push @db3, "`$db`"}                                 # names with non-alphanumeric chars and `?'
  7345.             }
  7346.             bail_out("Database privileges failed.\nNo database was selected.\n\n", $back_) unless (@db or @db3);
  7347.             my @privileges            = $q->param('database');
  7348.             shift @privileges         if ($privileges[0]    eq '');        
  7349.             until($privileges[-1]){pop @privileges; last unless @privileges}
  7350.             my ($priv_cols, @priv_cols);
  7351.             foreach (@privileges){
  7352.                 $priv_cols .= ", $global_lables{$_}";
  7353.                 push @priv_cols, $global_lables{$_};
  7354.             }
  7355.                     
  7356.             my (@query2, $j, @values1, @set, $set);
  7357.             my $max = check_version("4.0.4") ? 11 : 9;
  7358.             if ($action =~ /revoke/i){
  7359.                 my @privileges_ = @privileges;
  7360.                 if  ($privileges[-1] eq 'GRANT'){
  7361.                     $privileges[-1] = 'GRANT OPTION';
  7362.                     $priv_type = join (', ', @privileges)
  7363.                 }
  7364.                 elsif (scalar @privileges == $max){$priv_type = ' ALL'}
  7365.                 elsif (scalar @privileges == 0) {$priv_type = ' USAGE'}
  7366.                 else {$priv_type = join (', ', @privileges)}
  7367.                 my @query1; my @where_delete; my @where_update;
  7368.                 my @to         = @userlist;
  7369.                 my @to1        = @to;
  7370.                 for(my $i=0; $i < $num; $i++){
  7371.                     
  7372.                     if (@db3) {
  7373.                         $userlist[$i]        =~ /^'(.*)'\@'(.*)'/;
  7374.                         my $username         = $1;
  7375.                         my $hostname        = $2;
  7376.                         foreach (@db3){
  7377.                             my $db3 = $_;
  7378.                             $db3    =~ s/\?/$username/gi;
  7379.                             unless (belongs(\@db, $db3)){
  7380.                                 push @query3, "REVOKE $priv_type \n ON $db3\.* \n FROM '$username'\@'$hostname'\n";
  7381.                             }
  7382.                         }
  7383.                 
  7384.                     }#if (@db2)
  7385.                 }#for(my $i=0; $i < $num; $i++)
  7386.                 my $to = join ', ',@to;
  7387.                 my $to1 = join ', ',@to1;
  7388.                 if ($db[0]){
  7389.                     push @query, "REVOKE $priv_type \n ON $db[0]\.* \n FROM $to\n";
  7390.                     shift @db;
  7391.                 }
  7392.                 foreach (@db){
  7393.                     push @query, "REVOKE $priv_type \n ON $_\.*  \n FROM $to1\n";
  7394.  
  7395.                 }
  7396.             }
  7397.             else{#create, grant
  7398.                 if  ($privileges[-1] eq 'GRANT'){
  7399.                     $grant_opt        = " \nWITH GRANT OPTION";
  7400.                     pop @privileges;
  7401.                     $with = '';
  7402.                 }
  7403.                 if (scalar @privileges == $max){$priv_type = ' ALL'}
  7404.                 elsif (scalar @privileges == 0) {$priv_type = ' USAGE'}
  7405.                 else {$priv_type = join (', ', @privileges)}
  7406.                 my @query1;
  7407.                 my @to         = @userlist;
  7408.                 my @to1        = @to;
  7409.                 my @where_update;
  7410.                 for(my $i=0; $i < $num; $i++){
  7411.                     if (@db){
  7412.                         $to[$i]    .= " IDENTIFIED BY $password[$i]" if (($password[$i] ne '') and !$ident);
  7413.                     }
  7414.                     if (@db3) {
  7415.                         $userlist[$i]        =~ /^'(.*)'\@'(.*)'/;
  7416.                         my $username         = $1;
  7417.                         my $hostname        = $2;
  7418.                         my $count_            = $count;
  7419.                         if ($action =~ /create/i){
  7420.                             my $ident_ = $ident;
  7421.                             foreach (@db3){
  7422.                                 my $grant;
  7423.                                 unless(@db or $count_){
  7424.                                     my $v4output = &$v4opt($with);
  7425.                                     my $max = $v4output->{max};
  7426.                                     $count_ = 1;
  7427.                                     my $require = $v4output->{req};
  7428.                                     $grant = "$require$grant_opt$max";
  7429.                                 }
  7430.                                 my $db3 = $_;
  7431.                                 $db3    =~ s/\?/$username/ig;
  7432.                                 unless (belongs(\@db, $db3)){
  7433.                                     my $pw = "IDENTIFIED BY $password[$i]" unless ($ident_ or @db);
  7434.                                     push @query3, "GRANT $priv_type \nON $db3.* \nTO '$username'\@'$hostname' $pw $grant\n";
  7435.                                 }
  7436.                                 $ident_ = 1;
  7437.                             }
  7438.                         }
  7439.                         else { #GRANT
  7440.                             foreach (@db3){
  7441.                                 my $grant;
  7442.                                 unless(@db or $count_){
  7443.                                     my $v4output = &$v4opt($with);
  7444.                                     my $max = $v4output->{max};
  7445.                                     $count_ = 1;
  7446.                                     my $require = $v4output->{req};
  7447.                                     $grant = "$require$grant_opt$max";
  7448.                                 }
  7449.                                 my $v4output = &$v4opt($with);
  7450.                                 my $max = $v4output->{max};
  7451.                                 my $require = $v4output->{req};
  7452.                                 my $db3 = $_;
  7453.                                 $db3    =~ s/\?/$username/gi;
  7454.                                 unless (belongs(\@db, $db3)){
  7455.                                     push @query3, "GRANT $priv_type \nON $db3.* \nTO '$username'\@'$hostname' $grant\n";
  7456.                                 }
  7457.                             }
  7458.                         }#else
  7459.                     }#if (@db3)
  7460.                 }#for(my $i=0; $i < $num; $i++)
  7461.                 my $to = join ', ',@to;
  7462.                 my $to1 = join ', ',@to1;
  7463.  
  7464.                 for (my $i=0; $i<@db; $i++){
  7465.                     my $v4output = &$v4opt($with) unless $count;
  7466.                     $count = 1;
  7467.                     my $max = $v4output->{max};
  7468.                     my $require = $v4output->{req};
  7469.                     unless ($i) {push @query,    "GRANT $priv_type \nON $db[0]\.* \nTO $to $require$grant_opt$max\n"}
  7470.                     else {push @query,             "GRANT $priv_type \nON $db[$i]\.* \nTO $to1 $require$grant_opt$max\n"}
  7471.                 }
  7472.             }# create, grant
  7473.  
  7474.             push @query, @query3;
  7475.             
  7476.             $ident = 1;
  7477.         }
  7478.  
  7479.         if ($table_priv){
  7480.             my ($db, @tb);
  7481.             $db               = $q->param('t_db');
  7482.             @tb                  = $q->param('t_table');
  7483.             shift @tb unless $tb[0];
  7484.             $db = deletespace($db);
  7485.             bail_out("Table privileges failed.\nDatabase was not selected.\n\n", $back_) if ($db eq '');
  7486.             
  7487.             my @privileges        = $q->param('table_t');
  7488.             my $grant_opt        = '';
  7489.             my $priv_type        = '';
  7490.             shift @privileges         if ($privileges[0]    eq '');
  7491.             until($privileges[-1]){pop @privileges; last unless @privileges}
  7492.                my $ok = 0;
  7493.             if ($action =~ /revoke/i){
  7494.                 if  ($privileges[-1] eq 'GRANT'){
  7495.                     $privileges[-1] = 'GRANT OPTION';
  7496.                     $priv_type = join (', ', @privileges)
  7497.                 }
  7498.                 elsif (scalar @privileges == 9){$priv_type = ' ALL'}
  7499.                 elsif (scalar @privileges == 0) {$priv_type = ' USAGE'}
  7500.                 else {$priv_type = join (', ', @privileges)}
  7501.  
  7502.                 my @to = @userlist;
  7503.                 my @to1 = @to;
  7504.                 my $to = join ', ',@to;
  7505.                 my $to1 = join ', ',@to1;
  7506.                 if ($tb[0]){
  7507.                     $tb[0] =~ s/^\s*(.*)\s*$/$1/; 
  7508.                     $ok =1;
  7509.                     push @query, "REVOKE $priv_type \nON $db.$tb[0] FROM $to\n";
  7510.                     shift @tb
  7511.                 }
  7512.                 foreach (@tb){
  7513.                     s/^\s*(.*)\s*$/$1/;
  7514.                     next unless $_;
  7515.                     $ok =1;
  7516.                     push @query, "REVOKE $priv_type \nON $db.$_ FROM $to1\n "
  7517.                 }
  7518.             }
  7519.             else{
  7520.                 if ($privileges[-1] eq 'GRANT') {
  7521.                     $grant_opt = " \nWITH GRANT OPTION";
  7522.                     pop @privileges;
  7523.                     $with = '';
  7524.                 }
  7525.                 if (scalar @privileges == 9){$priv_type = ' ALL'}
  7526.                 elsif (scalar @privileges == 0) {$priv_type = ' USAGE'}
  7527.                 else {$priv_type = join (', ', @privileges)}
  7528.                 
  7529.                 my @to = @userlist;
  7530.                 my @to1 = @to;
  7531.                 for (my $i=0; $i<$num; $i++){
  7532.                     
  7533.                     if ($password[$i] and !$ident){$to[$i] .= " IDENTIFIED BY $password[$i]"} 
  7534.                 }
  7535.                 my $to = join ', ',@to;
  7536.                 my $to1 = join ', ',@to1;
  7537.                 
  7538.                 if ($tb[0]){
  7539.                     $tb[0] =~ s/^\s*(.*)\s*$/$1/; 
  7540.                     $ok =1;
  7541.                     my $v4output = &$v4opt($with) unless $count;
  7542.                     $count = 1;
  7543.                     my $max = $v4output->{max};
  7544.                     my $require = $v4output->{req};
  7545.                     push @query, "GRANT $priv_type \nON $db.$tb[0] \nTO $to $require$grant_opt$max\n";
  7546.                     shift @tb
  7547.                 }
  7548.                 foreach (@tb){
  7549.                     s/^\s*(.*)\s*$/$1/;
  7550.                     next unless $_;
  7551.                     $ok =1;
  7552.                     push @query, "GRANT $priv_type \nON $db.$_ \nTO $to1 $grant_opt\n "
  7553.                 }
  7554.             }            
  7555.             bail_out("Table privileges failed.\nTable was not selected.\n\n", $back_) unless $ok;
  7556.             $ident = 1;
  7557.         }
  7558.         if ($column_priv){
  7559.             my ($db, $tb, @col, $col);
  7560.             $db             = $q->param('c_db');
  7561.             $tb                = $q->param('c_table');
  7562.             @col            = $q->param('c_column');
  7563.             $db =~ s/^\s*(.*)\s*$/$1/;
  7564.             bail_out("Column privileges failed.\nDatabase was not selected.\n\n", $back_) if ($db eq '');
  7565.             $tb =~ s/^\s*(.*)\s*$/$1/;
  7566.             bail_out("Column privileges failed.\nTable was not selected.\n\n", $back_) if ($tb eq '');
  7567.             my @privileges        = $q->param('column');
  7568.             my $priv_type        = '';
  7569.             shift @privileges         if ($privileges[0]    eq '');
  7570.             until($privileges[-1]){pop @privileges; last unless @privileges}
  7571.             if (scalar @privileges == 0) {bail_out("Error. Column privileges are not selected", $back_)}
  7572.             else {$priv_type = join (', ', @privileges)}
  7573.             my @to = @userlist;
  7574.             for (my $i=0; $i<$num; $i++){
  7575.                 $to[$i] .= " IDENTIFIED BY $password[$i]" if ($password[$i] and !$ident)
  7576.             }
  7577.             my $to = join ', ',@to;
  7578.             my @col_ = ();
  7579.             foreach (@col){
  7580.                 s/^\s*(.*)\s*$/$1/;
  7581.                 next unless $_;
  7582.                 push @col_,$_
  7583.             }
  7584.             bail_out("Column privileges failed.\nColumn was not selected.\n\n", $back_) unless @col_;
  7585.             $col = join ', ',@col_;
  7586.             if ($action =~ /revoke/i){push @query, "REVOKE $priv_type ($col) \nON $db.$tb FROM $to\n "}
  7587.             else {
  7588.  
  7589.                 my $v4output = &$v4opt($with) unless $count;
  7590.                 $count = 1;
  7591.                 my $max = $v4output->{max};
  7592.                 my $require = $v4output->{req};
  7593.                 push @query, "GRANT $priv_type ($col) ON $db.$tb \nTO $to $require$max\n "
  7594.             }
  7595.             $ident = 1;
  7596.         }
  7597.     }
  7598.     print <<EOT
  7599. <TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0 WIDTH=650>
  7600.         <TR><FORM ACTION="$full_url" METHOD=POST>
  7601.             <TH ALIGN=LEFT WIDTH=550>
  7602.             ADMINISTRATION -> ACCESS CONTROL -> $actionDescr </TH>
  7603.             <TH WIDTH=100 ALIGN=RIGHT VALIGN=CENTER>
  7604.             <INPUT TYPE=SUBMIT VALUE="Cancel">
  7605.             <INPUT TYPE=HIDDEN NAME="page" VALUE="admin">
  7606.             <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  7607.             <INPUT TYPE=HIDDEN NAME="func" VALUE="access">
  7608.             </TH></FORM>
  7609.         </TR>
  7610. </TABLE>
  7611. EOT
  7612. ;
  7613.     if ($q->param('create')){
  7614.     
  7615.         if ($q->param('preview')){
  7616.             undef $back_->{'preview'};
  7617.             $back_->{'after_preview'} = '1';
  7618.             print qq!\n<FORM ACTION="$full_url" METHOD=POST>!;
  7619.             print qq!<P><TABLE><TR><TD></TD><TD>The following queries were generated:!;
  7620.             print qq!\n<B><INPUT TYPE=SUBMIT NAME="create" VALUE="Confirm" style="font-weight: bold" TITLE="Proceed with selected options"></B>\n!;
  7621.             print qq!\n<INPUT TYPE=SUBMIT VALUE="Back" TITLE="Back to edit privileges"></TD></TR>\n!;
  7622.             
  7623.             @query = quoteit(@query);
  7624.             my $i = 1;
  7625.             foreach (@query){
  7626.                 $_ = deletespace($_);
  7627.                 next unless ($_);
  7628.                 my $count;
  7629.                 while(/\n/g){$count++; last if $count > 8}
  7630.                 my $rows = $count+1;
  7631.                 if ($rows < 2){$rows = 2}
  7632.                 print qq!\t<TR><TD>$i</TD><TD><TEXTAREA NAME="query" COLS=$textareasize ROWS=$rows  WRAP=OFF>$_</TEXTAREA></TD></TR>\n!;
  7633.                 $i++;
  7634.             }
  7635.             print "</TABLE>\n";
  7636.             foreach (keys %$back_){
  7637.                     print $q->hidden(-name=>$_, -value=>$back_->{$_}, -override=>1),"\n";
  7638.             }
  7639.  
  7640.             print qq!\n</FORM>!;
  7641.             return
  7642.  
  7643.         }
  7644.         else {
  7645.             if ($q->param('after_preview')){@query = $q->param('query')}
  7646.             my $i=0;
  7647.             
  7648.             print "<P>";
  7649.             my $message;
  7650.             #$dbh->{AutoCommit} = 0;
  7651.             foreach(@query){
  7652.                 next unless $_;
  7653.                 $i++;
  7654.                 my $query = quoteit $_;
  7655.                 $query =~ s/$/<BR>/mg;
  7656.                 print"$i) $query<BR>";
  7657.                 next if  /^\/\*\s*error/i;
  7658.                 my $message_ = '';
  7659.                 my $res = $dbh->do($_);
  7660.                 if ($dbh->err()){
  7661.                     $message_        = quoteit($DBI::errstr);
  7662.                     $message_        =~ s/^/<BR>/mg;
  7663.                     $message_        = "Error  $DBI::err (<B>$message_ </B>)\n\n" ;
  7664.                 }
  7665.                 elsif (/^\s*((INSERT)|(DELETE)|(UPDATE))\s/i and ($res == 0)){
  7666.                     $message_ = "<B>The result of this query is zero. Probably the privileges have been set/revoked before.</B>\n\n";
  7667.                 }
  7668.                 print "<P>$message_<BR>\n" if $message_;
  7669.                 print "_" x 30, "<P>\n";
  7670.                 $message .= $message_
  7671.             }
  7672.             #$dbh->commit() or bail_out("", $back_);
  7673.             #$dbh->{AutoCommit} = 1;
  7674.             print "<B>Result: OK</B>\n\n" unless $message;
  7675.             print qq!\n<FORM ACTION="$full_url" METHOD=POST>!;
  7676.             print qq!\n<INPUT TYPE=SUBMIT VALUE="Back" TITLE="Back to privileges"></TD></TR>\n!;
  7677.             foreach (keys %$back_){
  7678.                     print $q->hidden(-name=>$_, -value=>$back_->{$_}, -override=>1),"\n";
  7679.             }
  7680.  
  7681.             print qq!\n</FORM>!;
  7682.             return
  7683.         }
  7684.     }
  7685.         
  7686.  
  7687.     @password = quoteit(@password);
  7688.     foreach (@password){
  7689.         $hidden_password .= "\t<INPUT TYPE=HIDDEN NAME=\"user_password\" VALUE=\"$_\">\n";
  7690.     }
  7691.     bail_out("User(s) not defined", $back) unless (@userlist);
  7692.  
  7693.     @userlist = quoteit(@userlist);
  7694.     foreach (@userlist){
  7695.         $hidden_userlist .= "\t<INPUT TYPE=HIDDEN NAME=\"userlist\" VALUE=\"$_\">\n";
  7696.     }
  7697.     my $globs    = 1 if (($q->param('global_priv') or $q->param('global_priv_on')) and !$q->param('global_priv_off'));
  7698.     my $dbs          = 1 if (($q->param('db_priv') or $q->param('db_priv_on')) and !$q->param('db_priv_off'));
  7699.     my $tables    = 1 if (($q->param('table_priv') or $q->param('table_priv_on')) and !$q->param('table_priv_off'));
  7700.     my $columns    = 1 if (($q->param('column_priv') or $q->param('column_priv_on')) and !$q->param('column_priv_off'));
  7701.     if ($globs) {$hidden_glob = qq!<INPUT TYPE=HIDDEN NAME="global_priv" VALUE="on">!}
  7702.     if ($dbs) {$hidden_db = qq!<INPUT TYPE=HIDDEN NAME="db_priv" VALUE="on">!}
  7703.     if ($tables) {$hidden_table = qq!<INPUT TYPE=HIDDEN NAME="table_priv" VALUE="on">!}
  7704.     if ($columns) {$hidden_column = qq!<INPUT TYPE=HIDDEN NAME="column_priv" VALUE="on">!}
  7705.  
  7706.     my $d_db            = $q->param('d_db');
  7707.     my $t_db            = $q->param('t_db');
  7708.     my $c_db            = $q->param('c_db');
  7709.     my $dblistref         = getdblist($dbh);
  7710.     my @dblist;
  7711.     my ($d_dblist, $t_dblist, $c_dblist);
  7712.     if ($DBI::err and !$database) {
  7713.         $d_dblist    = $q->scrolling_list(
  7714.                                         -name        => 'd_db',
  7715.                                         -values        => [''],
  7716.                                         -labels        => {'' => 'ACCESS DENIED'},
  7717.                                         -size        => 4,
  7718.                                         -multiple    =>1                                        
  7719.                     );
  7720.         $t_dblist    = $q->scrolling_list(
  7721.                                         -name        => 't_db',
  7722.                                         -values        => [''],
  7723.                                         -labels        => {'' => 'ACCESS DENIED'},
  7724.                                         -size        => 1,
  7725.                     );
  7726.         $c_dblist    = $q->scrolling_list(
  7727.                                         -name        => 'c_db',
  7728.                                         -values        => [''],
  7729.                                         -labels        => {'' => 'ACCESS DENIED'},
  7730.                                         -size        => 1,
  7731.                     );    
  7732.     }
  7733.     else {
  7734.         @dblist        = @$dblistref;
  7735.         unshift        @dblist, '';
  7736.         $d_dblist    = $q->scrolling_list(
  7737.                                         -name        => 'd_db',
  7738.                                         -values        => \@dblist,
  7739.                                         -size        => 6,
  7740.                                         -multiple    =>1                                        
  7741.                     );
  7742.         $t_dblist    = $q->scrolling_list(
  7743.                                         -name        => 't_db',
  7744.                                         -values        => \@dblist,
  7745.                                         -size        => 1,
  7746.                                         -default    => '',
  7747.                                         -onChange    => 'this.form.submit()'
  7748.                     );
  7749.         $c_dblist    = $q->scrolling_list(
  7750.                                         -name        => 'c_db',
  7751.                                         -values        => \@dblist,
  7752.                                         -size        => 1,
  7753.                                         -default    => '',
  7754.                                         -onChange    => 'this.form.submit()'
  7755.                     );
  7756.         }
  7757.     my $t_table        = $q->param('t_table');
  7758.     my $c_table        = $q->param('c_table');
  7759.     my $t_tablelist;
  7760.     my $c_tablelist;
  7761.     my $T_Table;
  7762.     my $database_checkbox;
  7763.     my $d1_db;
  7764.     my ($C_Other_Db, $C_Other_Table, $C_Other_Column);
  7765.     if ($t_db){
  7766.         $back_->{t_db} = '';
  7767.         my @t_tablelist;
  7768.         my $sth = $dbh->prepare("SHOW TABLES FROM $t_db") || bail_out("Cannot prepare query\nSHOW TABLES FROM $t_db");
  7769.         my $res = $sth->execute();
  7770.         if ($DBI::err){
  7771.             if ($DBI::errstr =~ /(access)|(denied)/i){
  7772.                 $t_tablelist = <<EOT
  7773. <SELECT NAME="t_table">
  7774. <OPTION VALUE="">ACCESS DENIED
  7775. </SELECT>
  7776. EOT
  7777. ;
  7778.             }
  7779.             else {bail_out("Cannot execute query:\nSHOW TABLES FROM $t_db", $back_)}
  7780.         }
  7781.         else{
  7782.             my $i = 0;
  7783.             while(my ($tab) = $sth->fetchrow_array){
  7784.                 push @t_tablelist, $tab;
  7785.                 if ($i++ > 100){bail_out("", $$back_)}
  7786.             }
  7787.             $back_->{t_db} = $t_db;
  7788.             my $size        = scalar @t_tablelist;
  7789.             unshift         @t_tablelist, '';
  7790.             if ($size == 0){
  7791.                 $t_tablelist = $q->scrolling_list(
  7792.                                                  -name        => 't_table',
  7793.                                         -value        => '',
  7794.                                         -labels        => {'' => "Table list is empty\n"},
  7795.                                         -size        => 1
  7796.                             ) ;
  7797.             }
  7798.             else {
  7799.                 if ($size > 7) {$size    = 8} else {$size = $size + 1} ;
  7800.                 $t_tablelist = $q->scrolling_list(
  7801.                                         -name        => 't_table',
  7802.                                         -values        => \@t_tablelist,
  7803.                                         -size        => $size,
  7804.                                         -multiple    => 1
  7805.                             );
  7806.             }
  7807.         }
  7808.         $T_Table    =<<EOT
  7809.                 <TR>
  7810.                     <TD TITLE="Select one or more tables"><B>Table</B></TD>
  7811.                     <TD TITLE="Select one or more tables" ALIGN=RIGHT>$t_tablelist</TD>
  7812.                 </TR>
  7813. EOT
  7814. ;
  7815.     }
  7816.     else {
  7817.         $t_tablelist = $q->scrolling_list(
  7818.                                     -name   => 't_table',
  7819.                                     -value  => '',
  7820.                                     -labels  => {'' => "DB is not selected\n"},
  7821.                                     -size    => 1
  7822.                     );
  7823.         $T_Table    =<<EOT
  7824.                 <TR>
  7825.                     <TD TITLE="Select a database in the scrolling list above"><B>Table</B></TD>
  7826.                     <TD TITLE="Select a database in the scrolling list above" ALIGN=RIGHT>$t_tablelist</TD>
  7827.                 </TR>
  7828. EOT
  7829. ;
  7830.     }
  7831.     my @c_tablelist; 
  7832.     my $C_Table;
  7833.     my $columnlist;
  7834.     my $column        = $q->param('column');
  7835.     unless ($q->param('column_priv_off')){
  7836.         if ($c_db){
  7837.             $back_->{c_db} = '';
  7838.             @c_tablelist = @{getTablelist($c_db, $back_)};
  7839.             $back_->{c_db} = $c_db;
  7840.             unshift         @c_tablelist, '';
  7841.             if (@c_tablelist == 1){
  7842.                 $c_tablelist = $q->scrolling_list(
  7843.                                                  -name        => 'c_table',
  7844.                                         -value        => '',
  7845.                                         -labels        => {'' => "Table list is empty\n"},
  7846.                                         -size        => 1
  7847.                             );
  7848.             }
  7849.             else {
  7850.                 $c_tablelist = $q->scrolling_list(
  7851.                                         -name        => 'c_table',
  7852.                                         -values        => \@c_tablelist,
  7853.                                         -size        => 1,
  7854.                                         -onChange    => 'this.form.submit()'
  7855.                             );
  7856.             }
  7857.             $C_Table = <<EOT
  7858.                 <TR>
  7859.                     <TD TITLE="Select table"><B>Table</B></TD>
  7860.                     <TD ALIGN=RIGHT TITLE="Select table">$c_tablelist</TD>
  7861.                 </TR>
  7862. EOT
  7863. ;
  7864.         }
  7865.         else{
  7866.             $c_tablelist = $q->scrolling_list(
  7867.                                     -name        => 'c_table',
  7868.                                     -value        => '',
  7869.                                     -labels        => {'' => "DB is not selected\n"},
  7870.                                     -size        => 1
  7871.                     );
  7872.             $C_Table = <<EOT
  7873.                 <TR>
  7874.                     <TD TITLE="Select a database in the scrolling list above"><B>Table</B></TD>
  7875.                     <TD ALIGN=RIGHT TITLE="Select a database in the scrolling list above">$c_tablelist</TD>
  7876.                 </TR>
  7877. EOT
  7878. ;
  7879.  
  7880.         }    
  7881.     
  7882.             my $title;
  7883.             if ($c_table and belongs(\@c_tablelist, $c_table)) {
  7884.                 my @columnlist = ();
  7885.                 my $size;
  7886.                 my $multiple = 0;
  7887.                 #$back_->{column_priv_off} = 1;
  7888.                 $back_->{c_table} = '';
  7889.                 my $sth        = $dbh->prepare("DESCRIBE $c_db.$c_table") || bail_out ("Cannot prepare query:\n$query", $back_);
  7890.                 my $res        = $sth->execute();
  7891.                 if ($DBI::err){
  7892.                     if ($DBI::errstr =~ /(denied)|(access)/i){
  7893.                         @columnlist = ('ACCESS DENIED');
  7894.                         $size = 1;
  7895.                         $multiple = 0;
  7896.                     }
  7897.                     else {bail_out("Cannot execute query:\n$query", $back_)}
  7898.                 }
  7899.                 else {
  7900.                     while (my @row = $sth->fetchrow_array){
  7901.                         push @columnlist, $row[0];
  7902.                     }
  7903.                     unshift @columnlist,'';
  7904.                     $size = scalar @columnlist;
  7905.                     if ($size > 7) {$size    = 8};
  7906.                     $multiple = 1
  7907.                 }
  7908.                 $sth->finish;
  7909.                 $columnlist = $q->scrolling_list(
  7910.                                     -name        => 'c_column',
  7911.                                     -values        => \@columnlist,
  7912.                                     -size        => $size,
  7913.                                     -multiple    => $multiple
  7914.                             );
  7915.                 $title = "Select one or more columns."
  7916.             }
  7917.             else {
  7918.                 $columnlist = $q->scrolling_list(
  7919.                                     -name        => 'c_column',
  7920.                                     -value        => '',
  7921.                                     -labels        => {'' => "Table is not selected\n"},
  7922.                                     -size        => 1
  7923.                         );
  7924.                 $title = 'Select a table in the scrolling list above';
  7925.             }
  7926.             $columnlist = <<EOT
  7927.                 <TR>
  7928.                     <TD TITLE="$title"><B>Column</B></TD>
  7929.                     <TD ALIGN=RIGHT TITLE="$title">$columnlist</TD>
  7930.                 </TR>
  7931. EOT
  7932. ;
  7933.         
  7934.     }
  7935.     my $global_priv     = $globs    ? 'global_priv_off' : 'global_priv_on';
  7936.     my $db_priv            = $dbs        ? 'db_priv_off'         : 'db_priv_on';
  7937.     my $table_priv        = $tables    ? 'table_priv_off'    : 'table_priv_on';
  7938.     my $column_priv        = $columns    ? 'column_priv_off'    : 'column_priv_on';
  7939.  
  7940.     my $v402 = sub {
  7941.         return '' if $action =~ /REVOKE/i;
  7942.         my $color            = "#000000";
  7943.         my $color_max        = "#000000";
  7944.         my $disabled        = '';
  7945.         my $disabled_max     = '';
  7946.         my $title_req;
  7947.         my $title1;
  7948.         my $title_maxq;
  7949.         my $title_maxu;
  7950.         my $title_maxc;
  7951.         my $queriesph;
  7952.         my $updatesph;
  7953.         my $connectionsph;
  7954.         my $cipher;
  7955.         my $issuer;
  7956.         my $subject;
  7957.         my $requirecheck;
  7958.         my @require_opt_check;
  7959.         if (check_version("4.0.2")){
  7960.             $title_maxq     = qq!TITLE="Parameter MAX_QUERIES_PER_HOUR. Numeric value"!;
  7961.             $title_maxu     = qq!TITLE="Parameter MAX_UPDATES_PER_HOUR. Numeric value"!;
  7962.             $title_maxc     = qq!TITLE="Parameter MAX_CONNECTIONS_PER_HOUR. Numeric value "!;
  7963.             $queriesph        = quoteit($q->param('queriesph'));
  7964.             $updatesph        = quoteit($q->param('updatesph'));
  7965.             $connectionsph    = quoteit($q->param('connectionsph'));
  7966.         }
  7967.         else{
  7968.             $color_max        = "#999999";
  7969.             $queriesph        = $updatesph = $connectionsph = "N/A";
  7970.             $disabled_max    = 'DISABLED';
  7971.             $title_maxq = $title_maxu = $title_maxc = qq!TITLE="These options require MySQL server version 4.0.2 or higher"!;
  7972.         }
  7973.         if(check_version("4.0.4")){
  7974.             $title_req                = qq!TITLE="Check this to use the options below"!;
  7975.             $cipher                    = quoteit($q->param('cipher'));
  7976.             $issuer                    = quoteit($q->param('issuer'));
  7977.             $subject                = quoteit($q->param('subject'));
  7978.             $requirecheck            = "CHECKED" if $q->param('require');
  7979.             $require_opt_check[0]     = "CHECKED" if ($q->param('require_opt') eq 'none');
  7980.             $require_opt_check[1]     = "CHECKED" if ($q->param('require_opt') eq 'ssl');
  7981.             $require_opt_check[2]     = "CHECKED" if ($q->param('require_opt') eq 'x509');
  7982.             $require_opt_check[3]     = "CHECKED" if ($q->param('require_opt') eq 'other');
  7983.         }
  7984.         else{
  7985.             $title_req        = $title1 = qq!TITLE="These options require MySQL server version 4.0.4 or higher"!;
  7986.             $color            = "#999999";
  7987.             $requirecheck    = $disabled = 'DISABLED';
  7988.             $cipher         = $issuer = $subject = "N/A";
  7989.             for(my $i = 0; $i < 4; $i++){$require_opt_check[$i] = 'DISABLED'}
  7990.         }
  7991.         my $h1    = $agent ? 140    : 105;
  7992.         my $r1    = $agent ? 1    : 2;
  7993.         my $c1    = $agent ? 10    : 16;
  7994.         my $s1    = $agent ? 3    : 4;
  7995.         
  7996.             return qq!
  7997. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=2 WIDTH="100" style="color: $color; font-weight: bold">
  7998.     <TR>
  7999.         <TD COLSPAN=4 HEIGHT=5></TD>
  8000.     </TR>
  8001.     <TR>
  8002.         <TD BGCOLOR="#AAAAAA">
  8003.     <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%"><TR><TD BGCOLOR="#CCCCCC" HEIGHT=20>
  8004. <INPUT TYPE=CHECKBOX NAME="require" $requirecheck $title_req>
  8005.     </TD></TR></TABLE>
  8006.         </TD>
  8007.         <TD COLSPAN=3 BGCOLOR="#AAAAAA" $title_req>
  8008.     <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 BGCOLOR="#CCCCCC" WIDTH="100%"><TR><TD BGCOLOR="#CCCCCC" HEIGHT=20><P style="color: $color; font-weight: bold" >REQUIRE:</p></TD></TR></TABLE>
  8009.     </TD>
  8010.     </TR>
  8011.     <TR>
  8012.         <TD BGCOLOR="#AAAAAA">
  8013.         
  8014. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%"><TR><TD BGCOLOR="#CCCCCC" HEIGHT=20>        
  8015.         <INPUT NAME="require_opt" TYPE=RADIO VALUE="none" $require_opt_check[0] $title1>
  8016. </TD></TR></TABLE>
  8017.         
  8018.         </TD><TD COLSPAN=3 BGCOLOR="#AAAAAA">
  8019. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%"><TR><TD BGCOLOR="#CCCCCC" HEIGHT=20 $title1><P style="color: $color">
  8020.         NONE
  8021. </TD></TR></TABLE>
  8022.         </TD>
  8023.     </TR>
  8024.     <TR>
  8025.         <TD WIDTH="10%" BGCOLOR="#AAAAAA">
  8026. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%"><TR><TD BGCOLOR="#CCCCCC" HEIGHT=20>        
  8027.         <INPUT NAME="require_opt" TYPE=RADIO VALUE="ssl" $require_opt_check[1] $title1>
  8028. </TD></TR></TABLE>
  8029.         </TD>
  8030.         <TD WIDTH="40%" BGCOLOR="#AAAAAA">
  8031. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%"><TR><TD BGCOLOR="#CCCCCC" HEIGHT=20 $title1><P style="color: $color">
  8032.         SSL
  8033. </TD></TR></TABLE>
  8034.         </TD>
  8035.         <TD WIDTH="10%" BGCOLOR="#AAAAAA">
  8036. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%"><TR><TD BGCOLOR="#CCCCCC" HEIGHT=20>        
  8037.         <INPUT NAME="require_opt" TYPE=RADIO VALUE="x509" $require_opt_check[2] $title1>
  8038. </TD></TR></TABLE>
  8039.         </TD>
  8040.         <TD WIDTH="40%" BGCOLOR="#AAAAAA">
  8041. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%"><TR><TD BGCOLOR="#CCCCCC" HEIGHT=20 $title1><P style="color: $color">
  8042.         X509
  8043. </TD></TR></TABLE>
  8044.         </TD>
  8045.     </TR>
  8046.     <TR>
  8047.         <TD VALIGN=TOP BGCOLOR="#AAAAAA">
  8048. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%"><TR><TD BGCOLOR="#CCCCCC" HEIGHT=$h1>
  8049.         <INPUT NAME="require_opt" TYPE=RADIO VALUE="other" $require_opt_check[3] $title1>
  8050. </TD></TR></TABLE>
  8051.         </TD><TD COLSPAN=3 BGCOLOR="#AAAAAA">
  8052.         
  8053.         <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%" BGCOLOR="#CCCCCC" HEIGHT=$h1>    
  8054.         <TR><TD $title1><P style="color: $color">cipher</TD><TD><TEXTAREA COLS=$c1 ROWS=$r1 NAME="cipher" SCROLLING=OFF $title1 $disabled>$cipher</TEXTAREA></TD></TR>
  8055.         <TR><TD $title1><P style="color: $color">issuer</TD><TD><TEXTAREA COLS=$c1 ROWS=$r1 NAME="issuer" SCROLLING=OFF $title1 $disabled>$issuer</TEXTAREA></TD></TR>
  8056.         <TR><TD $title1><P style="color: $color">subject</TD><TD><TEXTAREA COLS=$c1 ROWS=$r1 NAME="subject" SCROLLING=OFF $title1 $disabled>$subject</TEXTAREA></TD></TR>
  8057.         </TABLE>
  8058.         
  8059.         </TD>
  8060.     </TR>
  8061.     <TR>
  8062.         <TD COLSPAN=4 HEIGHT=5></TD>
  8063.     </TR>
  8064.     <TR>
  8065.         <TD COLSPAN=4 BGCOLOR="#AAAAAA">
  8066. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH="100%" BGCOLOR="#CCCCCC" >    
  8067. <TR><TD><P style="color: $color_max">max queries/hour</TD><TD><INPUT TYPE=TEXT NAME="queriesph" VALUE="$queriesph" $disabled_max SIZE=$s1 $title_maxq ></TD></TR>
  8068. <TR><TD><P style="color: $color_max">max updates/hour</TD><TD><INPUT TYPE=TEXT NAME="updatesph" VALUE="$updatesph" $disabled_max SIZE=$s1 $title_maxu ></TD></TR>
  8069. <TR><TD><P style="color: $color_max">max connections/hour</TD><TD><INPUT TYPE=TEXT NAME="connectionsph" VALUE="$connectionsph" $disabled_max SIZE=$s1 $title_maxc ></TD></TR>
  8070. </TABLE>
  8071.         </TD>
  8072.     </TR>
  8073. </TABLE>
  8074.  
  8075. !;
  8076.         
  8077.     };
  8078.     my $objectpriv;
  8079.     my $global_checkbox;
  8080.     if ($globs){
  8081.         $objectpriv = 1;
  8082.         my $size = 22;
  8083.         my @global_values = (
  8084.         'SELECT', 'INSERT','UPDATE','DELETE','CREATE', 'DROP', 'RELOAD', 
  8085.         'SHUTDOWN', 'PROCESS', 'FILE', 'REFERENCES', 'INDEX', 'ALTER'
  8086.         );
  8087.         my @global_values_ext = (
  8088.         'SHOW DATABASES', 'SUPER', 'CREATE TEMPORARY TABLES', 'LOCK TABLES',
  8089.         'EXECUTE', 'REPLICATION CLIENT', 'REPLICATION SLAVE'
  8090.         );
  8091.         
  8092.         
  8093.         if (check_version("4.0.2")){
  8094.             foreach (@global_values, @global_values_ext, "GRANT"){
  8095.                 my $selected        = "SELECTED" if belongs(\@global, $_);
  8096.                 $global_checkbox    .= qq!<OPTION VALUE="$_" $selected>$_\n!; 
  8097.             }
  8098.         }
  8099.         else {
  8100.             foreach (@global_values, 'GRANT'){
  8101.                 my $selected        = "SELECTED" if belongs(\@global, $_);
  8102.                 $global_checkbox    .= qq!<OPTION VALUE="$_" $selected>$_\n!; 
  8103.             }
  8104.  
  8105.             my $style = qq!STYLE="color: #bbbbbb;"!;
  8106.             foreach (@global_values_ext){
  8107.                 my $element = (lc $_);
  8108.                 $global_checkbox    .= qq!<OPTION VALUE="" $style>(N/A) $element\n!;
  8109.             }
  8110.         }
  8111.         
  8112.         
  8113.         $global_checkbox    .= qq!<OPTION VALUE="">\n!;
  8114.         $global_checkbox    .= qq!</SELECT><br>!;
  8115.         $global_checkbox    .= &$v402;
  8116.         $global_checkbox = qq!<SELECT NAME="global" MULTIPLE SIZE=$size>\n! . $global_checkbox;
  8117.         
  8118.     }
  8119.                             
  8120.     if ($dbs) {
  8121.         my $size = 13;
  8122.         my @database = $q->param('database');
  8123.         my @database_values_ext = ('LOCK TABLES', 'CREATE TEMPORARY TABLES');
  8124.         if (check_version("4.0.4")){
  8125.             foreach (@database_values, @database_values_ext, 'GRANT'){
  8126.                 my $selected        = "SELECTED" if belongs(\@database, $_);
  8127.                 $database_checkbox    .= qq!<OPTION VALUE="$_" $selected>$_\n!;
  8128.             }
  8129.         }
  8130.         else{
  8131.             foreach (@database_values, 'GRANT'){
  8132.                 my $selected        = "SELECTED" if belongs(\@database, $_);
  8133.                 $database_checkbox    .= qq!<OPTION VALUE=$_ $selected>$_\n!;
  8134.             }
  8135.             my $style = qq!STYLE="color: #bbbbbb;"!;
  8136.  
  8137.             foreach (@database_values_ext){
  8138.                 $_ = lc $_;
  8139.                 $database_checkbox .= qq!<OPTION VALUE="" $style>(N/A) $_\n!;
  8140.             }
  8141.         }
  8142.         $database_checkbox = qq!<SELECT NAME="database" MULTIPLE SIZE=$size>\n$database_checkbox<OPTION VALUE="">\n</SELECT><br>!;
  8143.         $database_checkbox = <<EOT
  8144.                     <TR>
  8145.                         <TD TITLE="Choose Database Privileges" COLSPAN=2>$database_checkbox</TD>
  8146.                     </TR>
  8147. EOT
  8148. ;
  8149.         
  8150.         unless ($objectpriv){
  8151.             $database_checkbox .= qq!
  8152.                     <TR>
  8153.                         <TD TITLE="Choose Database Privileges" COLSPAN=2 ALIGN=RIGHT>! . &$v402 . qq!</TD>
  8154.                     </TR>
  8155.             
  8156. !
  8157. ;
  8158.         }
  8159.         $objectpriv            = 1;
  8160.         $d_dblist         =    <<EOT    
  8161.                     <TR>
  8162.                         <TD ALIGN=RIGHT VALIGN=MIDDLE TITLE="Select one or more databases"><B>Db</B></TD>
  8163.                         <TD ALIGN=RIGHT TITLE="Select one or more databases">$d_dblist</TD>
  8164.                     </TR>
  8165. EOT
  8166. ;
  8167.         my $d1db = $q->textfield(-name=>'d1_db', -size=>$textsize, -title=>"Type database names (comma separated).\nPlaceholder `?' will be substituted\nwith user name for each user." );
  8168.         $d1_db            =     <<EOT
  8169.                     <TR>
  8170.                         <TD COLSPAN=2 ALIGN=RIGHT TITLE="Type database names (comma separated).\nPlaceholder `?' will be substituted\nwith user name for each user."><I>Other Db </I>$d1db</TD>
  8171.                     </TR>
  8172. EOT
  8173. ;
  8174.     } else {$d_dblist = ''; }
  8175.     my $table_checkbox_t;
  8176.     if ($tables){
  8177.         $table_checkbox_t = $q->scrolling_list(
  8178.                               -name        => 'table_t',
  8179.                             -values        => $table_values,
  8180.                             -size        =>11,
  8181.                             -multiple    =>1
  8182.                             );
  8183.         my $ext = qq!
  8184.                 <TR>
  8185.                     <TD COLSPAN=2 ALIGN=RIGHT>! . &$v402 . qq!</TD>
  8186.                 </TR>
  8187. ! unless ($objectpriv);
  8188.         $objectpriv            = 1;
  8189.         $t_dblist = <<EOT
  8190.             <TABLE BORDER=0 WIDTH="100%">
  8191.                 <TR>
  8192.                     <TD TITLE="Select database"><INPUT TYPE=SUBMIT VALUE=">" TITLE="Reload page to apply changes"> <B>Db</B></TD>
  8193.                     <TD TITLE="Select database" ALIGN=RIGHT>$t_dblist</TD>
  8194.                 </TR>
  8195.                 $T_Table
  8196.                 <TR HEIGHT=6>
  8197.                     <TD HEIGHT=6></TD>
  8198.                     <TD HEIGHT=6></TD>
  8199.                 </TR>
  8200.                 <TR>
  8201.                     
  8202.                     <TD TITLE="Choose table privileges" COLSPAN=2 ALIGN=RIGHT>$table_checkbox_t</TD>
  8203.                 </TR>
  8204. $ext
  8205.             </TABLE>
  8206. EOT
  8207. ;
  8208.  
  8209.     }
  8210.     else {$t_dblist = ''}
  8211.     my $column_checkbox;
  8212.     if ($columns){
  8213.         $column_checkbox = $q->scrolling_list(
  8214.                               -name        => 'column',
  8215.                             -values        => $column_values,
  8216.                             -size        => 4,
  8217.                             -multiple    => 1
  8218.                             ) ;
  8219.         my $ext = qq!
  8220.                 <TR>
  8221.                     <TD COLSPAN=2 ALIGN=RIGHT>! . &$v402 . qq!</TD>
  8222.                 </TR>
  8223. ! unless ($objectpriv);
  8224.  
  8225.         $c_dblist = <<EOT
  8226.                 <TABLE BORDER=0 WIDTH="100%">
  8227.                 <TR>
  8228.                     <TD TITLE="Select database"><INPUT TYPE=SUBMIT VALUE=">" TITLE="Reload page to apply changes"> <B>Db</B></TD>
  8229.                     <TD ALIGN=RIGHT TITLE="Select database">$c_dblist</TD>
  8230.                 </TR>
  8231.                 $C_Other_Db
  8232.                 $C_Table
  8233.                 $C_Other_Table
  8234.                 $columnlist
  8235.                 $C_Other_Column
  8236.                 <TR HEIGHT=6>
  8237.                     <TD HEIGHT=6></TD>
  8238.                     <TD HEIGHT=6></TD>
  8239.                 </TR>
  8240.                 <TR>
  8241.                     <TD TITLE="Choose column privileges"> </TD>
  8242.                     <TD ALIGN=RIGHT TITLE="Choose column privileges">$column_checkbox</TD>
  8243.                 </TR>
  8244. $ext
  8245.                 </TABLE>
  8246. EOT
  8247. ;
  8248.     
  8249.     }
  8250.     else {$c_dblist = ''}
  8251.     my $action_bar    = <<EOT
  8252.     <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  8253.         <TR>
  8254.             <TD ALIGN=LEFT>
  8255.             <INPUT TYPE=RESET TITLE="Reset" style="width: 65">  
  8256.             <INPUT TYPE=SUBMIT VALUE="Reload" TITLE="Reload this page" style="width: 65">  <B>
  8257.             <INPUT TYPE=SUBMIT NAME="create" VALUE="$action" style="font-weight: bold" TITLE="Proceed with selected options"></B>
  8258.                 <I>Preview queries</I> <INPUT NAME="preview" TYPE=CHECKBOX CHECKED></TD>
  8259.         </TR>
  8260.         <TR HEIGHT=4><TD HEIGHT=4></TD</TR>
  8261.     </TABLE>
  8262. EOT
  8263.     if ($globs or $dbs or ($tables and $t_db) or ($columns and ($c_db and $c_table)) or $C_Other_Db);
  8264.  
  8265. print <<EOT
  8266. <!-- USER ACCOUNTS PROCEDURE STARTS HERE -->
  8267.  
  8268. <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
  8269.     <TR HEIGHT=10><TD ALIGN=LEFT HEIGHT=10></TD></TR>
  8270.     <TR>
  8271.         <TD>
  8272.     <FORM ACTION="$full_url" METHOD=POST>
  8273.  
  8274. $action_bar    
  8275.     <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 BGCOLOR="#AAAAAA"><!-- PRIVILEGES -->
  8276.  
  8277.         <TR><TD BGCOLOR="#AAAAAA"><!-- SET OF GLOBAL PRIVILEGES -->
  8278.             <TABLE BORDER=0 CELLPADDING=2 CELLSPACING=1 BGCOLOR="#AAAAAA">
  8279.                 <TR><TD BGCOLOR="#CCCCCC"><P TITLE="Check to assign Global Privileges"> <B><INPUT TYPE=SUBMIT        VALUE="Global privileges"     NAME="$global_priv"    style="font-weight: bold; width=150px" TITLE="Click to show/hide privileges"> </B></TD>
  8280.                     <TD BGCOLOR="#CCCCCC"><P TITLE="Check to assign Database Privileges"> <B><INPUT TYPE=SUBMIT    VALUE="Database privileges"    NAME="$db_priv"     style="font-weight: bold; width=150px" TITLE="Click to show/hide privileges"> </B></TD>
  8281.                     <TD BGCOLOR="#CCCCCC"><P TITLE="Check to assign Table Privileges"> <B><INPUT TYPE=SUBMIT        VALUE="Table privileges"    NAME="$table_priv"    style="font-weight: bold; width=150px" TITLE="Click to show/hide privileges"> </B></TD>
  8282.                     <TD BGCOLOR="#CCCCCC"><P TITLE="Check to assign Column Privileges"> <B><INPUT TYPE=SUBMIT        VALUE="Column privileges"    NAME="$column_priv"    style="font-weight: bold; width=150px" TITLE="Click to show/hide privileges"> </B></TD>
  8283.                 </TR>
  8284.                 <TR BGCOLOR="#AAAAAA">
  8285.                     <TD VALIGN=TOP BGCOLOR="#CCCCCC" ALIGN=LEFT><P> <BR><!-- GLOBAL PRIVILEGES -->
  8286. $global_checkbox
  8287.                 </TD>
  8288.                 <TD VALIGN=TOP BGCOLOR="#CCCCCC"><!-- DATABASE PRIVILEGES -->
  8289.                 <TABLE BORDER=0>
  8290.                     $d_dblist
  8291.                     $d1_db
  8292.                     <TR HEIGHT=6>
  8293.                         <TD HEIGHT=6 COLSPAN=2></TD>
  8294.                     </TR>
  8295.                     <TR>
  8296.                         <TD TITLE="Choose Database Privileges" COLSPAN=2>$database_checkbox</TD>
  8297.                     </TR>
  8298.                 </TABLE></TD>
  8299.                 <TD VALIGN=TOP BGCOLOR="#CCCCCC"><P><!-- TABLE PRIVILEGES -->
  8300.                 $t_dblist
  8301.                 </TD>
  8302.                 <TD VALIGN=TOP BGCOLOR="#CCCCCC"><P><!-- COLUMN PRIVILEGES -->
  8303.                 $c_dblist
  8304.                 </TD>
  8305.             </TR>    
  8306.             </TABLE>
  8307.         </TR></TD>
  8308.     </TABLE>
  8309.  
  8310.     <INPUT TYPE=HIDDEN NAME="page" VALUE="admin">
  8311.     <INPUT TYPE=HIDDEN NAME="func" VALUE="access">
  8312.     <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  8313.     <INPUT TYPE=HIDDEN NAME="action" VALUE="$action">
  8314.     $hidden_glob
  8315.     $hidden_db
  8316.     $hidden_table
  8317.     $hidden_column
  8318.     $hidden_userlist
  8319.     $hidden_password
  8320. </FORM>
  8321.     </TD></TR>
  8322.     </TABLE><BR>
  8323.  
  8324. <!-- USER access PROCEDURE STARTS HERE -->
  8325. EOT
  8326. ;
  8327.     print "\n\n<TABLE><TR><TD><B>USER LIST:</B></TD></TR>\n";
  8328.     foreach (@userlist){print "\t<TR><TD><B>$_</B></TD></TR>\n"}
  8329.     print "</TABLE>\n";
  8330.       return
  8331. }
  8332. sub setup {
  8333.     if ($q->param('cancel')){
  8334.         $page= '';
  8335.         logout();
  8336.         return
  8337.     }
  8338.     if ($q->param('save')){
  8339.         sub exitonerror{
  8340.             print     $q->header();
  8341.             &startpage();
  8342.             print qq!<FORM ACTION="$full_url" METHOD=POST>\n!;
  8343.             print <<EOT
  8344. <FONT COLOR="#FF0000">$_[0]</FONT><BR>
  8345.         <P><INPUT TYPE=SUBMIT VALUE="BACK">
  8346.         <INPUT TYPE=HIDDEN NAME="page" VALUE="setup" >
  8347.         </FORM>
  8348. </TD></TR></TABLE>
  8349. </BODY>
  8350. </HTML>
  8351. EOT
  8352. ;
  8353. exit 0
  8354.         }
  8355.         if ($q->param('charset') !~ /iso-8859-1/i){
  8356.             local $SIG{__DIE__} = sub{
  8357.                 my $message = <<EOT
  8358. Perl module CGI.pm is outdated on this system.<br>
  8359. Please pass this message to your system administrator.<br>
  8360. You can not use Character Set other than ISO-8859-1 before the module CGI.pm is updated.
  8361. EOT
  8362. ;
  8363. &exitonerror($message);
  8364.             };
  8365.             $q->charset($CHARSET)
  8366.         }
  8367.         my @config;
  8368.         my ($userName, $Password, $type) = $q->cookie('mdm_setup');
  8369.         unless (open FH, "$configFile") {exitonerror ("$configFile, $!") }
  8370.         flock (FH,2) unless $WIN32;
  8371.         while(<FH>){
  8372.             push @config, $_;
  8373.         }
  8374.         flock (FH,8) unless $WIN32;
  8375.         close FH;
  8376.         my $i=0;
  8377.         unless ($q->param('new_admin')){
  8378.             my $config = readconfig(\@config);
  8379.             if (($config->{userName} ne $userName) or ($config->{Password} ne $Password)){
  8380.                 exitonerror("Login incorrect!")
  8381.             }
  8382.             
  8383.         }
  8384.         my $err_message;
  8385.         if($q->param('setPW')){
  8386.             unless ($q->param('userName') =~ /^\w+$/){
  8387.                 $err_message = "User name can not be blank and must consist of alphanumeric characters only.<BR>\n";
  8388.             }
  8389.             unless ($q->param('Password') =~ /^\w+$/){
  8390.                 $err_message .= "Password can not be blank and must consist of alphanumeric characters only.<BR>\n";
  8391.             }
  8392.             unless ($q->param('Password') eq $q->param('Password_')){
  8393.                 $err_message .= "Password was incorrect.<BR>\n"
  8394.             }
  8395.         }
  8396.         foreach(@config){
  8397.             if (/^\s*#/ or /^\s*$/){$i++; next}
  8398.             s/^\s*(\S+.*\S*)\s*$/$1/;
  8399.             if (/^userName\b/){
  8400.                 if ($q->param('setPW') and !$err_message){
  8401.                     $config[$i] = 'userName = '.$q->param('userName')."\n" ;
  8402.                 }
  8403.                 else {$config[$i] .= "\n" }
  8404.             }
  8405.             elsif(/^Password\b/){
  8406.                 if ($q->param('setPW') and !$err_message){
  8407.                         my $pw =  crypt $q->param('Password'), $q->param('userName');
  8408.                         $config[$i] = "Password=$pw\n";
  8409.                 }
  8410.                 else {$config[$i] .= "\n";}
  8411.             }
  8412.             elsif(/^(\w*\b)/){
  8413.                 $config[$i] = "$1 = ".$q->param($1)."\n";
  8414.             }
  8415.             $i++;
  8416.         }
  8417.         unless (open FH, ">$configFile") {exitonerror ("$configFile, $!") }
  8418.         else {
  8419.             flock (FH,2) unless $WIN32;
  8420.             foreach (@config) {print FH }
  8421.             flock (FH,8) unless $WIN32;
  8422.             close FH;
  8423.         }
  8424.         if ($err_message){
  8425.             $err_message = "User name and password were not changed.<P>\n$err_message<BR>\n";
  8426.             exitonerror($err_message)
  8427.         }
  8428.         
  8429.         $page= '';
  8430.         logout();
  8431.         return
  8432.     }
  8433.     #print     $q->header();
  8434.     if ($q->param('login')){
  8435.         my $pw = crypt $q->param('Password'),$q->param('userName');
  8436.         my $cookies = $q->cookie(    
  8437.                             -name=>'mdm_setup',
  8438.                             -value=>[$q->param('userName'), $pw, 'glob'],
  8439.                             -secure=>0
  8440.                             );
  8441.         print     $q->header(-cookie=>$cookies, -expires=>0);
  8442.     }
  8443.     else {print     $q->header()}
  8444.     &startpage();
  8445.     print qq!<FORM ACTION="$full_url" METHOD=POST>\n!;
  8446.     printHeaderTable({name=>'SETUP'});
  8447.     my @config;
  8448.     my ($user_password,$config, $zip_CHECKED, $gzip_CHECKED);
  8449.     if (-e $configFile){
  8450.     my @params = qw(
  8451. userName 
  8452. Password
  8453. homeURL
  8454. helpURL
  8455. defaultSocket
  8456. defaultHost
  8457. defaultPort
  8458. mysql
  8459. otherMysql
  8460. userDirectory
  8461. backupMax
  8462. SQLMax
  8463. asciiMax
  8464. adminEmail
  8465. compressCommand
  8466. allowZIP
  8467. allowGZIP
  8468. zipSyntax
  8469. zipLog
  8470. printPopUp
  8471. bgcolor1
  8472. bgcolor2
  8473. statusfontcolor
  8474. logo
  8475. slogan
  8476. slogancolor
  8477. logolink
  8478. logotarget
  8479. charset
  8480. );
  8481.     
  8482.         open FH, $configFile or die $!;
  8483.         flock (FH,2) unless $WIN32;
  8484.         while(<FH>){
  8485.             push @config, $_;
  8486.         }
  8487.         flock (FH,8) unless $WIN32;
  8488.         close FH;
  8489.         $config         = readconfig(\@config);
  8490.         my @param_missing;
  8491.         foreach (@params){
  8492.             unless (exists $config->{$_}){push @param_missing, "$_ = \n"}
  8493.         }
  8494.         if (@param_missing){
  8495.             open FH, ">>$configFile" or exitonerror ("$configFile, $!");
  8496.             flock (FH,2) unless $WIN32;
  8497.             foreach (@param_missing) {print FH }
  8498.             flock (FH,8) unless $WIN32;
  8499.             close FH;
  8500.         }
  8501.     }
  8502.     else {
  8503.         @config = @{config()};
  8504.         unless (open FH, ">$configFile") {print qq?<FONT COLOR="#FF0000">$configFile, $!</FONT><BR>? }
  8505.         else {
  8506.             flock (FH,2) unless $WIN32;
  8507.             foreach (@config) {print FH "$_\n"}
  8508.             flock (FH,8) unless $WIN32;
  8509.             close FH;
  8510.             $config         = readconfig(\@config);
  8511.         }
  8512.     }
  8513.     my $new_admin;
  8514.     my $printPopUp_CHECKED     = 'CHECKED' if ($config->{printPopUp} > 0);
  8515.     my $allowZIP_CHECKED    = 'CHECKED' if ($config->{allowZIP} > 0);
  8516.     my $allowGZIP_CHECKED    = 'CHECKED' if ($config->{allowGZIP} > 0);
  8517.     if ($config->{compressCommand} eq 'zip'){$zip_CHECKED = 'CHECKED'}
  8518.     elsif ($config->{compressCommand} eq 'gzip'){$gzip_CHECKED = 'CHECKED'}
  8519.     
  8520.     if ($config->{userName}){
  8521.         unless ($q->param('login')){
  8522.             print <<EOT
  8523. <TABLE BORDER=0 CELLPADDING=2 CELLSPACING=0>
  8524.     <TR>
  8525.         <TD WIDTH=100 HEIGNT=30><P> </TD>
  8526.         <TD><P>Admin Name </TD>
  8527.         <TD><P><INPUT TYPE=TEXT NAME="userName" SIZE=25> </TD>
  8528.     </TR>    
  8529.     <TR>
  8530.         <TD WIDTH=100 HEIGNT=10><P> </TD>
  8531.         <TD HEIGNT=10><P> </TD>
  8532.         <TD HEIGNT=10><P> </TD>
  8533.     </TR>    
  8534.     <TR>
  8535.         <TD WIDTH=100 HEIGNT=30><P> </TD>
  8536.         <TD><P>Password </TD>
  8537.         <TD><P><INPUT TYPE=PASSWORD NAME="Password" SIZE=25> </TD>
  8538.     </TR>
  8539.     <TR>
  8540.         <TD WIDTH=100 HEIGNT=10><P> </TD>
  8541.         <TD HEIGNT=10><P> </TD>
  8542.         <TD HEIGNT=10><P> </TD>
  8543.     </TR>    
  8544.     <TR>
  8545.         <TD WIDTH=100 HEIGNT=30><P> </TD>
  8546.         <TD><P> </TD>
  8547.         <TD><P><INPUT TYPE=SUBMIT NAME="login" VALUE="SUBMIT" SIZE=30> </TD>
  8548.     </TR>
  8549. </TABLE>
  8550. <INPUT TYPE=HIDDEN NAME="page" VALUE="setup">
  8551. </FORM>
  8552. </TD></TR></TABLE>
  8553. </BODY>
  8554. </HTML>
  8555. EOT
  8556. ;
  8557.             return
  8558.         }
  8559.         my $pw = crypt $q->param('Password'), $q->param('userName');
  8560.         if (($config->{userName} ne $q->param('userName')) or ($pw ne $config->{Password})){
  8561.             
  8562.             print <<EOT
  8563.         <FONT COLOR="#FF0000"><B>INCORRECT USER NAME OR PASSWORD</B></FONT><P>
  8564.         <P><INPUT TYPE=SUBMIT VALUE="BACK">
  8565.         <INPUT TYPE=HIDDEN NAME="page" VALUE="setup">
  8566.         </FORM>
  8567. </TD></TR></TABLE>
  8568. </BODY>
  8569. </HTML>
  8570.  
  8571.  
  8572. EOT
  8573. ;
  8574.     return
  8575.         }
  8576.  
  8577.         $user_password     = "CHANGE USER NAME AND PASSWORD ";
  8578.         $new_admin        = '';
  8579.     }
  8580.  
  8581.     else {
  8582.         $user_password     = "CREATE ADMIN USER ";
  8583.         $new_admin        = '1';
  8584.     }
  8585.     foreach (keys %{$config}){$config->{$_} = quoteit $config->{$_}}    
  8586.     print <<EOT
  8587.                     
  8588.                     <TABLE BORDER=0 BGCOLOR="#CCCCCC" CELLPADDING=1 CELLSPACING=2 WIDTH=650>
  8589.                         <TR>
  8590.                             <TD ALIGN=RIGHT><P>
  8591. <TABLE BORDER=0 BGCOLOR="#AAAAAA" CELLPADDING=1 CELLSPACING=0><TR><TD>        
  8592.                     <TABLE BORDER=0 CELLSPACING=0 CELLPADDING=2 BGCOLOR="#CCCCCC">
  8593.                         <TR><TD COLSPAN=2><P><INPUT TYPE=CHECKBOX NAME="setPW" TITLE="Check to submit user name and password"> <B>$user_password</B></TD>
  8594.                         </TR>
  8595.                         <TR>
  8596.                             <TD><P>User Name:</TD>
  8597.                             <TD>
  8598.                                 <P><INPUT TYPE=TEXT NAME="userName" VALUE="" SIZE=20 
  8599.                                 TITLE="Admin user name.\nOnly alphanumeric characters are allowed"> 
  8600.                             </TD>
  8601.                         </TR>
  8602.                         <TR>
  8603.                             <TD><P>Password:</TD>
  8604.                             <TD>
  8605.                                 <P><INPUT TYPE=PASSWORD NAME="Password" VALUE="" SIZE=20 
  8606.                                 TITLE="Password.\nOnly alphanumeric characters are allowed"> 
  8607.                             </TD>
  8608.                         </TR>
  8609.                         <TR>
  8610.                             <TD><P>Confirm Password:</TD>
  8611.                             <TD>
  8612.                                 <P><INPUT TYPE=PASSWORD NAME="Password_" VALUE="" SIZE=20 
  8613.                                 TITLE="Confirm Password.\nOnly alphanumeric characters are allowed"> 
  8614.                             </TD>
  8615.                         </TR>
  8616.                     </TABLE></TD></TR></TABLE>
  8617.                             </TD>
  8618.                         </TR>
  8619.                         <TR>
  8620.                             <TD BGCOLOR="#AAAAAA">
  8621.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8622.                                     <TR>
  8623.                                         <TD WIDTH="48%"><P><B>PARAMETERS</B></TD>
  8624.                                         <TD WIDTH="51%"><P><B>DESCRIPTION</B></TD>
  8625.                                     </TR>
  8626.                                 </TABLE>
  8627.                             </TD>
  8628.                         </TR>
  8629.                         <TR>
  8630.                             <TD BGCOLOR="#AAAAAA"><P>
  8631.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8632.                                     <TR>
  8633.                                         <TD WIDTH="48%"><P>Home page URL:<BR>
  8634.                                         <INPUT TYPE=TEXT NAME="homeURL" VALUE="$config->{homeURL}" SIZE=32 
  8635.                                         TITLE="URL of your Home Page. For example,\n http://www.edatanew.com/index.html\nor ../index.html"> </TD>
  8636.                                         <TD WIDTH="51%"><P>Your home page URL. </TD>
  8637.                                     </TR>
  8638.                                 </TABLE>
  8639.                             </TD>
  8640.                         </TR>
  8641.                         <TR>
  8642.                             <TD BGCOLOR="#AAAAAA">
  8643.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8644.                                     <TR>
  8645.                                         <TD WIDTH="48%" HEIGHT=16><P>Help directory URL:<BR>
  8646.                                         <INPUT TYPE=TEXT NAME="helpURL" VALUE="$config->{helpURL}" SIZE=32 
  8647.                                         TITLE="URL of 'help' directory. For example,\nhttp://www.edatanew.com/help\nor  ../help"> </TD>
  8648.                                         <TD WIDTH="51%"><P>URL of directory where 'help' files are installed</TD>
  8649.                                     </TR>
  8650.                                 </TABLE>
  8651.                             </TD>
  8652.                         </TR>
  8653.                         <TR>
  8654.                             <TD BGCOLOR="#AAAAAA">
  8655.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8656.                                     <TR>
  8657.                                         <TD WIDTH="48%" HEIGHT=16><P>MYSQL CONNECTION PARAMETERS<BR><BR>Default socket<BR>
  8658.                                         <INPUT TYPE=TEXT NAME="defaultSocket" VALUE="$config->{defaultSocket}" SIZE=32 
  8659.                                         TITLE="These are connection parameters of the most frequently used Mysql server. If defined as default, it will be not necessarily to type them at login page.">
  8660.                                         <BR>Default host<BR>
  8661.                                         <INPUT TYPE=TEXT NAME="defaultHost" VALUE="$config->{defaultHost}" SIZE=32 
  8662.                                         TITLE="These are connection parameters of the most frequently used Mysql server. If defined as default, it will be not necessarily to type them at login page.">
  8663.                                         <BR>Default port number<BR>
  8664.                                         <INPUT TYPE=TEXT NAME="defaultPort" VALUE="$config->{defaultPort}" SIZE=16 
  8665.                                         TITLE="These are connection parameters of the most frequently used Mysql server. If defined as default, it will be not necessarily to type them at login page."> </TD>
  8666.                                         <TD WIDTH="51%"><P>Default socket, Default host and Default port are used when the field 'HOST:PORT' is blank (login page).<BR> </TD>
  8667.                                     </TR>
  8668.                                 </TABLE>
  8669.                             </TD>
  8670.                         </TR>
  8671.                         <TR>
  8672.                             <TD BGCOLOR="#AAAAAA">
  8673.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8674.                                     <TR>
  8675.                                         <TD WIDTH="100%" COLSPAN=2><P><I>mysql</I> CLIENT PARAMETERS (Restore databases)</TD>
  8676.                                    </TR>
  8677.                                     <TR>
  8678.                                         <TD WIDTH="48%" HEIGHT=16><P>Path to binary <i>mysql</i> client<BR>
  8679.                                         <INPUT TYPE=TEXT NAME="mysql" VALUE="$config->{mysql}" SIZE=32 MAXLENGTH=200
  8680.                                         TITLE="Path to binary mysql client.\nFor example,\n for Windows: c:\\mysql\\bin\\mysql.exe\n for Unix/Linux: /usr/local/mysql/bin/mysql">
  8681.                                         <TD WIDTH="51%"><P>Path to binary <i>mysql</i> client</TD>
  8682.                                     </TR>
  8683.                                     <TR>
  8684.                                         <TD WIDTH="48%" ><P>Other parameters<BR>
  8685.                                         <INPUT TYPE=TEXT NAME="otherMysql" VALUE="$config->{otherMysql}" SIZE=32 MAXLENGTH=200
  8686.                                         TITLE="You can use some additional parameters in mysql client call syntax">
  8687.                                         <TD WIDTH="51%"><P>Additional parameters used to call <i>mysql</i><br>
  8688.                                         For example 'SILENT' AND 'COMPRESS': -s -C</TD>
  8689.                                     </TR>
  8690.                                 </TABLE>
  8691.                             </TD>
  8692.                         </TR>
  8693.                         <TR>
  8694.                             <TD BGCOLOR="#AAAAAA">
  8695.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8696.                                     <TR>
  8697.                                         <TD WIDTH="48%" HEIGHT=16><P>Path to user directory:<BR>
  8698.                                         <INPUT TYPE=TEXT NAME="userDirectory" VALUE="$config->{userDirectory}" SIZE=32 MAXLENGTH=200
  8699.                                         TITLE="Path to user directory.\nFor example,\nfor Windows: C:\\MYDOCU~1\\DATA\\USR\nfor Unix/Linux: /home/mydirname/usr"> </TD>
  8700.                                         <TD WIDTH="51%"><P>Path to directory where user subdirectories are stored.</TD>
  8701.                                     </TR>
  8702.                                 </TABLE>
  8703.                             </TD>
  8704.                         </TR>
  8705.                         <TR>
  8706.                             <TD BGCOLOR="#AAAAAA">
  8707.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8708.                                     <TR>
  8709.                                         <TD WIDTH="48%" HEIGHT=16><P>Max. total size of backup files (per user): <BR>
  8710.                                         <INPUT TYPE=TEXT NAME="backupMax" VALUE="$config->{backupMax}" SIZE=10 MAXLENGTH=10
  8711.                                         TITLE="Maximum total size of backup files per user [kilobytes].\nZero value or blank field means 'Unlimited'"> [kbyte] </TD>
  8712.                                         <TD WIDTH="51%"><P>Maximum allowed total size of bacup files for each user (in kilobytes)</TD>
  8713.                                     </TR>
  8714.                                 </TABLE>
  8715.                             </TD>
  8716.                         </TR>
  8717.                         <TR>
  8718.                             <TD BGCOLOR="#AAAAAA">
  8719.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8720.                                     <TR>
  8721.                                         <TD WIDTH="48%" HEIGHT=16><P>Max. total size of SQL scripts (per user):<BR>
  8722.                                         <INPUT TYPE=TEXT NAME="SQLMax" VALUE="$config->{SQLMax}" SIZE=10 MAXLENGTH=10
  8723.                                         TITLE="Maximum total size of SQL scripts per user [kilobytes].\nZero value or blank field means 'Unlimited'"> [kbyte]</TD>
  8724.                                         <TD WIDTH="51%"><P>Maximum allowed total size of SQL scripts for each user (in kilobytes)</TD>
  8725.                                     </TR>
  8726.                                 </TABLE>
  8727.                             </TD>
  8728.                         </TR>
  8729.                         <TR>
  8730.                             <TD BGCOLOR="#AAAAAA">
  8731.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8732.                                     <TR>
  8733.                                         <TD WIDTH="48%" HEIGHT=16><P>Max. total size of ASCII delimited files (per user):<BR>
  8734.                                         <INPUT TYPE=TEXT NAME="asciiMax" VALUE="$config->{asciiMax}" SIZE=10 MAXLENGTH=10
  8735.                                         TITLE="Maximum total size of ASCII delimited files per user [kilobytes].\nZero value or blank field means 'Unlimited'"> [kbyte]</TD>
  8736.                                         <TD WIDTH="51%"><P>Maximum allowed total size of ASCII delimited files for each user (in kilobytes)</TD>
  8737.                                     </TR>
  8738.                                 </TABLE>
  8739.                             </TD>
  8740.                         </TR>
  8741.                         <TR>
  8742.                             <TD BGCOLOR="#AAAAAA">
  8743.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8744.                                     <TR>
  8745.                                         <TD WIDTH="48%" HEIGHT=16><P>Administrator email:<BR>
  8746.                                         <INPUT TYPE=TEXT NAME="adminEmail" VALUE="$config->{adminEmail}" SIZE=32 MAXLENGTH=200
  8747.                                         TITLE="Put your administrator email address here"> </TD>
  8748.                                         <TD WIDTH="51%"><P>Email address used in error messages</TD>
  8749.                                     </TR>
  8750.                                 </TABLE>
  8751.                             </TD>
  8752.                         </TR>
  8753.                         <TR>
  8754.                             <TD BGCOLOR="#AAAAAA">
  8755.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8756.                                     <TR>
  8757.                                         <TD WIDTH="48%" HEIGHT=16><P>Compressing method:<BR>
  8758.                                         <INPUT TYPE=RADIO $zip_CHECKED NAME="compressCommand" VALUE="zip"
  8759.                                         TITLE="It defines, which method 'ZIP' or 'GZIP' will be used in 'Compress File' command"> zip 
  8760.                                         <INPUT TYPE=RADIO $gzip_CHECKED NAME="compressCommand" VALUE="gzip"
  8761.                                         TITLE="It defines, which method 'ZIP' or 'GZIP' will be used in 'Compress File' command"> gzip</TD>
  8762.                                         <TD WIDTH="51%"><P>Compressing method used by "Compress" command</TD>
  8763.                                     </TR>
  8764.                                 </TABLE>
  8765.                             </TD>
  8766.                         </TR>
  8767.                         <TR>
  8768.                             <TD BGCOLOR="#AAAAAA">
  8769.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8770.                                     <TR>
  8771.                                         <TD WIDTH="48%" HEIGHT=16><P>
  8772.                                         <INPUT TYPE=CHECKBOX NAME="allowZIP" VALUE="1" $allowZIP_CHECKED
  8773.                                         TITLE="Check to allow ZIP method to compress backup files"> Allow ZIP </TD>
  8774.                                         <TD WIDTH="51%"><P>Uncheck if zip utility is not installed</TD>
  8775.                                     </TR>
  8776.                                 </TABLE>
  8777.                             </TD>
  8778.                         </TR>
  8779.                         <TR>
  8780.                             <TD BGCOLOR="#AAAAAA">
  8781.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8782.                                     <TR>
  8783.                                         <TD WIDTH="48%" HEIGHT=16><P>
  8784.                                         <INPUT TYPE=CHECKBOX NAME="allowGZIP" VALUE="1" $allowGZIP_CHECKED
  8785.                                         TITLE="Check to allow GZIP method to compress backup files"> Allow GZIP </TD>
  8786.                                         <TD WIDTH="51%"><P>Uncheck if gzip utility is not installed</TD>
  8787.                                     </TR>
  8788.                                 </TABLE>
  8789.                             </TD>
  8790.                         </TR>
  8791.                         <TR>
  8792.                             <TD BGCOLOR="#AAAAAA">
  8793.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8794.                                     <TR>
  8795.                                         <TD WIDTH="48%" HEIGHT=16><P>ZIP call syntax:<BR>
  8796.                                         <INPUT TYPE=TEXT NAME="zipSyntax" VALUE="$config->{zipSyntax}" SIZE=16 
  8797.                                         TITLE="For Windows command line utility 'Wzzip' syntax is: 'Wzzip -Pr' \nFor Unix/Linux zip utility: 'zip -qj'"> </TD>
  8798.                                         <TD WIDTH="51%"><P>Syntax used to call ZIP utility.</TD>
  8799.                                     </TR>
  8800.                                 </TABLE>
  8801.                             </TD>
  8802.                         </TR>
  8803.                         <TR>
  8804.                             <TD BGCOLOR="#AAAAAA">
  8805.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8806.                                     <TR>
  8807.                                         <TD WIDTH="48%" HEIGHT=16><P>Syntax to suppress the output from ZIP utility<BR>
  8808.                                         <INPUT TYPE=TEXT NAME="zipLog" VALUE="$config->{zipLog}" SIZE=16 
  8809.                                         TITLE="In the case of Windows command line ZIP utility 'Wzzip' this syntax looks like: 1>NUL"> </TD>
  8810.                                         <TD WIDTH="51%"><P>Some command lline ZIP programs print output information that must be 
  8811.                                         suppressed using this syntax.</TD>
  8812.                                     </TR>
  8813.                                 </TABLE>
  8814.                             </TD>
  8815.                         </TR>
  8816.                         <TR>
  8817.                             <TD BGCOLOR="#AAAAAA">
  8818.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8819.                                     <TR>
  8820.                                         <TD WIDTH="48%" HEIGHT=16><P>
  8821.                                         <INPUT TYPE=CHECKBOX NAME="printPopUp" VALUE="1" $printPopUp_CHECKED 
  8822.                                         TITLE="Check to enable print pop up window"> Print Pop Up </TD>
  8823.                                         <TD WIDTH="51%"><P>Unchech if your browser does not support JavaScript function window.print(), or you do not want print pop up window to appear </TD>
  8824.                                     </TR>
  8825.                                 </TABLE>
  8826.                             </TD>
  8827.                         </TR>
  8828.                         <TR>
  8829.                             <TD BGCOLOR="#AAAAAA">
  8830.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8831.                                     <TR>
  8832.                                         <TD WIDTH="48%" HEIGHT=16><P>Specify the character set<BR>
  8833.                                         <INPUT TYPE=TEXT NAME="charset" VALUE="$CHARSET" SIZE=16
  8834.                                         TITLE="Specify the character set to be used in the documents"></TD>
  8835.                                         <TD WIDTH="51%"><P>Specify the character set to be used in the documents and forms. The default value is ISO-8859-1. Leave it blank if you are not sure.</TD>
  8836.                                     </TR>
  8837.                                 </TABLE>
  8838.                             </TD>
  8839.                         </TR>
  8840.                         
  8841.                         <TR>
  8842.                             <TD BGCOLOR="#AAAAAA">
  8843.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8844.                                     <TR>
  8845.                                         <TD WIDTH="48%" HEIGHT=16><P>SETTING UP OF LOOK AND FEEL</TD>
  8846.                                         <TD WIDTH="51%"><P> </TD>
  8847.                                     </TR>
  8848.                                 </TABLE>
  8849.                             </TD>
  8850.                         </TR>
  8851.                         
  8852.                         <TR>
  8853.                             <TD BGCOLOR="#AAAAAA">
  8854.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8855.                                     <TR>
  8856.                                         <TD WIDTH="48%" HEIGHT=16><P>The color of the upper part of the banner<BR>
  8857.                                         <INPUT TYPE=TEXT NAME="bgcolor1" VALUE="$config->{bgcolor1}" SIZE=16 
  8858.                                         TITLE="Color of the upper part of the banner"> </TD>
  8859.                                         <TD WIDTH="51%"><P>Hexadecimal value. 336699 by default.</TD>
  8860.                                     </TR>
  8861.                                 </TABLE>
  8862.                             </TD>
  8863.                         </TR>
  8864.                         <TR>
  8865.                             <TD BGCOLOR="#AAAAAA">
  8866.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8867.                                     <TR>
  8868.                                         <TD WIDTH="48%" HEIGHT=16><P>The color of the status bar<BR>
  8869.                                         <INPUT TYPE=TEXT NAME="bgcolor2" VALUE="$config->{bgcolor2}" SIZE=16 
  8870.                                         TITLE="Color of the status bar"> </TD>
  8871.                                         <TD WIDTH="51%"><P>Hexadecimal value. 003366 by default.</TD>
  8872.                                     </TR>
  8873.                                 </TABLE>
  8874.                             </TD>
  8875.                         </TR>
  8876.                         <TR>
  8877.                             <TD BGCOLOR="#AAAAAA">
  8878.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8879.                                     <TR>
  8880.                                         <TD WIDTH="48%" HEIGHT=16><P>Font color in the status bar<BR>
  8881.                                         <INPUT TYPE=TEXT NAME="statusfontcolor" VALUE="$config->{statusfontcolor}" SIZE=16 
  8882.                                         TITLE="Font color in the status bar"> </TD>
  8883.                                         <TD WIDTH="51%"><P>Hexadecimal value. 336699 by default.</TD>
  8884.                                     </TR>
  8885.                                 </TABLE>
  8886.                             </TD>
  8887.                         </TR>
  8888.                         <TR>
  8889.                             <TD BGCOLOR="#AAAAAA">
  8890.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8891.                                     <TR>
  8892.                                         <TD WIDTH="48%" HEIGHT=16><P>URL of logo image<BR>
  8893.                                         <INPUT TYPE=TEXT NAME="logo" VALUE="$config->{logo}" SIZE=16 
  8894.                                         TITLE="URL of logo image"> </TD>
  8895.                                         <TD WIDTH="51%"><P>Location of Logo Image. For example:<BR> http://www.mydomain.com/images/logo.jpg</TD>
  8896.                                     </TR>
  8897.                                 </TABLE>
  8898.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8899.                                     <TR>
  8900.                                         <TD WIDTH="48%" HEIGHT=16><P>Logo is linked to URL:<BR>
  8901.                                         <INPUT TYPE=TEXT NAME="logolink" VALUE="$config->{logolink}" SIZE=16 
  8902.                                         TITLE="Type web address the logo is linked to"> </TD>
  8903.                                         <TD WIDTH="51%"><P>Web address the logo is linket to. For example:<BR> http://www.mywebsite.com</TD>
  8904.                                     </TR>
  8905.                                 </TABLE>
  8906.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8907.                                     <TR>
  8908.                                         <TD WIDTH="48%" HEIGHT=16><P>Target window of Logo link<BR>
  8909.                                         <INPUT TYPE=TEXT NAME="logotarget" VALUE="$config->{logotarget}" SIZE=16 
  8910.                                         TITLE="Target window of Logo Link. Leave blank to open the link in the same window"> </TD>
  8911.                                         <TD WIDTH="51%"><P>Name of the target window (or frame) of the above link. For example:<BR>_blank - new window; _self - the same window</TD>
  8912.                                     </TR>
  8913.                                 </TABLE>
  8914.                             </TD>
  8915.                         </TR>
  8916.                         <TR>
  8917.                             <TD BGCOLOR="#AAAAAA">
  8918.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8919.                                     <TR>
  8920.                                         <TD WIDTH="48%" HEIGHT=16><P>Your company slogan<BR>
  8921.                                         <INPUT TYPE=TEXT NAME="slogan" VALUE="$config->{slogan}" SIZE=16 
  8922.                                         TITLE="Your company slogan"> </TD>
  8923.                                         <TD WIDTH="51%"><P>Text. For example: MYSQL DATA MANAGER (default value)</TD>
  8924.                                     </TR>
  8925.                                 </TABLE>
  8926.                             </TD>
  8927.                         </TR>
  8928.                         <TR>
  8929.                             <TD BGCOLOR="#AAAAAA">
  8930.                                 <TABLE BORDER=0 WIDTH="100%" BGCOLOR="#CCCCCC" CELLPADDING=2 CELLSPACING=0>
  8931.                                     <TR>
  8932.                                         <TD WIDTH="48%" HEIGHT=16><P>Slogan font color<BR>
  8933.                                         <INPUT TYPE=TEXT NAME="slogancolor" VALUE="$config->{slogancolor}" SIZE=16 
  8934.                                         TITLE="Slogan font color"> </TD>
  8935.                                         <TD WIDTH="51%"><P>Hexadecimal value. ffffff - by default</TD>
  8936.                                     </TR>
  8937.                                 </TABLE>
  8938.                             </TD>
  8939.                         </TR>
  8940.                         
  8941.                         <TR>
  8942.                             <TD ALIGN=RIGHT>
  8943.                             <INPUT TYPE=SUBMIT NAME="save" VALUE="SAVE AND EXIT">
  8944.                             <INPUT TYPE=SUBMIT NAME="cancel" VALUE="CANCEL">
  8945.                             <INPUT TYPE=RESET>
  8946.                             </TD>
  8947.                         </TR>
  8948.                     </TABLE>
  8949.                     <INPUT TYPE=HIDDEN NAME="page" VALUE="setup">
  8950.                     <INPUT TYPE=HIDDEN NAME="new_admin" VALUE="$new_admin">
  8951.  
  8952. </FORM>
  8953. </TD></TR></TABLE>
  8954. </BODY>
  8955. </HTML>
  8956.  
  8957. EOT
  8958. ;
  8959.     
  8960. }
  8961.  
  8962. sub getdatanstructure {
  8963.     my $hashref            = shift;
  8964.     my @tablelist         = @{$hashref->{tablelist}} if defined $hashref->{tablelist};
  8965.     my @newtablelist    = @{$hashref->{newtablelist}} if defined $hashref->{newtablelist};
  8966.     my $include            = $hashref->{include};
  8967.     my $dropifexists    = $hashref->{dropifexists};
  8968.     my $back            = $hashref->{back};
  8969.     my $comments        = $hashref->{comments};
  8970.     my @locks;
  8971.     my $filecontent        = '';
  8972.     if ($hashref->{lock}){
  8973.         my $query = "LOCK TABLES";
  8974.         foreach (@tablelist){
  8975.             push @locks, " $_ READ";
  8976.         }
  8977.         $query .= join(',',@locks);
  8978.         $dbh->do($query) or bail_out("Cannon lock!",$back);
  8979.     }
  8980.     my $j    = 0;
  8981.     my @filecontent;
  8982.     my $fk;
  8983.     foreach my $table (@tablelist) {
  8984. #        my $tbname        = "\n#\tTABLE $table \n" if $comments;
  8985.         my $text        = getCreateTableSQL({
  8986.             tabsref         => [$table],
  8987.             dropifexists     => "$dropifexists",
  8988.             newtabs         => $hashref->{newtablelist},
  8989.             back            => $back
  8990.             }) unless ($include eq 'data');
  8991.         if ($text =~ /FOREIGN KEY/si){$fk = 1}
  8992.         $text = "\n#\tTABLE $table \n$text" if $comments;
  8993.         unless ($include eq 'structure') {
  8994.             $text .= "\n#\tDUMPING DATA\n\n" if $comments;    
  8995.     
  8996.             my $query         = "SELECT * FROM $table";
  8997.             my ($sth, $res) = prepare_execute($query,$back);
  8998.             $table            = $newtablelist[$j] if $newtablelist[$j];
  8999.             while (my @row = $sth->fetchrow_array){
  9000.                 $text .= "INSERT INTO $table VALUES ( ";
  9001.                 my @rowdata;
  9002.                 for (my $i = 0; $i < @row; $i++) {
  9003.                     push @rowdata, $dbh->quote($row[$i]);
  9004.                 }
  9005.                 $text .= join (', ', @rowdata);
  9006.                 $text .= ");\n";
  9007.  
  9008.             }
  9009.             $sth->finish;
  9010.         }
  9011.         $text .= "\n#--------------------------------------------------------\n" if $comments;
  9012.         if ($fk){push @filecontent, $text} else {unshift @filecontent, $text}
  9013.         $j++;
  9014.         $fk = 0;
  9015.     }
  9016.     $filecontent = join '', @filecontent;
  9017.     $filecontent .= "#\tEND OF FILE\n" if ($filecontent and $comments);
  9018.     if ($hashref->{lock}){
  9019.         $dbh->do("UNLOCK TABLES") or bail_out("Cannot unlock!", $back);
  9020.     }
  9021.     return $filecontent
  9022. }
  9023. sub config {
  9024.     my $config = <<EOT
  9025. #######################################################################################
  9026. #                 MYSQL DATA MANAGER CONFIGURATION FILE
  9027. #######################################################################################
  9028. userName = 
  9029. Password = 
  9030. homeURL = 
  9031. helpURL = ../help
  9032. defaultSocket = 
  9033. defaultHost = localhost
  9034. defaultPort = 3306
  9035. mysql = /usr/local/mysql/bin/mysql
  9036. otherMysql = 
  9037. userDirectory = SET VALID VALUE!
  9038. backupMax = 200
  9039. SQLMax = 50
  9040. adminEmail = 
  9041. compressCommand = gzip
  9042. allowZIP = 1
  9043. allowGZIP = 1
  9044. zipSyntax = zip -qj
  9045. zipLog = 
  9046. printPopUp = 1
  9047. bgcolor1 = 336699
  9048. bgcolor2 = 003366
  9049. statusfontcolor = 336699
  9050. logo = 
  9051. slogan = Mysql Data Manager
  9052. slogancolor = ffffff
  9053. logolink = 
  9054. logotarget = _blank
  9055.  
  9056.  
  9057. EOT
  9058. ;
  9059.     my @config = split "\n", $config;
  9060.     return (\@config);
  9061. }
  9062. sub readconfig {
  9063.     my $config;
  9064.     my @config = @{$_[0]};
  9065.     foreach(@config){
  9066.         next if (/^\s*#/ or /^\s*$/);
  9067.         s/^\s*(\S+.*\S*)\s*$/$1/;
  9068.         if (/^\w*/){
  9069.             /^(\w*)\s*=\s*(\S*.*\S*)\s*$/;
  9070.             $config->{$1}=$2;
  9071.         }
  9072.     }
  9073.     return $config
  9074. }
  9075.  
  9076. sub checkuserdir {
  9077.         my $dirname                    = shift;
  9078.         my $userhost                = myhost();
  9079.         unless ((-e $USER_DIR) and (-d $USER_DIR)) {return "Cannot create user directory." unless mkdir $USER_DIR, 0777}
  9080.         my $userdir                    = "$USER_DIR$delim$user.$userhost";
  9081.         unless ((-e $userdir) and (-d $userdir)) {return "Cannot create directory $user.$userhost" unless mkdir $userdir, 0777 }
  9082.         $userdir                     = "$USER_DIR$delim$user.$userhost$delim$dirname";
  9083.         unless ((-e $userdir) and (-d $userdir)) {return "Cannot create directory $dirname." unless mkdir $userdir, 0777}
  9084.         return 0;
  9085.         
  9086. # see:     LoadRestore
  9087. #        suggest
  9088. #        create backup
  9089. #        loadImport
  9090. }
  9091. sub download {
  9092.     my $path_    = $_[0]; # Path to directory or -1 to download from variable $content
  9093.     my $file     = $_[1]; # File name to be downloaded. Must be defined
  9094.     my $content    = $_[2]; # If Path = -1, this shoud be array reference, containing downloadable information
  9095.     my $size = 0;
  9096.     my $EOL    = $WIN32 ? "\r\n" : "\n" ;
  9097.     if ($path_ == -1){
  9098.         foreach (@$content){
  9099.             $size += length ;
  9100.         }
  9101.         print "Content-disposition: application; filename=$file$EOL";
  9102.         print "Content-Type: application/download$EOL$EOL";
  9103.         binmode STDOUT;
  9104.         foreach (@$content){print}
  9105.     }
  9106.     else {
  9107.         my @stat = stat $path_.$delim.$file;
  9108.         $size = $stat[7];
  9109.         open FH, $path_.$delim.$file or return("Could not open file $path_$delim$file. $!");
  9110.         flock(FH, 2) unless $WIN32;
  9111.         binmode FH;
  9112. #        print "Content-type: application/download$EOL";
  9113. #        print  "Content-Length: $size$EOL";
  9114. #        print  "Content-Disposition: attachment; filename=$file$EOL";
  9115. #        print  "Content-Transfer-Encoding: binary$EOL$EOL";
  9116.         print "Content-disposition: application; filename=$file$EOL";
  9117.         print "Content-Type: application/download$EOL$EOL";
  9118.         binmode STDOUT;
  9119.         my $data;
  9120.         while (read FH, $data, 1024) {print $data}
  9121.         flock(FH, 8) unless $WIN32 ;
  9122.         close FH;
  9123.     }
  9124.     return undef;
  9125. }
  9126. sub backslash {
  9127.     my $input    = shift;
  9128.     $input        =~ s/\\a/\a/g;
  9129.     $input        =~ s/\\b/\b/g;
  9130.     $input        =~ s/\\e/\e/g;
  9131.     $input        =~ s/\\f/\f/g;
  9132.     $input        =~ s/\\n/\n/g;
  9133.     $input        =~ s/\\r/\r/g;
  9134.     $input        =~ s/\\t/\t/g;
  9135.     $input        =~ s{\&\#(\w+)\;}{
  9136.                 chr($1)
  9137.         }gsex;
  9138.     return $input
  9139. }
  9140. sub charesc {
  9141.     my $seq = ["+","?",".","*","^","\$","(",")","[","{","|","\\"];
  9142.     my @char = @_;
  9143.     foreach (@char){if (belongsb($seq, $_)){$_ = "\\".$_}}
  9144.     return @char if wantarray;
  9145.     return $char[0];    
  9146. }
  9147.  
  9148. sub import_ {
  9149.     my $input        = shift;
  9150.     my $back        = $input->{back};
  9151.     my @file         = $q->param('selectfilelist');
  9152.     if (@file > 1)        {return "Too many files selected"}
  9153.     unless ($file[0])    {return "Please select a file"}
  9154.  
  9155.     my $userhost    = myhost();
  9156.     my $userdir        = "$USER_DIR$delim$user.$userhost$delim" . "ascii";
  9157.     my $fterm         = $q->param('fterm1')    ? $q->param('fterm2')    : $q->param('fterm');
  9158.     my $fencl         = $q->param('fencl1')    ? $q->param('fencl2')    : $q->param('fencl');
  9159.     my $fesc         = $q->param('fesc1')    ? $q->param('fesc2')    : $q->param('fesc');
  9160.     my $lterm         = $q->param('lterm1')    ? $q->param('lterm2')    : $q->param('lterm');
  9161.     my $ignore        = $q->param('ignore');
  9162.     {
  9163.         my $long = "The `FIELDS [OPTIONALLY] ENCLOSED BY' and `FIELDS ESCAPED BY' values must be a single character or empty.\nThey can be specified as backslash followed by a letter: \\x,\nor as a Numeric Entity: &#xxx; (where xxx is character's three-digit numerical value)";
  9164.         if (length $fencl > 1 and ($fencl !~ /^(\\[a-zA-Z]|&#\d\d\d;)$/)) {
  9165.             return $long
  9166.         }
  9167.         if (length $fesc > 1 and ($fesc !~ /^(\\[a-zA-Z]|&#\d\d\d;)$/)) {
  9168.             return $long
  9169.         }
  9170.     }
  9171.     $ignore =~ s/^\s*(\S*)/$1/;
  9172.     $ignore =~ s/^(\S*)\s*/$1/;
  9173.     unless ($ignore =~ /^\d*$/){return "Parameter IGNORE ... LINES must consist of digits only"}
  9174.     $fterm            = backslash($fterm);
  9175.     $fencl            = backslash($fencl);
  9176.     $fesc            = backslash($fesc);
  9177.     $lterm            = backslash($lterm);
  9178.     my $content;
  9179.     open FH, "$userdir$delim$file[0]" or return (qq?$! "$file[0]"?);
  9180.     flock (FH,2) unless $WIN32;
  9181.     while (read FH, my $data, 1024) {$content .= $data}
  9182.     flock (FH,8) unless $WIN32;
  9183.     close FH;
  9184.     my $insert    = [[]];
  9185.     my $jj = 0;
  9186.     my $i = 0;
  9187.     my @esc = ();
  9188.         my %test;
  9189.  
  9190.     if ($q->param('mode') =~ /simple/i){
  9191.         $_ = $content;
  9192.         while (
  9193.             m/
  9194.                 (?:
  9195.                     (?<!$fesc)$fencl
  9196.                     ([^$fencl]*?(?:$fesc$fesc)+[^$fencl]*?)        #1
  9197.                     (?<!$fesc)$fencl
  9198.                     |
  9199.                     (?<!$fesc)$fencl
  9200.                     (.*?)                                        #2
  9201.                     $fesc(?!$fencl)
  9202.                     |
  9203.                     ([^\n\r$fterm$fesc]*?)                        #3
  9204.                 )?
  9205.                 ($fterm|\n|\r\n)
  9206.             /gxs
  9207.         )
  9208.         {
  9209.             my $cell            = $1.$2.$3;
  9210.             my $eoc                = $4;
  9211.             $cell                =~ s/$fesc$fencl/$fencl/g;
  9212.             $insert->[$jj]->[$i] = $cell;
  9213.             bail_out("Too big", $back) if ($i++ > 100000);
  9214.             if ($eoc ne $fterm){
  9215.                 if ($ignore){$ignore--;$insert->[0]=[]}
  9216.                 else {$jj++}
  9217.                 $i=0
  9218.             }
  9219.         }
  9220.     }# end of simple mode
  9221.     else {
  9222.         my $ii;
  9223.         foreach($fterm,$fencl,$fesc,$lterm){if ($_ ne ''){$esc[$ii] = "\\" unless m/[a-zA-Z0-9]/} ; $ii++} #m/[\+\?\.\*\^\$\(\)\[\{\|\\]/
  9224.         $_ = $content;
  9225.         my $lterm1;
  9226.         if ($lterm eq "\n"){$lterm1 = "\r"; $esc[4]="\\"}
  9227.         elsif ($lterm eq "\r"){$lterm1 = "\n"; $esc[4]="\\"}
  9228.         my $null = $fesc ? "$esc[2]$fesc"."N" : 'NULL';
  9229.         my $cut;
  9230.         my @lines = split /(?<!$esc[2]$fesc)(?:esc[3]$lterm$esc[4]$lterm1$|$esc[3]$lterm)/s, $_;
  9231.         foreach (@lines){
  9232.             while (
  9233.                 m/
  9234.                     (?:
  9235.                         ($null)                                        #1
  9236.                         |
  9237.                         (?<!$esc[2]$fesc)$esc[1]$fencl?
  9238.                         (.*?)                                        #2
  9239.                         (?<!$esc[2]$fesc)$esc[1]$fencl?
  9240.                     )?
  9241.                     ((?<!$esc[2]$fesc)(?:$esc[0]$fterm)|\z)    #3
  9242.                 /gxs
  9243.             )
  9244.             {
  9245. #             print "1-'$1'; 2-'$2', 3-'$3', 4-'$4'<BR>";
  9246.                 my $cell            = "$1$2";
  9247.                 my $eoc                = $3;
  9248.                 my $zero            = 0;
  9249.                 $cell                =~ s/$esc[2]$fesc$zero/chr(0)/gsxe;
  9250.                 $test{"$i-$4"} = $1 ;
  9251.                 if ($cell eq "$fesc"."N"){$cell = undef}
  9252.                 else {$cell            =~ s/$esc[2]$fesc([$esc[0]$fterm$esc[1]$fencl$esc[2]$fesc$esc[3]$lterm])/$1/g}
  9253.                 $insert->[$jj]->[$i] = $cell;
  9254.                 $i++;
  9255.                 
  9256.             }
  9257.             pop @{$insert->[$jj]};
  9258.             if ($ignore){$ignore--;$insert->[0]=[]}
  9259.             else {$jj++}
  9260.             $i=0;
  9261.         }
  9262.     }
  9263.  
  9264.  
  9265.     my $table = $q->param('tables');
  9266.     my ($sth,$res) = prepare_execute("SELECT * FROM $table WHERE 1=0");
  9267.     my $Type    = $sth->{TYPE};
  9268.     my $bool = $sth->{mysql_is_num};
  9269.     $sth->finish();
  9270.     for (my $i=0; $i<@$insert; $i++){
  9271.         for (my $j=0; $j<@{$insert->[$i]}; $j++){
  9272.             $insert->[$i]->[$j] = $dbh->quote($insert->[$i]->[$j]);
  9273. #            $insert->[$i]->[$j] = $dbh->quote($insert->[$i]->[$j], $Type->[$j]);
  9274.         }
  9275.     }
  9276.     my $insertopt;
  9277.     if ($q->param('replacekey') eq 'ignore'){
  9278.         $insertopt = 'INSERT IGNORE';
  9279.     }
  9280.     elsif ($q->param('replacekey') eq 'replace'){$insertopt = 'REPLACE'}
  9281.     elsif ($q->param('replacekey') eq 'error'){$insertopt = 'INSERT'}
  9282.     my @value = ();
  9283.     foreach (@$insert){
  9284.         my $value = join ',',@{$_};
  9285.         push @value, "(".$value.")"; 
  9286.     }
  9287.     if (check_version("3.22.5")){
  9288.         my $value =  join ",\n",@value;
  9289.         my $query = "$insertopt INTO $table VALUES\n$value";
  9290.         $dbh->do($query) || return "Cannot insert.\n$query";
  9291.         return "Selected file was imported successfully\n";
  9292.     }
  9293.     else{
  9294.         foreach (@value){
  9295.             my $query = "$insertopt INTO $table VALUES\n$_";
  9296.             $dbh->do($query) || return "Cannot insert.\n$query\n";
  9297.         }
  9298.     }
  9299.  
  9300.     
  9301. }
  9302. sub export_ {
  9303.     my $input        = shift;
  9304.     my $query        = $input->{query};
  9305.     my $back        = $input->{back};
  9306.     my @file         = ($q->param('exportintofile') eq 'new') ? $q->param('newfilename') : $q->param('selectfilelist');
  9307.     if (@file > 1)    {return "Too many files selected"}
  9308.     $file[0]        = deletespace($file[0]);
  9309.     if ($file[0]        =~ /[\/\\:\*\?\"<>]/){return qq!A filename cannot contain any of the following character:\n \\/:*?"<>|!}
  9310.     if (!$file[0] or ($file[0] eq 'NEW FILE NAME')){return "Please select a file or create a new one"}
  9311.     my ($sth, $res) = prepare_execute($query, $back);
  9312.     my $userhost    = myhost();
  9313.     my $userdir        = "$USER_DIR$delim$user.$userhost$delim" . "ascii";
  9314.     
  9315.     if ($q->param('exportintofile') eq 'new'){
  9316.         if (-e "$userdir$delim$file[0]"){return "File $file[0] already exists"}    
  9317.     }
  9318.     my $fterm         = $q->param('fterm1')    ? $q->param('fterm2')    : $q->param('fterm');
  9319.     my $fencl         = $q->param('fencl1')    ? $q->param('fencl2')    : $q->param('fencl');
  9320.     my $fesc         = $q->param('fesc1')    ? $q->param('fesc2')    : $q->param('fesc');
  9321.     my $lterm         = $q->param('lterm1')    ? $q->param('lterm2')    : $q->param('lterm');
  9322.     {
  9323.         my $long = "The `FIELDS [OPTIONALLY] ENCLOSED BY' and `FIELDS ESCAPED BY' values must be a single character or empty.\nThey can be specified as backslash followed by a letter: \\x,\nor as a Numeric Entity: &#xxx; (where xxx is character's three-digit numerical value)";
  9324.         if (length $fencl > 1 and ($fencl !~ /^(\\[a-zA-Z]|&#\d\d\d;)$/)) {
  9325.             return $long
  9326.         }
  9327.         if (length $fesc > 1 and ($fesc !~ /^(\\[a-zA-Z]|&#\d\d\d;)$/)) {
  9328.             return $long
  9329.         }
  9330.     }
  9331.     open FH, ">$userdir$delim$file[0]" or return (qq?$! "$file[0]"?);
  9332.     flock (FH,2) unless $WIN32;
  9333.     my $length             = $sth->{mysql_length};
  9334.     my $maxlength         = $sth->{mysql_max_length};
  9335.     my $Type             = $sth->{TYPE};
  9336.     my $mysql_type_name    = $sth->{mysql_type_name};
  9337.     my $Nullable         = $sth->{NULLABLE};
  9338.     my $Nameref            = $sth->{NAME};
  9339.     #($fterm,$fencl,$fesc,$lterm) = charesc($fterm,$fencl,$fesc,$lterm);
  9340.     $fterm            = backslash($fterm);
  9341.     $fencl            = backslash($fencl);
  9342.     $fesc            = backslash($fesc);
  9343.     $lterm            = backslash($lterm);
  9344.     my $zero        = chr(0);
  9345.     if ($q->param('mode') =~ /simple/i){
  9346.         if ($q->param('colnames')){
  9347.             my $result = join $fterm, @$Nameref;
  9348.             print FH $result, "\n";
  9349.         }
  9350.         while(my @result = $sth->fetchrow_array()){
  9351.             my $i = 0;
  9352.             foreach (@result){
  9353. # escape ENCLOSE and ESCAPE characters
  9354.                 s{$fencl}{$fesc.$fencl}gse;
  9355. # convert ASCII 0 into ASCII 48 and escape it
  9356.                 s{$zero}{$fesc."0"}gse;
  9357.                 #s/\x0D\x0D/\x0D/gm;
  9358. # enclose when appropriate
  9359.                 $_ = "$fencl$_$fencl" if /[$fterm"\n]/;
  9360.             }
  9361.             my $result = join $fterm,@result;                        # add FIELDS TERMINATED BY characters
  9362. #            print FH $result,$lterm;                                # add LINES TERMINATED BY characters
  9363.             print FH $result,"\n";                                # add LINES TERMINATED BY characters
  9364.         }    
  9365.         $sth->finish();
  9366.         flock (FH,8) unless $WIN32;
  9367.         close FH;
  9368.         return 0;
  9369.     }
  9370.     
  9371.     if (($lterm eq '') and $fterm){$lterm = $fterm}
  9372. # ........
  9373. # If the FIELDS TERMINATED BY and FIELDS ENCLOSED BY values are both empty (''), 
  9374. # a fixed-row (non-delimited) format is used. With fixed-row format, no delimiters are used between fields. 
  9375. # Instead, column values are written and read using the ``display'' widths of the columns. 
  9376. # For example, if a column is declared as INT(7), values for the column are written using 7-character fields. 
  9377. # On input, values for the column are obtained by reading 7 characters. 
  9378. # Fixed-row format also affects handling of NULL values; see below. 
  9379. # Note that fixed-size format will not work if you are using a multi-byte character set.
  9380. # NULLs are treated as empty strings
  9381. #.........
  9382. #                                                MySQL Manual
  9383. #
  9384.     my $fixed            = 0;
  9385.     if ($fencl eq '' and $fterm eq ''){
  9386.         unless (belongsb($Type, -1)){$fixed = 1}
  9387.     }
  9388.     
  9389.     my ($fencl_,$fesc_,$fterm_,$lterm_) = ($fencl,$fesc,$fterm,$lterm);
  9390.  
  9391.     while(my @result = $sth->fetchrow_array()){
  9392.         my $i = 0;
  9393.         foreach (@result){
  9394.             ($fencl,$fesc,$fterm,$lterm) = ($fencl_,$fesc_,$fterm_,$lterm_);
  9395.             if ($fixed){
  9396.                 my $len    = $length->[$i];
  9397.                 my $kk = (substr $_, 0, $len).(" " x($len - length $_));
  9398.                 $_ = $kk;
  9399.             }
  9400.             else {
  9401.                 my $esc = "\\";
  9402. # escape FIELDS ESCAPED BY characters
  9403.                 if ($fesc ne ''){
  9404.                     $fesc =~ /^(.)/s;
  9405.                     my $fc = $1;
  9406.                     if ($fesc =~ /[\+\?\.\*\^\$\(\)\[\{\|\\]/){
  9407.                         s{$esc$fc}{$fesc.$fc}gsex
  9408.                     }
  9409.                     else{s{$fc}{$fesc.$fc}gse}
  9410.                 }
  9411. # escape FIELDS ENCLOSED BY characters
  9412.                 $fencl =~ /^(.)/s;
  9413.                 if (($fesc ne $1) and ($fencl ne '')){
  9414.                     my $fc = $1;
  9415.                     if ($fencl =~ /[\+\?\.\*\^\$\(\)\[\{\|\\]/){s{$esc$fc}{$fesc.$fc}gse}
  9416.                     else{s{$fc}{$fesc.$fc}gse}
  9417.                 }
  9418. # escape The first character in FIELDS TERMINATED BY
  9419.                 $fterm =~ /^(.)/s;
  9420.                 if (($fesc ne $1) and ($fterm ne $fencl) and ($fterm ne '') and ($fencl eq '')){
  9421.                     my $fc = $1;
  9422.                     if ($fterm =~ /[\+\?\.\*\^\$\(\)\[\{\|\\]/){s{$esc$fc}{$fesc.$fc}gse}    
  9423.                     else {s{$fc}{$fesc.$fc}gse}        
  9424.                 }
  9425. # escape LINES TERMINATED BY characters
  9426.                 $lterm =~ /^(.)/s;
  9427.                 if (($fesc ne $1) and ($lterm ne $fencl) and ($lterm ne $fterm) and ($lterm ne '')){
  9428.                     my $fc = $1;
  9429.                     if ($lterm =~ /[\+\?\.\*\^\$\(\)\[\{\|\\]/){s{$esc$fc}{$fesc.$fc}gse}    
  9430.                     else {s{$fc}{$fesc.$fc}gse}        
  9431.                 }
  9432. # convert ASCII 0 into ASCII 48 and escape it
  9433.                 s{$zero}{$fesc."0"}gse unless ($lterm eq "");
  9434. # escape NULLs
  9435.                 unless (defined $_){$_ = ($fesc eq '') ? "NULL" : $fesc."N"} 
  9436. # enclose the correct data types
  9437.                 else {$_ = "$fencl$_$fencl"  if  (                    
  9438.                         !$q->param('optionally') or 
  9439.         ((abs $Type->[$i] <= 1) or (( $Type->[$i] >= 9 ) and (($Type->[$i]!=11) or $Nullable->[$i])))
  9440.                             )
  9441.                 }
  9442.             }
  9443.             #$_ = "<$_ LENGTH=$length->[$i], MAX_LENGTH=$maxlength->[$i], mTYPE=$Type->[$i], mTYPE_NAME=$mysql_type_name->[$i]>";  
  9444.             $i++;
  9445.         }
  9446.         my $result = join $fterm,@result;                        # add FIELDS TERMINATED BY characters
  9447.         print FH $result,$lterm;                                # add LINES TERMINATED BY characters
  9448.     }
  9449.     $sth->finish();
  9450.     flock (FH,8) unless $WIN32;
  9451.     close FH;
  9452.     return 0;
  9453. }
  9454. sub loadImportExportFile {
  9455.     my $border            = 0;
  9456.     my $input            = shift;
  9457.     my $func            = $q->param('func');
  9458.     my $action            = $q->param('action');
  9459.     my $userhost         = myhost();
  9460.     my $chkusrdir        =  checkuserdir('ascii');
  9461.     my $userdir            = "$USER_DIR$delim$user.$userhost$delim" . "ascii";
  9462.     my $mode            = $q->param('setmode') || $q->param('mode') || "simple";
  9463.     my $sql                = $q->param('query');
  9464.     my $back             = {    page => 'select_db', dbname => "$database"};
  9465.     my $table;            
  9466.     {
  9467.         my @table        = $q->param('tables'); 
  9468.         bail_out ("Too many tables selected", $back) if  @table > 1;
  9469.         $table            = $table[0];
  9470.     }
  9471.     $back->{page}                 = 'tables';
  9472.     $back->{func}                 = $func;
  9473.     $back->{tables}             = $table if $table;
  9474.     $back->{query}                = $sql if $sql;
  9475.     $back->{mode}                 = $mode;
  9476.     $back->{replacekey}         = $q->param('replacekey'); 
  9477.     $back->{fterm}                 = $q->param('fterm'); 
  9478.     $back->{fterm1}             = $q->param('fterm1'); 
  9479.     $back->{fterm2}             = $q->param('fterm2'); 
  9480.     $back->{fencl}                 = $q->param('fencl'); 
  9481.     $back->{fencl1}             = $q->param('fencl1'); 
  9482.     $back->{fencl2}             = $q->param('fencl2'); 
  9483.     $back->{fesc}                 = $q->param('fesc'); 
  9484.     $back->{fesc1}                 = $q->param('fesc1'); 
  9485.     $back->{fesc2}                 = $q->param('fesc2'); 
  9486.     $back->{lterm}                 = $q->param('lterm'); 
  9487.     $back->{lterm1}             = $q->param('lterm1'); 
  9488.     $back->{lterm2}             = $q->param('lterm2');
  9489.     $back->{exportintofile}     = $q->param('exportintofile');
  9490.     $back->{optionally}         = $q->param('optionally');
  9491.     $back->{colnames}             = $q->param('colnames');
  9492.     if ($func =~ /export/i){
  9493.         if (defined $q->param('SQL')){
  9494.             $back->{SQL}                 = $q->param('SQL');
  9495.             $back->{selectedscript}     = $q->param('selectedscript');
  9496.         }
  9497.         elsif (defined $q->param('select')){
  9498.             my $tables                    = $q->param('tables');
  9499.             my @cols                     = $q->param("fields_$tables");
  9500.             $back->{"select"}            = $q->param('select');
  9501.             $back->{where}                = $q->param('where');
  9502.             $back->{groupby}            = $q->param('groupby');
  9503.             $back->{orderby}            = $q->param('orderby');
  9504.             $back->{limit}                = $q->param('limit');
  9505.             $back->{"fields_$tables"}    = \@cols;
  9506.         }
  9507.         elsif (defined $q->param('searchresult')){
  9508.             my @fields                    = $q->param('fields');
  9509.             $back->{rows}                = $q->param('rows');
  9510.             $back->{order}                = $q->param('order');
  9511.             $back->{where}                = $q->param('where');
  9512.             $back->{start}                = $q->param('start');
  9513.             $back->{count}                = $q->param('count');
  9514.             $back->{searchresult}        = $q->param('searchresult');
  9515.             $back->{fields}                = \@fields;
  9516.         }
  9517.     }
  9518.     if ($action =~ /export/i){
  9519.         my $sql_        = $sql || "SELECT * FROM $table";
  9520.         if(my $errmsg = export_({query => $sql_, back => $back})){bail_out($errmsg, $back)}
  9521.     }
  9522.     elsif ($action =~ /import/i){
  9523.         if(my $errmsg = import_({back => $back})){bail_out($errmsg, $back)}
  9524.     }
  9525.     elsif ($action =~ /(alter)|(create)/i){
  9526.         &loadAlterTable({back => $back});
  9527.         return
  9528.     }
  9529.     elsif ($action =~ /download/i){
  9530.         my @file = $q->param('selectfilelist');
  9531.         bail_out("Too many files selected", $back) if (@file > 1);
  9532.         bail_out("Please select a file", $back) if (@file == 0);
  9533.         if (my $errmsg = download($userdir, $file[0])){bail_out($errmsg, $back)} 
  9534.         exit
  9535.     }
  9536.     elsif ($action =~ /upload/i){
  9537.         if (my $sourse = $q->param('localfile')) {
  9538.             my $dest = $sourse;
  9539.             $dest =~ s/^(.*[\/|\\])*(.*)/$2/;
  9540.             my $dest_ = $dest;
  9541.             my $filexist = sub {
  9542.                 if ($q->param('overwrite')){
  9543.                     unlink $_[0]
  9544.                 }
  9545.                 else {
  9546.                     close $sourse or bail_out("$!");
  9547.                     bail_out("File $dest_ already exists",$back)
  9548.                 }    
  9549.             };
  9550.             my $size_ = 0;
  9551.             if (-e "$userdir$delim$dest_") 
  9552.             {&$filexist("$userdir$delim$dest_"); $size_ = -s "$userdir$delim$dest_"}
  9553.             if ($MAX_ASCII_SIZE){
  9554.                 my $size = dirsize($userdir);
  9555.                 $size += (-s $sourse) - $size_;
  9556.                 if ($size > ($MAX_ASCII_SIZE*1024)) {
  9557.                     my $errmsg = "Total size of this directory is limited to $MAX_ASCII_SIZE kb.";
  9558.                     $errmsg .= "\nPlease delete some files before uploading.";            
  9559.                     bail_out("$errmsg",$back);
  9560.                 }
  9561.             }
  9562.             $dest = "$userdir$delim$dest";
  9563.             open (DEST, ">$dest") || bail_out ("$! $dest_", $back);
  9564.             flock (DEST,2) unless $WIN32;
  9565.             binmode $sourse;
  9566.             binmode DEST;
  9567.             my $data;
  9568.             while (read $sourse,$data,1024) {
  9569.                 print DEST $data;
  9570.             }
  9571.             flock (DEST,8) unless $WIN32;
  9572.             close DEST;
  9573.             close $sourse or bail_out($!);
  9574.         }
  9575.         else {bail_out("Please select file to upload", $back)}
  9576.     }
  9577.     elsif ($action =~ /edit/i){
  9578.         my @file = $q->param('selectfilelist');
  9579.         bail_out("Too many files selected", $back) if (@file > 1);
  9580.         bail_out("Please select a file", $back) if (@file == 0);
  9581.         my $errmsg = editfile({path => $userdir, back => $back});
  9582.         bail_out($errmsg, $back) if $errmsg;
  9583.         return 0 unless defined $errmsg
  9584.     }
  9585.     elsif ($action =~ /delete/i){
  9586.         my @file = $q->param('selectfilelist');
  9587.         bail_out("Please select a file", $back) if (@file == 0);
  9588.         my $errmsg = deletefiles({path => $userdir, back => $back});
  9589.         bail_out($errmsg, $back) if $errmsg;
  9590.         return 0 unless defined $errmsg;
  9591.     }
  9592.     my $multiform = $q->start_multipart_form(-action=>$full_url, -method=>"post");
  9593.     my $selectfilelist = qq!\n<SELECT NAME="selectfilelist" SIZE=8 MULTIPLE  TITLE="Select file">\n!;
  9594.     my $tsize        = 0;
  9595.     my @files         = ();
  9596.     my @lables        = ();
  9597.     unless ($chkusrdir){
  9598.  
  9599.         opendir DIR, $userdir; 
  9600.         my @filenames    = readdir (DIR) or print "Cannot read this directory: $userdir<br>";
  9601.         closedir DIR;
  9602.  
  9603.         foreach (@filenames){
  9604.             next if (($_ eq '.') or ($_ eq '..'));
  9605.             my $file  = "$userdir$delim$_";
  9606.             unless (-d $file){
  9607.                 my @stat = stat $file;
  9608.                 my $size = $stat[7];
  9609.                 $tsize += $size;
  9610.                 my $date = scalar localtime ($stat[9]);
  9611.                 $date =~ s/^\s*\w\w\w\s*(.*)/$1/;
  9612.                 s/^(.*[\/\\])*(.*)$/$2/;
  9613.                 push @files, $_;
  9614.                 push @lables, "$_ /$size/ $date";
  9615.             }
  9616.         }
  9617.         $tsize = int($tsize / 1024 * 100) / 100;
  9618.         if (@files == 0){$selectfilelist .=  "\t<OPTION VALUE=\"\">FILE LIST IS EMPTY"}
  9619.         else{
  9620.             @files         = quoteit(@files);
  9621.             @lables        = quoteit(@lables);
  9622.             for (my $j=0; $j<@files; $j++) {
  9623.                 $selectfilelist .= "\t<OPTION VALUE=\"$files[$j]\">$lables[$j]\n"
  9624.             }
  9625.         }
  9626.     }
  9627.     else {
  9628.         $selectfilelist .= qq!<OPTION VALUE="">$chkusrdir\n!;
  9629.         $selectfilelist .= qq?<OPTION VALUE="">$!\n?;
  9630.     }
  9631.     my $exportfile        = '';
  9632.     my $hidden = <<EOT
  9633. <INPUT TYPE=HIDDEN NAME="page"         VALUE="tables">
  9634. <INPUT TYPE=HIDDEN NAME="dbname"     VALUE="$database">
  9635. <INPUT TYPE=HIDDEN NAME="func"         VALUE="$func">
  9636. <INPUT TYPE=HIDDEN NAME="mode"         VALUE="$mode">
  9637. EOT
  9638. ;
  9639.     my $nameheader = uc $func;
  9640.     if ($func =~ /export/i){
  9641.         if (defined $sql){ # Export query result
  9642.             bail_out ("Query is empty", {dbname => $database, page => 'select_db'}) unless $sql;
  9643.             $sql                 = quoteit($sql);
  9644.             $hidden .= qq!<INPUT TYPE=HIDDEN NAME="query"             VALUE="$sql">\n!;
  9645.             my $backhidden = qq!<INPUT TYPE=HIDDEN NAME="dbname"             VALUE="$database">\n!;
  9646.             if (defined $q->param('SQL')){
  9647.                 my $value            = quoteit ($q->param('SQL'));
  9648.                 my $selectedscript    = quoteit ($q->param('selectedscript'));
  9649.                 $hidden             .= qq!<INPUT TYPE=HIDDEN NAME="SQL"             VALUE="$value">\n!;
  9650.                 $hidden             .= qq!<INPUT TYPE=HIDDEN NAME="selectedscript"     VALUE="$selectedscript">\n!;
  9651.                 $backhidden         .= qq!<INPUT TYPE=HIDDEN NAME="SQL"             VALUE="$value">\n!;
  9652.                 $backhidden         .= qq!<INPUT TYPE=HIDDEN NAME="selectedscript"     VALUE="$selectedscript">\n!;
  9653.                 $backhidden         .= qq!<INPUT TYPE=HIDDEN NAME="script"             VALUE="execute">\n!;
  9654.                 $backhidden         .= qq!<INPUT TYPE=HIDDEN NAME="page"             VALUE="tables">\n!;
  9655.                 $backhidden         .= qq!<INPUT TYPE=HIDDEN NAME="func"             VALUE="script">\n!;
  9656.             }
  9657.             elsif(defined $q->param('select')){
  9658.                 my $param            = backtoselect();
  9659.                 my $concatenate;
  9660.                 foreach (keys %$param){
  9661.                     $concatenate .= $q->hidden(-name=>$_, -value=>$param->{$_}, -override=>1)."\n";
  9662.                 }
  9663.                 $backhidden         .= $concatenate;
  9664.                 $backhidden         .= qq!<INPUT TYPE=HIDDEN NAME="func"             VALUE="select">\n!;
  9665.                 $backhidden         .= qq!<INPUT TYPE=HIDDEN NAME="page"             VALUE="tables">\n!;
  9666.  
  9667.                 $hidden             .= $concatenate;
  9668.             }
  9669.             elsif (defined $q->param('searchresult')){
  9670.                 my @fields                    = $q->param('fields');
  9671.                 my $concatenate;
  9672.                 foreach ('rows','tables','order','where','start','count'){
  9673.                     $concatenate .= $q->hidden(-name=>$_, -value=>$q->param($_), -override=>1)."\n";
  9674.                 }
  9675.                 $concatenate .= $q->hidden(-name=>"fields", -value=>\@fields, -override=>1)."\n";
  9676.                 $backhidden         .= $concatenate;
  9677.                 $backhidden         .= qq!<INPUT TYPE=HIDDEN NAME="func"             VALUE="return">\n!;
  9678.                 $backhidden         .= qq!<INPUT TYPE=HIDDEN NAME="page"             VALUE="searchresult">\n!;
  9679.                 $hidden             .= $concatenate;
  9680.                 $hidden             .= qq!<INPUT TYPE=HIDDEN NAME="searchresult"     VALUE="1">\n!;
  9681.             }
  9682.             
  9683.             print <<EOT
  9684. <TABLE BORDER=0><!-- Header Table -->
  9685. <FORM ACTION=$full_url METHOD=POST>
  9686.     <TR><TH COLSPAN=5 ALIGN=LEFT>$nameheader</TH><TR>
  9687.     <TR>
  9688.         <TD><INPUT TYPE=SUBMIT NAME="" VALUE="BACK" TITLE="Return to previous page"></TD>
  9689.     </TR>
  9690. $backhidden
  9691. </FORM>
  9692. </TABLE><!-- End of Header Table -->
  9693. EOT
  9694. ;
  9695.  
  9696.         }
  9697.         else { # Export the entire table
  9698.             bail_out ("Table is not selected", {dbname => $database, page => 'select_db'}) unless $table;
  9699.             $hidden .= qq!<INPUT TYPE=HIDDEN NAME="tables"     VALUE="$table">\n!;
  9700.             printHeaderTable( {name =>(uc $func), table => "TABLE: $table"} );
  9701.         }
  9702.         my $newformsize        = $agent ? 16 : 27;
  9703.         my $exportintofile1            = $q->radio_group(-name => "exportintofile", -values => ["new"],         labels => {new => ''},        default=>"new", title=>"Check to create new file");
  9704.         my $exportintofile2            = $q->radio_group(-name => "exportintofile", -values => ["existing"],    labels => {existing => ''},    default=>"-", title=>"Check to overwrite an existing file");
  9705.         $exportfile =<<EOT
  9706. $exportintofile1 Create New File <INPUT TYPE=TEXT NAME="newfilename" SIZE=$newformsize TITLE="Type the Name of a new file" 
  9707. onFocus="if(this.value=='NEW FILE NAME')this.value='';" onBlur="if(this.value=='')this.value='NEW FILE NAME';" VALUE="NEW FILE NAME"><BR>        
  9708. $exportintofile2 Overwrite existing file<BR>        
  9709. EOT
  9710. ;        
  9711.     }
  9712.     else { # IMPORT
  9713.         bail_out ("Table is not selected", {dbname => $database, page => 'select_db'}) unless $table;
  9714.         $hidden .= qq!<INPUT TYPE=HIDDEN NAME="tables"     VALUE="$table">\n!;
  9715.         printHeaderTable( {name =>(uc $func), table => "TABLE: $table"} );
  9716.     }
  9717.     
  9718.     $selectfilelist     .= "</SELECT> \n";
  9719.     my $narrowstyle     = qq!style="width: 100;"!;
  9720.     my $buttonstyle1     = qq!style="width: 150;"!;
  9721.     my $buttonstyle2     = qq!style="width: 360;"!;
  9722.     my $finput            = $agent ? 25 : 36;
  9723.     my $advanced;
  9724.     my $setmode;
  9725.     my $colnames        = $q->checkbox(-name => "colnames", -label => '', title=>"Check to include column names into first row");
  9726.     my $ignorekey        = $q->radio_group(-name => "replacekey", -values => ["ignore"],     -label => {ignore => ''},    default=>"-", title=>"Check to ignore input on duplicate Unique Key Values" );
  9727.     my $replacekey        = $q->radio_group(-name => "replacekey", -values => ["replace"],     -label => {replace => ''},    default=>"-", title=>"Check to replace existing row on duplicate Unique Key Values");
  9728.     my $errorkey        = $q->radio_group(-name => "replacekey", -values => ["error"],         -label => {error => ''},    default=>"error", title=>"Check to abort input on duplicate Unique Key Values and get Error message");
  9729. if ($mode =~ /advanced/i){
  9730.         my $ignore = <<EOT
  9731.     <TR>
  9732.         <TD COLSPAN=5 ALIGN=CENTER><P><B>Other Options:</B></TD>
  9733.     </TR>
  9734.     <TR>
  9735.         <TD ALIGN=RIGHT COLSPAN=4><P>Ignore:</TD>
  9736.         <TD><INPUT TYPE=TEXT NAME="ignore" VALUE="" SIZE=4 TITLE="Type number of lines to ignore"> lines</TD>
  9737.     </TR>
  9738.     <TR>
  9739.         <TD ALIGN=RIGHT COLSPAN=4><P>Ignore input on duplicate Unique Key Values:</TD>
  9740.         <TD>$ignorekey</TD>
  9741.     </TR>
  9742.     <TR>
  9743.         <TD ALIGN=RIGHT COLSPAN=4><P>Replace existing row on duplicate Unique Key Values:</TD>
  9744.         <TD>$replacekey</TD>
  9745.     </TR>
  9746.     <TR>
  9747.         <TD ALIGN=RIGHT COLSPAN=4><P>Get error on duplicate Unique Key Values:</TD>
  9748.         <TD>$errorkey</TD>
  9749.     </TR>
  9750. EOT
  9751.         if ($func =~ /import/i);
  9752.         my $fterm     = $q->scrolling_list(
  9753.                                                  -name        => 'fterm',
  9754.                                         -value        => ["\ ", ",", ";", "|", " ", ""],
  9755.                                         -labels        => {"\ "    => 'tab (\\t)',
  9756.                                                         ","        => 'comma',
  9757.                                                         ";"        => 'semicolon',
  9758.                                                         "|"        => 'pipe',
  9759.                                                         " "        => 'space',
  9760.                                                         ""        => ''},
  9761.                                         -size        => 1,
  9762.                                         -default    => "\t",
  9763.                                         -title        => 'Select delimiter'
  9764.                                 );
  9765.         my $fencl     = $q->scrolling_list(
  9766.                                                  -name        => 'fencl',
  9767.                                         -value        => ["", "'", '"'],
  9768.                                         -size        => 1,
  9769.                                         -default    => "",
  9770.                                         -title        => 'Select Enclosed By character'
  9771.                                 );
  9772.         my $fesc     = $q->scrolling_list(
  9773.                                                  -name        => 'fesc',
  9774.                                         -value        => ["\\"],
  9775.                                         -size        => 1,
  9776.                                         -default    => "\\",
  9777.                                         -title        => 'Select Escaped By character'
  9778.                                 );
  9779.         my $lterm     = $q->scrolling_list(
  9780.                                                  -name        => 'lterm',
  9781.                                         -value        => ["\n"],
  9782.                                         -labels        => {"\n"    => 'New Line'},
  9783.                                         -size        => 1,
  9784.                                         -title        => 'Select Lines Terminated By character'
  9785.                                 );
  9786.         my $checktitle1 = 'Check to use another character';
  9787.         my $checktitle2 = 'Type a single character or its numeric entity: &#xxx;.';
  9788.         my $checktitle3 = 'Type other characters or their numeric entity: &#xxx;.';
  9789.         my $charlength = $agent ? 4 : 6;
  9790.         my $fterm1                    = $q->checkbox(-name => 'fterm1', -label => '', title => $checktitle1);
  9791.         my $fterm2                    = $q->textfield(-name => 'fterm2', -size => $charlength, title => $checktitle2);
  9792.         my $fencl1                    = $q->checkbox(-name => 'fencl1', -label => '', title => $checktitle1);
  9793.         my $fencl2                    = $q->textfield(-name => 'fencl2', -size => $charlength, title => $checktitle2);
  9794.         my $fesc1                    = $q->checkbox(-name => 'fesc1', -label => '', title => $checktitle1);
  9795.         my $fesc2                    = $q->textfield(-name => 'fesc2', -size => $charlength, title => $checktitle2);
  9796.         my $lterm1                    = $q->checkbox(-name => 'lterm1', -label => '', title => $checktitle1);
  9797.         my $lterm2                    = $q->textfield(-name => 'lterm2', -size => $charlength, title => $checktitle3);
  9798.         my $optionally                = $q->checkbox(-name => 'optionally', -label => '', title => "If checked, only strings will be enclosed");
  9799.         $advanced = <<EOT
  9800.     <TABLE BORDER=$border>
  9801.         <TR>
  9802.             <TD COLSPAN=5><P><INPUT TYPE=SUBMIT NAME="action" VALUE="$func" $buttonstyle2></TD>
  9803.         </TR>
  9804.         <TR>
  9805.             <TD COLSPAN=5 ALIGN=CENTER><P><B>File Format:</B></TD>
  9806.         </TR>
  9807.         <TR>
  9808.             <TD ALIGN=RIGHT TITLE="Select a delimiter"><P>Fields terminated by:</TD>
  9809.             <TD TITLE="Select a delimiter"><P>
  9810.  
  9811. $fterm</TD>
  9812.             <TD><P>Other $fterm1</TD>
  9813.             <TD><P>$fterm2</TD>
  9814.             <TD><P> </TD>
  9815.         </TR>
  9816.         <TR>
  9817.             <TD ALIGN=RIGHT TITLE="Select Enclosed By character"><P>Fields enclosed by:</TD>
  9818.             <TD TITLE="Select Enclosed By character"><P>
  9819. $fencl</TD>
  9820.             <TD><P>Other $fencl1</TD>
  9821.             <TD><P>$fencl2</TD>
  9822.             <TD><P>$optionally Optionally</TD>
  9823.         </TR>
  9824.         <TR>
  9825.             <TD ALIGN=RIGHT TITLE="Select Escaped By character"><P>Fields escaped by:</TD>
  9826.             <TD TITLE="Select Escaped By character"><P>
  9827. $fesc</TD>
  9828.             <TD><P>Other $fesc1</TD>
  9829.             <TD><P>$fesc2</TD>
  9830.             <TD><P> </TD>
  9831.         </TR>
  9832.         <TR>
  9833.             <TD ALIGN=RIGHT TITLE="Select Lines Terminated By character"><P>Lines terminated by:</TD>
  9834.             <TD TITLE="Select Lines Terminated By character"><P>
  9835. $lterm</TD>
  9836.             <TD><P>Other $lterm1</TD>
  9837.             <TD><P>$lterm2</TD>
  9838.             <TD><P> </TD>
  9839.         </TR>
  9840.  
  9841. $ignore
  9842.  
  9843.     </TABLE>
  9844.  
  9845. EOT
  9846. ;
  9847.     $setmode = <<EOT
  9848.  
  9849.     <TR>
  9850.         <TD ALIGN=RIGHT><P>
  9851. <INPUT TYPE=SUBMIT NAME="" VALUE="Reload Default Values" TITLE="Click to reset all values">
  9852.         </TD>
  9853.         <TD ALIGN=RIGHT><P>
  9854. <INPUT TYPE=SUBMIT NAME="setmode" VALUE="<< Simple (CSV)" style="width: 150;" TITLE="Click to switch to CSV mode">
  9855.         </TD><TD WIDTH=80><P> </TD>
  9856.     </TR>
  9857. EOT
  9858. ;
  9859.     }
  9860.     else {
  9861.         my $ignore = ($func =~ /import/i) ? <<EOT
  9862.     <TR>
  9863.         <TD ALIGN=RIGHT><P>Ignore:</TD>
  9864.         <TD><INPUT TYPE=TEXT NAME="ignore" VALUE="" SIZE=4 TITLE="Type number of lines to ignore"> lines</TD>
  9865.     </TR>
  9866.     <TR>
  9867.         <TD ALIGN=RIGHT><P>Ignore input on duplicate Unique Key Values:</TD>
  9868.         <TD>$ignorekey</TD>
  9869.     </TR>
  9870.     <TR>
  9871.         <TD ALIGN=RIGHT><P>Replace existing row on duplicate Unique Key Values:</TD>
  9872.         <TD>$replacekey</TD>
  9873.     </TR>
  9874.     <TR>
  9875.         <TD ALIGN=RIGHT><P>Get error on duplicate Unique Key Values:</TD>
  9876.         <TD>$errorkey</TD>
  9877.     </TR>
  9878.  
  9879. EOT
  9880. :
  9881.         <<EOT
  9882.         <TR>
  9883.             <TD ALIGN=RIGHT>Include column names:</TD>
  9884.             <TD> $colnames</TD>
  9885.         </TR>
  9886. EOT
  9887. ;
  9888.     my @fterm = (
  9889.         $q->radio_group(-name=>"fterm", -values=>[','], -labels=>{','=>''}, -default=>",", title=>"Check to use comma separated values"),
  9890.         $q->radio_group(-name=>"fterm", -values=>[';'], -labels=>{';'=>''}, -default=>"-", title=>"Check to use semicolon separated values")
  9891.         );
  9892.     
  9893.     $advanced = <<EOT
  9894. <INPUT TYPE=SUBMIT NAME="action" VALUE="$func" $buttonstyle2 TITLE="Click to $func text file">
  9895.     <TABLE BORDER=$border>
  9896.         <TR>
  9897.             <TD COLSPAN=2 ALIGN=CENTER><B>File Format (CSV):</B></TD>
  9898.         </TR>
  9899.         <TR>
  9900.             <TD ALIGN=RIGHT>Comma-separated values:</TD>
  9901.             <TD> $fterm[0]</TD>
  9902.         </TR>
  9903.         <TR>
  9904.             <TD ALIGN=RIGHT>Semicolon-separated values:</TD>
  9905.             <TD> $fterm[1]</TD>
  9906.         </TR>
  9907.         <TR>
  9908.             <TD COLSPAN=2 ALIGN=CENTER><B>Other Options:</B></TD>
  9909.         </TR>
  9910. $ignore
  9911.     </TABLE>
  9912. <INPUT TYPE=HIDDEN NAME="fencl" VALUE=""">
  9913. <INPUT TYPE=HIDDEN NAME="fesc" VALUE=""">
  9914. <INPUT TYPE=HIDDEN NAME="lterm" VALUE="
  9915. ">
  9916.  
  9917. EOT
  9918. ;
  9919.     $setmode = <<EOT
  9920.     <TR>
  9921.         <TD ALIGN=RIGHT><P>
  9922. <INPUT TYPE=SUBMIT NAME="setmode" VALUE="Advanced >>" $buttonstyle1 TITLE="Click to switch to Advanced mode (Mysql compatible text files)">
  9923.         </TD>
  9924.         <TD WIDTH=30></TD>
  9925.     </TR>
  9926. EOT
  9927. ;
  9928.         
  9929.     }
  9930.     print <<EOT
  9931.  
  9932.         <TABLE BORDER=$border>
  9933.             <TR>
  9934.                 <TD>
  9935. <TABLE BORDER=$border>
  9936. $multiform
  9937.         <TR>
  9938.         <TD VALIGN=TOP><P>
  9939. $exportfile
  9940. $selectfilelist
  9941. <BR>
  9942.         <TABLE CELLPADDING=0 CELLSPACING=0 BORDER=$border>
  9943.             <TR>
  9944.                 <TD><P>
  9945.                 <TABLE CELLPADDING=0 CELLSPACING=0 BORDER=$border>
  9946.                     <TR>
  9947.                         <TD><P><INPUT TYPE=SUBMIT NAME="action" VALUE="View/Edit" $narrowstyle TITLE="Click to view/edit selected file"></TD>
  9948.                         <TD><P><INPUT TYPE=SUBMIT NAME="action" VALUE="Delete" $narrowstyle TITLE="Click to delete selected files"></TD>
  9949.                         <TD><P><INPUT TYPE=SUBMIT NAME="action" VALUE="Download" $narrowstyle TITLE="Click to download selected files"></TD>
  9950.                     </TR>
  9951.                 </TABLE></TD>
  9952.                 <TD><P> </TD>
  9953.             </TR>
  9954.         <!--    <TR>
  9955.                 <TD><INPUT TYPE=SUBMIT NAME="action" VALUE="Download" TITLE="Click to download selected files"></TD>
  9956.                 <TD ALIGN=RIGHT><INPUT TYPE=SUBMIT NAME="action" VALUE="Compress" $buttonstyle1 TITLE="Click to compress selected files"></TD>
  9957.                 </TD>
  9958.             </TR> -->
  9959.             <TR>
  9960.                 <TD COLSPAN=2 HEIGHT=6></TD>
  9961.             </TR>
  9962.             <TR>
  9963.                 <TD COLSPAN=2><P><INPUT TYPE=FILE NAME="localfile" SIZE=$finput title="Select file to upload"></TD>
  9964.             </TR>
  9965.             <TR>
  9966.                 <TD><P>
  9967.                 <TABLE CELLPADDING=0 CELLSPACING=0 BORDER=$border WIDTH="100%">
  9968.                     <TR>
  9969.                         <TD><P><INPUT TYPE=CHECKBOX NAME="overwrite" TITLE="Check to overwrite existing file"> Overwrite if exists</TD>
  9970.                         <TD ALIGN=RIGHT><P><INPUT TYPE=SUBMIT NAME="action" VALUE="Upload" $buttonstyle1 TITLE="Click to upload selected file"></TD>
  9971.                     </TR>
  9972.                 </TABLE></TD>
  9973.                 <TD ALIGN=RIGHT><P> </TD>
  9974.             </TR>
  9975.         </TABLE>
  9976.         </TD>
  9977.         <TD> </TD>
  9978.             <TD VALIGN=TOP><P>
  9979. <!-- selecttable -->
  9980. $advanced
  9981.         </TD>
  9982.     </TR>
  9983. $hidden
  9984. </FORM>    
  9985. </TABLE>
  9986.  
  9987.     </TD>
  9988.         </TR>
  9989.         <TR>
  9990.     <TD ALIGN=RIGHT>
  9991.  
  9992. <TABLE BORDER=$border CELLPADDING=0 CELLSPACING=0>
  9993. <FORM METHOD=POST ACTION="$full_url">
  9994. $setmode
  9995. $hidden
  9996. </FORM>
  9997.     
  9998. </TABLE>
  9999.             </TD>
  10000.         </TR>
  10001.     </TABLE>
  10002. EOT
  10003. ;
  10004.     
  10005. }
  10006.  
  10007. sub editfile {
  10008.     my $input = shift;
  10009.     my $path    = $input->{path};
  10010.     my $back    = $input->{back};
  10011.     my $errmsg = '';
  10012.     my @files = $q->param('selectfilelist');
  10013.     if ($q->param('save')){
  10014.         open FH, ">$path$delim$files[0]" or $errmsg = qq?<font color="#ff0000">Could not open file $files[0]. $!</font>?;
  10015.         flock (FH,2) unless $WIN32;
  10016.         print FH $q->param('filebody');
  10017.         flock (FH,8) unless $WIN32;
  10018.         close FH;
  10019.     }
  10020.     elsif($q->param('saveas')){
  10021.         my $filename = $q->param('filename');
  10022.         if (!$q->param('overwrite') and -e "$path$delim$filename"){
  10023.             $errmsg = qq!<font color="#ff0000">File <b>$filename</b> already exists</font>!;
  10024.         }
  10025.         else {
  10026.             open FH, ">$path$delim$filename" or $errmsg = qq?<font color="#ff0000">Could not open File $filename. $!</font>?;
  10027.             flock (FH,2) unless $WIN32;
  10028.             print FH $q->param('filebody');
  10029.             flock (FH,8) unless $WIN32;
  10030.             close FH;
  10031.         }
  10032.         $files[0] = $filename;
  10033.     }
  10034.     elsif ($q->param('back')){
  10035.         return 0;
  10036.     }
  10037.     else{
  10038.         unless ($input->{new}){
  10039.             if(!-f $path.$delim.$files[0]){
  10040.                 return "Selected file does not seem to be editable";
  10041.             }
  10042.         }
  10043.     }
  10044.     my $file;
  10045.     if ($q->param('action') =~ /view\/edit/i or $q->param('reload')){
  10046.         $file = "";
  10047.         open FH, "$path$delim$files[0]" or return("Cannot open $files[0]");
  10048.         flock (FH,2) unless $WIN32;
  10049.         while (<FH>){
  10050.             $file .= $_
  10051.         }
  10052.         flock (FH,8) unless $WIN32;
  10053.         close FH;
  10054.     }
  10055.     else {$file = $q->param('filebody')}
  10056.     $file = quoteit($file);
  10057.     my ($wrap, $checked_on, $checked_off);
  10058.     if ($q->param('wrap') eq 'on'){
  10059.         $wrap = "wrap=virtual";
  10060.         $checked_on = "checked";
  10061.         $checked_off = "";
  10062.     }
  10063.     else {
  10064.         $wrap = "wrap=off";
  10065.         $checked_on = "";
  10066.         $checked_off = "checked";
  10067.     }
  10068.     my ($cols, $rows);
  10069.     if ($q->param('resize')){
  10070.         ($cols, $rows) = ($q->param('cols_'),$q->param('rows_'));
  10071.     }
  10072.     else {
  10073.         unless (($cols, $rows) = ($q->param('cols_h'),$q->param('rows_h'))){
  10074.             ($cols, $rows) = $agent ? (80, 25) : (150, 25)
  10075.         }
  10076.     }
  10077.     my $func = $q->param('func');
  10078.     my $hiddenback;
  10079.     foreach (keys %$back){
  10080.         $hiddenback .= $q->hidden(-name=>$_, -value=>$back->{$_}, -override=>1)."\n";
  10081.     }
  10082.     print <<EOT
  10083. <form action="$full_url" method=post>
  10084. <table border=0 cellpadding=0 cellspacing=0>
  10085.     <tr height=6>
  10086.         <td colspan=7><p>
  10087.         <table  border=0 cellpadding=0 cellspacing=0>
  10088.             <tr>
  10089.                 <td><input type=submit name="save" value="Save" title="Click to save changes" style="width: 100px"></td>
  10090.                 <td><p><input type=submit name="saveas" value="Save as" title="Click to save as another file" style="width: 100px"></td>
  10091.                 <td><p> </td>
  10092.                 <td><p><input type=text name="filename" title="Type a file name to save as"></td>
  10093.                 <td><p><input type=checkbox name="overwrite" title="Check to overwrite if file name already exists"></td>
  10094.                 <td><p>Overwrite if exists</td>
  10095.             </tr>
  10096.         </table>
  10097.         </td>
  10098.         <td colspan=3 align=right><p><input type=submit name="back" value="Close" title="Click to return back. All changes will be lost" style="width: 100"></td>
  10099.     </tr>
  10100.     <tr height=6>
  10101.         <td colspan=10 ><p>
  10102.             <table  border=0 cellpadding=2 cellspacing=2>
  10103.                 <tr>
  10104.                     <td height=14><p>$errmsg</td>
  10105.                 </tr>
  10106.             </table>
  10107.         </td>
  10108.     </tr>
  10109.     <tr valign=center>
  10110.         <td><p>
  10111.         <table  border=0 cellpadding=0 cellspacing=0>
  10112.             <tr>
  10113.                 <td><p><input type=submit name="reload" value="Reload File" title="Click to reload file. All changes will be lost" style="width: 100"></td>
  10114.                 <td><p><input type=reset style="width: 100"></td>
  10115.             </tr>
  10116.         </table>
  10117.         </td>
  10118.         <td width=60> </td>
  10119.         <td>Wrap text</td>
  10120.         <td><input type=radio name="wrap" value="on" onClick="this.form.submit()" $checked_on title="Check to wrap text"><nobr> on </nobr></td>
  10121.         <td><input type=radio name="wrap" value="off" onClick="this.form.submit()" $checked_off title="Check to unwrap text"><nobr> off</nobr></td>
  10122.         <td width=10> </td>
  10123.         <td>Cols <input type=text name="cols_" value="$cols" size=3 title="Define area width"></td>
  10124.         <td width=2> </td>
  10125.         <td>Rows <input type=text name="rows_" value="$rows" size=3 title="Define area height"></td>
  10126.         <td><input type=submit name="resize" value="Resize" title="Click to apply new area dimensions" style="width: 100"></td>
  10127.     </tr>
  10128. </table>
  10129. <br>
  10130. <textarea name="filebody" cols=$cols rows=$rows $wrap title="Edit file">$file</textarea><p>
  10131. FILE NAME: <b>$files[0]</b><br>
  10132. <input type=hidden name="path" value="$path">
  10133. <input type=hidden name="edit" value="continue">
  10134. <input type=hidden name="selectfilelist" value="$files[0]">
  10135. <input type=hidden name="cols_h" value="$cols">
  10136. <input type=hidden name="rows_h" value="$rows">
  10137. <input type=hidden name="action" value="edit">
  10138. $hiddenback
  10139. </form>
  10140. EOT
  10141. ;
  10142.     return undef;
  10143. }
  10144. sub deletefiles {    
  10145.     my $input     = shift;
  10146.     my $path     = $input->{path};
  10147.     my $back    = $input->{back};
  10148.     my @filestodelete = $q->param('selectfilelist');
  10149.     return 0 if $q->param('cancel');
  10150.     unless ($q->param('deleteconfirm')) {
  10151.         my $func = $q->param('func');
  10152.         print qq!<FORM ACTION="$full_url" METHOD=POST>!;
  10153.         print qq!<BR><P TITLE="List of files to be deleted"><B>THESE FILES WILL BE DELETED:</B></P>\n!;
  10154.         foreach (@filestodelete){
  10155.             $_ = quoteit($_);
  10156.             print qq!<INPUT TYPE=CHECKBOX NAME="selectfilelist" VALUE="$_" CHECKED TITLE="Uncheck to keep this file"> $_ <BR>\n!;
  10157.         }
  10158.         my $hiddenback;
  10159.         foreach (keys %$back){
  10160.             $hiddenback .= $q->hidden(-name=>$_, -value=>$back->{$_}, -override=>1)."\n";
  10161.         }
  10162.         print <<EOT
  10163. <BR><INPUT TYPE=SUBMIT NAME="deleteconfirm" VALUE="DELETE" TITLE="Delete selected files"> 
  10164. <INPUT TYPE=SUBMIT NAME="cancel" VALUE="CANCEL" TITLE="Go back to previous page without deletion">
  10165. <INPUT TYPE=HIDDEN NAME="delete" VALUE="1">
  10166. <INPUT TYPE=HIDDEN NAME="action" VALUE="delete">
  10167. $hiddenback
  10168. </FORM>
  10169. EOT
  10170. ;
  10171.  
  10172.         return undef;            
  10173.     }
  10174.     else {
  10175.         my $errmsg = '';
  10176.         foreach (@filestodelete){
  10177.             my $file = "$path$delim$_";
  10178.             $errmsg .= "Could not unlink $_ : $!\n" unless unlink ($file);
  10179.         }
  10180.         return $errmsg 
  10181.     }
  10182. }
  10183. sub loadBackup{
  10184.     if ($q->param('back')){loadSelectTables(); return}
  10185.     elsif($q->param('backup')){&execBackup()}
  10186.     elsif($q->param('restore')){&loadRestore(); return}
  10187.  
  10188.     my @databases;
  10189.     my $selectdbname_   = $q->param('selectdbname_');
  10190.     $selectdbname_  = $database unless $selectdbname_;
  10191.     my $databasesref = getdblist($dbh);
  10192.     my $selectDBlist;
  10193.     if ($DBI::err and !$database){
  10194.         $selectDBlist = $q->scrolling_list(
  10195.                         -name   =>'selectdbname_',
  10196.                          -labels    =>{'' => 'ACCESS DENIED'},
  10197.                            -values =>[''],
  10198.                         -size   =>1,
  10199.                     );
  10200.     }
  10201.     else {
  10202.         @databases = @$databasesref;
  10203.         push @databases,'' unless $selectdbname_;                    
  10204.         $selectDBlist = $q->scrolling_list(
  10205.                         -default=>[$database],
  10206.                         -name=>'selectdbname_',
  10207.                         -values=>[@databases],
  10208.                         -size=>1,
  10209.                         -onChange=>'this.form.submit()'
  10210.                     );
  10211.     }
  10212.     my $downloadcheck     = 'CHECKED' if $q->param('downloadBackup');
  10213.     my $keepcheck         = 'CHECKED' if ($q->param('keep') or (!$q->param('downloadBackup') and !$q->param('keep')));
  10214.     my $dropcheck         = 'CHECKED' if $q->param('dropifexists');
  10215.     my ($bothcheck, $structurecheck, $datacheck);
  10216.     if ($q->param('include') eq 'structure'){$structurecheck = 'CHECKED'}
  10217.     elsif ($q->param('include') eq 'data'){$datacheck  = 'CHECKED'}
  10218.     else {$bothcheck = 'CHECKED'}
  10219.     my  $buttonwidth     = '110px';
  10220.     my  $buttonwidth2     =  ($buttonwidth * 2) + 15;
  10221.     my $filenamestyle    = "style= 'width: $buttonwidth2"."px'";
  10222.     my $remotefile;
  10223.     if ($q->param('suggest')) {
  10224.         my $back                    = {page => "$page"};
  10225.         $back->{dbname}                = "$database" if $database;
  10226.         $back->{selectdbname_}        = "$selectdbname_" if $selectdbname_;
  10227.         my $userhost                = myhost();
  10228.         if (my $errmsg = checkuserdir('backup')){bail_out("$errmsg\n$!", $back)}
  10229.         my $userdir                 = "$USER_DIR$delim$user.$userhost$delim" . "backup";
  10230.     
  10231.     
  10232.         bail_out("Select a database first") unless ($selectdbname_);
  10233.         my @files = ();
  10234.         opendir DIR, $userdir; 
  10235.         my @filenames    = readdir (DIR) or print "Cannot read this directory: $userdir<br>";
  10236.         closedir DIR;
  10237.         my $n = 0;
  10238.         for (@filenames){
  10239.             next if (($_ eq '.') or ($_ eq '..'));
  10240.             s/^(.*\/)*(.*)$/$2/;
  10241.             if (/^(.+)(\.[a-zA-Z]*)$/){push @files, $1}
  10242.             else {push @files, $_}
  10243.         }
  10244.         $remotefile = "$user.$userhost.$selectdbname_.0";        
  10245.         for (0..$#files){
  10246.             if (belongs(\@files, $remotefile)){
  10247.                 $n++;
  10248.                 $remotefile = "$user.$userhost.$selectdbname_.$n";
  10249.             }
  10250.         }
  10251.     }
  10252.     my $tablelist = qq!\n<SELECT NAME="tablelist" SIZE=13 MULTIPLE>\n!;
  10253.     my $tablelistref;
  10254.     if ($selectdbname_) {
  10255.         $tablelistref = $dbh->selectcol_arrayref("SHOW TABLES FROM $selectdbname_");
  10256.         if (! defined $tablelistref ) {
  10257.             if ($DBI::err){
  10258.                 if ($DBI::errstr =~ /access/i){
  10259.                     $tablelist .= qq!<OPTION VALUE="">ACCESS DENIED\n!;
  10260.                 }
  10261.                 else{
  10262.                     $tablelist .= qq!<OPTION VALUE="">CANNOT SHOW TABLES\n!;
  10263.                     $tablelist .= qq!<OPTION VALUE="">Check database name\n!;
  10264.                 }
  10265.             }
  10266.             else {$tablelist .= qq!<OPTION VALUE="">CANNOT SHOW TABLES\n!}
  10267.         }
  10268.         elsif (@$tablelistref == 0){
  10269.             $tablelist .= qq!<OPTION VALUE="">Table list is empty\n!;
  10270.         }
  10271.         else{
  10272.             my @tblist = $q->param('tablelist');
  10273.             foreach (@$tablelistref){
  10274.                 my $selected = 'SELECTED' if belongs(\@tblist, $_);
  10275.                 $tablelist .= qq!<OPTION VALUE="$_" $selected>$_!
  10276.             }
  10277.         }
  10278.     }
  10279.     else {
  10280.         $tablelist .= qq!<OPTION VALUE="">SELECT DATABASE\n!;
  10281.     }
  10282.     $tablelist .= "</SELECT>\n";
  10283.     my $textsize         = $agent ? 21 : 36 ;
  10284.     my $gzipchecked     = 'CHECKED' if (($q->param('type') eq 'gzip') or  !$q->param('type'));
  10285.     my $zipchecked         = 'CHECKED' if ($q->param('type') eq 'zip');
  10286.     
  10287.     my $zipselect         = qq!<INPUT TYPE=RADIO NAME="type" VALUE="zip" $zipchecked TITLE="Select to create compressed backup file (ZIP format)"><I>zip</I>! if $ALLOW_ZIP;
  10288.     my $targzselect     = qq!<INPUT TYPE=RADIO NAME="type" VALUE="gzip" $gzipchecked TITLE="Select to create compressed backup file (GZIP format)"><I>gzip</I>! if $ALLOW_GZIP;
  10289.     my $textchecked     = 'CHECKED' if ((!$ALLOW_GZIP and !$q->param('type')) or ($q->param('type') eq 'text'));
  10290.     my $selectallcheck     = 'CHECKED' if $q->param('selectalltables');
  10291.  
  10292.     print <<EOT
  10293. <FORM METHOD=POST ACTION="$full_url">
  10294. <TABLE BORDER=0>
  10295.     <TR><TH ALIGN=LEFT COLSPAN=3>CREATE BACKUP</TH></TR>
  10296.     <TR><TD VALIGN=TOP>
  10297. <!-- BACKUP CONTROL PANEL -->
  10298. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA"   WIDTH=240><!-- BORDER START -->
  10299.             <TR>
  10300.                 <TD width="100%">
  10301. <TABLE WIDTH="100%" BORDER=0 CELLPADDING=3 CELLSPACING=0 BGCOLOR="#AAAAAA" >
  10302.     <TR><TD BGCOLOR="#CCCCCC"><INPUT TYPE=CHECKBOX NAME="downloadBackup" $downloadcheck TITLE="Download created backup file"> Download 
  10303.             <INPUT TYPE=CHECKBOX NAME="keep" $keepcheck TITLE="Save created backup file on the server"> Save</TD>
  10304.     </TR>
  10305.     <TR>
  10306.         <TD BGCOLOR="#CCCCCC"><INPUT TYPE=CHECKBOX NAME="dropifexists" $dropcheck TITLE="Include SQL query 'DROP TABLE IF EXISTS tablename' for each table into backup "> Add 'DROP TABLE'</TD>
  10307.     </TR>
  10308.     <TR>
  10309.         <TD BGCOLOR="#CCCCCC">Include: <INPUT TYPE=RADIO NAME="include" VALUE="structure" $structurecheck TITLE="Include only 'CREATE TABLE...' SQL query into backup"
  10310.         ><I>Structure</I><INPUT TYPE=RADIO NAME="include" VALUE="data" $datacheck TITLE="Include only 'INSERT INTO TABLE...' SQL query into backup"
  10311.         ><I>Data</I><INPUT TYPE=RADIO NAME="include" VALUE="both" $bothcheck TITLE="Include both 'CREATE TABLE...' and 'INSERT INTO TABLE ... ' SQL queries into backup"><I>Both</I></TD>
  10312.     </TR>
  10313.     <TR>
  10314.         <TD BGCOLOR="#CCCCCC"><P><INPUT TYPE=SUBMIT NAME="suggest" VALUE="Suggest output file name"   style="width: $buttonwidth2" TITLE="Ask the program to propose an appropriate name for backup file"><BR>
  10315.         <INPUT TYPE=TEXT NAME="remotefile" VALUE="$remotefile" SIZE=$textsize TITLE="Type name of backup file" $filenamestyle></TD>
  10316.     </TR>
  10317.     <TR>
  10318.         <TD BGCOLOR="#CCCCCC">Type: $zipselect $targzselect <INPUT TYPE=RADIO NAME="type" VALUE="text" $textchecked TITLE="Select to create plain text backup file"><I>text</I> </TD>
  10319.     </TR>
  10320.     <TR>
  10321.         <TD BGCOLOR="#CCCCCC" ><INPUT TYPE=SUBMIT NAME="backup" VALUE="CREATE BACKUP FILE"  style="width: $buttonwidth2" TITLE="Create backup file"></TD>
  10322.     </TR>
  10323.     <TR>
  10324.         <TD BGCOLOR="#CCCCCC"><INPUT TYPE=SUBMIT NAME="restore" VALUE="        SELECT FILE       "  style="width: $buttonwidth2" TITLE="Backup file manager"></TD>
  10325.     </TR>
  10326. </TABLE>
  10327.                 </TD></TR><!-- BORDER END -->
  10328. </TABLE>
  10329.  
  10330. <!-- END BACKUP CONTROL PANEL -->
  10331. </TD>
  10332. <TD> </TD>
  10333. <TD VALIGN=TOP>
  10334.  
  10335. <!-- SELECT DATABASE AND TABLE  -->
  10336.  
  10337. <TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 BGCOLOR="#AAAAAA" >
  10338.             <TR>
  10339.                 <TD width="100%"><!-- BORDER START -->
  10340.  
  10341. <TABLE WIDTH=200 BORDER=0 CELLPADDING=4 CELLSPACING=0 BGCOLOR="#AAAAAA">
  10342.     <TR>
  10343.         <TD BGCOLOR="#CCCCCC" TITLE="Databases available on this server">SELECT DATABASE:
  10344. <BR><nobr>$selectDBlist <INPUT TYPE=SUBMIT VALUE="<-" TITLE="Show tables in selected database"></nobr></TD>
  10345.         
  10346.     </TR>
  10347.     <TR>
  10348.         <TD BGCOLOR="#CCCCCC" TITLE="Select tables to backup">SELECT TABLE:<BR>
  10349. $tablelist
  10350.         </TD>
  10351.     </TR>
  10352.     <TR>
  10353.         <TD BGCOLOR="#CCCCCC" TITLE="Select all tables"><INPUT TYPE=CHECKBOX NAME="selectalltables" $selectallcheck TITLE="Select all tables"> SELECT ALL TABLES</TD>
  10354.     </TR>
  10355. </TABLE>
  10356.                 
  10357.                 </TD><!-- BORDER END -->
  10358.             </TR>
  10359. </TABLE>
  10360.  
  10361. <!-- END SELECT DATABASE AND TABLE -->
  10362.  
  10363. </TD></TR></TABLE>
  10364. <INPUT TYPE=HIDDEN NAME="page" VALUE="$page">
  10365. <INPUT TYPE=HIDDEN NAME="func" VALUE="backup">
  10366. <INPUT TYPE=HIDDEN NAME="dbname" VALUE="$database">
  10367. </FORM>
  10368.  
  10369. EOT
  10370. ;
  10371.  
  10372.  
  10373. }
  10374. sub dirsize {
  10375.     my $dir = shift;
  10376.     my $size = 0;
  10377.     opendir DIR, $dir; 
  10378.     my @filenames    = readdir (DIR); # or print "Cannot read this directory: $dir<br>";
  10379.     closedir DIR;
  10380.      foreach (@filenames){
  10381.         next if (($_ eq '.') or ($_ eq '..'));
  10382.         my $file  = "$dir$delim$_";
  10383.         unless (-d $file){
  10384.             $size += -s _;
  10385.         }
  10386.     }#foreach
  10387.     return $size
  10388. }
  10389. sub get_mysql_pri {
  10390.     my $sth = shift @_;
  10391.     my $pri;
  10392.     if (eval {local $SIG{__DIE__};  $pri = $sth->{mysql_is_pri_key}}) {
  10393.         return $pri
  10394.     }
  10395.     else {return $sth->{is_pri_key}}
  10396. }
  10397. sub get_mysql_length {
  10398.     my $sth = shift @_;
  10399.     my $len;
  10400.     if (eval {local $SIG{__DIE__};  $len = $sth->{mysql_is_pri_key}}) {
  10401.         return $len
  10402.     }
  10403.     else {return $sth->{is_pri_key}}
  10404. }
  10405. sub get_mysql_max_lendth {
  10406.     my $sth = shift @_;
  10407.     my $len;
  10408.     if (eval {local $SIG{__DIE__};  $len = $sth->{mysql_max_length}}) {
  10409.         return $len
  10410.     }
  10411.     else {return $sth->{max_length}}
  10412. }
  10413. sub checkfilename {
  10414.     my $filename    = $_[0];
  10415.     my $back        = $_[1];
  10416.     if ($filename =~ /[\/\\:\*\?"<>\|]/){bail_out("A filename cannot contain any of the following characters",$back)}
  10417.     if ($filename =~ /(\.\.)/){bail_out("File name is incorrect", $back)}
  10418.     return
  10419. }
  10420. sub deletespace {
  10421.     my $var = shift;
  10422.     $var =~ s/^\s*(.*)$/$1/m;
  10423.     $var =~ s/^(.*?)\s*$/$1/s;
  10424.     return $var;
  10425. }
  10426. print "<H1>There is no data<H1>";
  10427. exit 0;
  10428.  
  10429. #++++++++++++++++++++++++++++++++++++++
  10430.