dbmedit.cgi

代码名称： DBMEdit 1.0 添加日期： 2000-8-22 所属分类： CGI代码>数据库管理 总下载次数： 984 文件大小： 12KB 适用环境： UNIX 评定级别： 上传者： r

# Currently, this does NOT fill in gaps in data, e.g. (in_001, in_003) is
#   only two fields, not three with a blank one in the middle.
sub putfieldstodb {
    # create full data string, removing empty fields at the end
    my(@field)= sort grep(/^in_\d\d\d$/, keys %in) ;
    $#field-- while ( ($#field>0) && !length($in{$field[$#field]}));

    # Normalize raw CRLF into LF, to accommodate brain-dead OS's
    foreach (@field) { $in{$_}=~ s/\r\n/\n/g }

    $dbdata{$in{'key'}}= join($delim, map { &slashunescape($_) } @in{@field}) ;
}


#----- translation to/from slash-escaped string format ---------------

# unescape the user input into raw data
sub slashunescape {
    my($s)= @_ ;
    $s=~ s/(\\(n|r|t|f|b|a|e|0(?!\d\d)|\d\d\d|x[0-9A-Fa-f]{2}|c.|\\))/ 
    eval qq(\"$1\") /ge ;
    return $s ;
}

# use backslashes to escape string, to make it suitable for input form
sub slashescape {
    my($s)= @_ ;
    $s=~ s/\\/\\\\/g ;
    $s=~ s/\n/\\n/g ;
    $s=~ s/\r/\\r/g ;
    $s=~ s/\t/\\t/g ;
    $s=~ s/\f/\\f/g ;
    $s=~ s/\x08/\\b/g ;
    $s=~ s/\a/\\a/g ;
    $s=~ s/\e/\\e/g ;
    $s=~ s/\0(?!\d\d)/\\0/ ;
    $s=~ s/([\ca-\cz])/   "\\c" . chr(ord($1)+64) /ge ;
    $s=~ s/([^\x20-\x7e])/ "\\x" . sprintf("%02x",ord($1)) /ge ;
    return $s ;
}

# Identical to &slashescape(), except doesn't escape \n
sub slashescapetextarea {
    my($s)= @_ ;
    $s=~ s/\\/\\\\/g ;
    $s=~ s/\r/\\r/g ;
    $s=~ s/\t/\\t/g ;
    $s=~ s/\f/\\f/g ;
    $s=~ s/\x08/\\b/g ;
    $s=~ s/\a/\\a/g ;
    $s=~ s/\e/\\e/g ;
    $s=~ s/\0(?!\d\d)/\\0/ ;
    $s=~ s/([\ca-\ci\ck-\cz])/   "\\c" . chr(ord($1)+64) /ge ;
    $s=~ s/([^\x20-\x7e\n])/ "\\x" . sprintf("%02x",ord($1)) /ge ;
    return $s ;
}

#----- routines to calculate various globals and arrays --------------

# Calculate all global scalars and arrays, as part of initialization.
# Order is sometimes important here.
# None of these should need recalculating; they should all be constant.
sub calcglobals {
    @safein{keys %in}= map { &HTMLescape($_) } values %in ;

    # Save database definition to send to script again
    $dbdefnget= &urlencodelist(&subhash(*in, qw(file delim columns referer))) ;
    $dbdefnpost= &hiddenvars(&subhash(*in, qw(file delim columns referer))) ;

    $delim= ($in{'delim'}=~ /\d/)
            ? join("", map { chr } ($in{'delim'}=~ /(\d+)/g) )
            : $DEFAULT_DELIM ;
    $safedelim= &slashescape($delim) ;

    # Columns are "title:flags"; store in @title and @flags[]{flags}.
    # Flags are one char and may take numeric value, e.g. "title:a5b11cd".
    # Default flag value is 1.  Initial numeric value stored in 'preflag'. (?)
    # could be cleaner here...
    @column= (split(/\s*,\s*/, $in{'columns'})) ;
    for (0..$#column) { ($title[$_],$flags[$_])= split(/:/, $column[$_], 2) }
    @title= map { &HTMLescape($_) } @title ;
    foreach (0..$#flags) {
        ($flags[$_])= { 'preflag', split(/([a-zA-Z])/, $flags[$_]) } ;
        foreach $key (keys %{$flags[$_]}) { 
            $flags[$_]{$key}= '1' unless length($flags[$_]{$key}) ;
        }
    }

}


# Find current parameters of table
# columns start with column 0
sub calctablesize {
    &findmaxwidths ;
    $lastcol= ($#column>$#maxwidth)  ? $#column  : $#maxwidth ;
}


# Find maximum widths of data in columns
# jsm-- field array could be saved to use later, for speed?
sub findmaxwidths {
    @maxwidth= () ;
    @maxheight= () ;
    foreach $key (keys %dbdata) {
        my($i, $numlines) ;
        foreach (split(/$delim/, $dbdata{$key})) {
            # @maxheight() calc is only needed for textareas, but let's
            #   figure all of them, may come in handy.
            $numlines= s/\n/\n/g + 1 ;
            $maxheight[$i]= $numlines if $maxheight[$i]<$numlines ;
            if ($flags[$i]{'t'}) {
                foreach my $l (split(/\n/)) {
                    $l= &slashescape($l) ;
                    $maxwidth[$i]= length($l) if $maxwidth[$i]<length($l) ;
                }
            } else {
                $_= &slashescape($_) ;
                $maxwidth[$i]= length if $maxwidth[$i]<length ;
            }
            $i++ ;
        }
    }
}


#-----  Main display routines  ---------------------------------------

# Print common header
sub printheader {

    print <<EOF ;
Content-type: text/html

<html>
<head>
<title>Editing "$safein{'file'}" database</title>
</head>
<body bgcolor=white vlink="#008080">

<a name="top"></a>
<h1>Editing "$safein{'file'}" database</h1>

$topmsg

EOF
}


# Print common footer
sub printfooter {
    print <<EOF ;

<p><hr>

<a href="http://www.jmarshall.com/tools/dbmedit/"><i>DBMEdit 1.0</i></a>

<p>

$debug
</body>
</html>
EOF
}


# Display the main table to the user
sub displaymaintable {
    my($numrecs)= scalar(keys %dbdata) ;
    my($plural)= ($numrecs==1)  ? ''  : 's' ;
    my($safekey, $safekeyurl, $safefield, $has_backslashes) ;
    &printheader ;
    print <<EOF ;

<h2>$numrecs record$plural shown</h2>

<p>Edit a record by following the link in the "key" column.

<p><table width="100%" cellspacing=0 cellpadding=0><tr>
    <td><b><a href="#addrecord">Add new record</a></b></td>
    <td align=center><b><a href="$ENV{'SCRIPT_NAME'}?$dbdefnget">Refresh table</a></b></td>
    <td align=right><b><a href="$safein{'referer'}">Exit from database session</a></b></td>
</tr></table>

<hr>

<table border>
<tr>
    <th><font color=blue>key</font></th>
EOF

    for (0..$#column) { print "    <th>$title[$_]</th>\n" }

    print "</tr>\n" ;

    foreach $key (sort keys %dbdata) {
        $safekey= &HTMLescape(&slashescape($key)) ;
        $safekeyurl= &urlencode($key) ;
        print <<EOF ;
    <td><font color=blue>
        <a href="$ENV{'SCRIPT_NAME'}?$dbdefnget&cmd=edit&key=$safekeyurl">$safekey</a>
        </font></td>
EOF

        # show \n as line break, but show all other control codes as "\..."
        foreach (split(/$delim/, $dbdata{$key})) { 
            $safefield= &HTMLescape(&slashescapetextarea($_)) ;
            $safefield=~ s/\n/<br>\n/g ;
            print "    <td>", $safefield, "</td>\n" ;
            $has_backslashes||= ($safefield=~ /\\/) ;
        }
        print "</tr>\n" ;
    }


    print "</table>\n\n" ;
    print "<p><b><i>* Backslashes indicate escaped characters, as in Perl.</i></b>\n\n"
        if $has_backslashes ;

    print <<EOF ;
<p><hr>
<a name="addrecord"></a>
<h2>Add a record:</h2>

<ul>
<li>To add a record, fill in this form and press the button below.
<li>Fields marked with <b>*</b> become read-only after the record is added.
<li>If you leave the <b><font color=blue>key</font></b> field blank, a
unique numeric key will be generated.
<li>You may use backslash-escaped characters, as in Perl (e.g. \\n, \\x7f).
Note that using the delimiter string (currently "$safedelim") in a value
may cause problems.
</ul>

<form action="$ENV{'SCRIPT_NAME'}" method=post>
<input type=hidden name="cmd" value="add">
<input type=hidden name="time" value="$now">
$dbdefnpost

<table>
<tr><td><b><font color=blue>key:</font></b></td>
    <td><b><font color=blue><input name="key" size=20></font><b></td></tr>
EOF

    &calctablesize ;
    my($fieldname, $width, $height, $rostar) ;
    for (0..$lastcol) {
        $fieldname= sprintf("in_%03d", $_+1) ;   # max 999 fields
        $rostar= $flags[$_]{'r'}  ?'*'  :'' ;
        print "<tr valign=top><td><b>$title[$_]:$rostar</b></td>\n" ;
        if ($flags[$_]{'t'}) {
            $width= $maxwidth[$_]>20  ? $maxwidth[$_]  : 20 ;
            $width= $width<60         ? $width         : 60 ;
            $height= $maxheight[$_]>1  ? $maxheight[$_]+1  : 2 ;
            $height= $height<10        ? $height           : 10 ;
            print qq(    <td><textarea name="$fieldname" rows=$height cols=$width></textarea></td></tr>\n) ;
        } else {
            $width= $maxwidth[$_]  ? $maxwidth[$_]+1  : 20 ;
            print qq(    <td><input name="$fieldname" size=$width></td></tr>\n) ;
        }
    }

    print <<EOF ;
</table>

<p>
<input type=submit value="Add this record">
<input type=reset value="Clear values">
</form>

<hr>

<table width="100%" cellspacing=0 cellpadding=0><tr>
    <td><b><a href="#top">Go to top of page</a></b></td>
    <td align=right><b><a href="$safein{'referer'}">Exit from database session</a></b></td>
</tr></table>

EOF

    &printfooter ;

} # sub displaymaintable()



# Display a form with a record to edit
sub displayeditform {
    my(@field, @safefield, $fieldname, $width) ;
    my($safekey)= &slashescape($safein{'key'}) ;

    &HTMLdie("That record was just deleted.")
        unless defined($dbdata{$in{'key'}}) ;

    &printheader ;

    print <<EOF ;

<table width="100%" cellspacing=0 cellpadding=0><tr>
    <td><b><a href="$ENV{'SCRIPT_NAME'}?$dbdefnget">Go to main table</a></b></td>
    <td align=right><b><a href="$safein{'referer'}">Exit from database session</a></b></td>
</tr></table>
<hr>

<form action="$ENV{'SCRIPT_NAME'}" method=post>
<input type=hidden name="cmd" value="update">
<input type=hidden name="key" value="$safekey">
<input type=hidden name="time" value="$now">
$dbdefnpost

<h2>Edit a record:</h2>

<ul>
<li>To edit this record, modify the values below and press the "Update" button.
<li>You may use backslash-escaped characters, as in Perl (e.g. \\n, \\x7f).
Note that using the delimiter string (currently "$safedelim") in a value
may cause problems.
</ul>

<table>
<tr><td><b><font color=blue>key:</font></b></td>
    <td><b><font color=blue>$safein{'key'}</font><b></td></tr>
EOF

    &calctablesize ;
    @field= split(/$delim/, $dbdata{$in{'key'}}) ;
    @safefield= map { &HTMLescape(&slashescape($_)) } @field ;
    for (0..$lastcol) {
        $fieldname= sprintf("in_%03d", $_+1) ;   # max 999 fields
        print "<tr valign=top><td><b>$title[$_]:</b></td>\n" ;

        # text areas
        if ($flags[$_]{'t'}) {
            my($safefieldta)= &HTMLescape(&slashescapetextarea($field[$_])) ;
            if ($flags[$_]{'r'}) {
                $safefieldta=~ s/\n/<br>\n/g ;
                print qq(    <td><input type=hidden name="$fieldname" value="$safefield[$_]">$safefieldta</td></tr>\n) ;
            } else {
                $width= $maxwidth[$_]>20  ? $maxwidth[$_]  : 20 ;
                $width= $width<60         ? $width         : 60 ;
                $height= $maxheight[$_]>1  ? $maxheight[$_]+1  : 2 ;
                $height= $height<10        ? $height           : 10 ;
                print qq(    <td><textarea name="$fieldname" rows=$height cols=$width>$safefieldta</textarea></td></tr>\n) ;
            }

        # ordinary text fields
        } else {