Интерактивный tclsh с автодополнением Мой первый скрипт (map lan viewer).
Создано: 06-07-2009 12:11:15 изменено: 20-12-2009 10:50:14  Метки: tcl cgi css html sql
Попробовал написать несложное cgi-приложение используя средства tcl, sqlite, css и html. Вот что получилось:

#! /usr/bin/tclsh
#
# ver 0.4
 
# название базы данных
set dbs wiki
# путь к базе, директория должна позволять писать туда пользователю от которого запускается веб-сервер
set path /var/www/wiki
# количество записей на странице
set nums 5

package require ncgi
package require sqlite3
# открытие базы
sqlite3 db [file join $path $dbs]

############## создание таблицы для хранения записей ##############
proc db_create dbs {
    if {[db eval "select name from sqlite_master where type='table' and tbl_name=\'$dbs\';"] ne "$dbs"} {
        db eval "create table $dbs (id INTEGER PRIMARY KEY, name text, teg text, mess text, date integer);"
    }
}

############## добавление записи ##############
proc db_add {dbs name teg mess} {
    db eval "insert into $dbs values (NULL, \'$name\', \'$teg\', \'$mess\', \'[clock seconds]\');"
}

############## удаление записи ##############
proc db_del {dbs id} {
    db eval "delete from $dbs where id=\'$id\';"
}

############## обновление записи ##############
proc db_upd {dbs id name teg mess} {
    db eval "update $dbs set name=\'$name\', teg=\'$teg\', mess=\'$mess\', date=\'[clock seconds]\' where id=\'$id\';"
}

############## закрытие базы - вызывать не обязательно ##############
proc db_close {} {
    db close
}

############## показываем записи ##############
proc db_show {dbs offset tag} {
    db eval "select * from $dbs $tag order by date desc limit \'$::nums\' offset \'$offset\';" {
        puts "<h4>$name</h4>
        <div class=clock>Добавлено: [clock format $date -format {%Y-%m-%d %H:%M:%S}]</div>
        <em>  Метка: $teg</em><div class=text>$mess</div>
        <a href=\"index.tcl?change=$id\">изменить</a>
        <a href=\"index.tcl?delete=$id\">удалить</a><hr>"
    }
}

############## показываем тэги ##############
proc showtags {dbs} {
    set tags ""
    db eval "select teg from $dbs;" {
        set tags [lappend tags $teg]
    }
    set tags [lsort -unique $tags]
    foreach tag $tags {
        puts "<em><a href=\"index.tcl?tag=[ncgi::encode $tag]=1\">$tag</a></em>"
    }
}

############## шапка документа ##############
proc header {} {
puts {Content-type: text/html

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<link rel="stylesheet" type="text/css" href="/style.css">
<title>miniwiki</title></head><body>}}

############## конец документа ##############
proc footer {id name teg mess} {
puts "<form method=\"post\" action=\"index.tcl\" target=\"_self\">
<input name=\"id\" value=\"$id\" type=\"hidden\" readonly>
<div>Название*:</div>
<div><input class=\"inp\" name=\"name\" value=\"$name\" type=\"text\" maxlength=\"80\"></div>
<div>Метка:</div>                                                                                                          
<div><input class=\"inp\" name=\"tag\" value=\"$teg\" type=\"text\" maxlength=\"80\"></div>
<div>Тело*:</div>                                                                                                          
<div><textarea class=\"text-area\" name=\"body\">$mess</textarea></div>
<div><input type=\"submit\" value=\"Отправить заметку\"></div></form>
<i>* - поля обязательные для заполнения</i>
<hr><br></body></html>"}

############## показать нумерацию страниц ##############
proc page_show {dbs page tag} {
set teg ""
if {$tag ne ""} {set teg "where teg=\'$tag\'"}
#### количество записей в таблице ####
set end [db eval "select count(*) from $dbs $teg;"]
set i 1
if {$page > 4} {set i [expr {$page-2}]}
puts "Страница: "
for {set j $i} {$j < [expr {$i+5}]} {incr j} {
    if {[expr ($j-1)*$::nums] < $end} {
        if {$tag eq ""} {
            if {$page != $j} {
                puts "<a href=\"index.tcl?page=$j\">$j</a>  "
            } else {puts "$j  "
            }
        } else {
            if {$page != $j} {
                puts "<a href=\"index.tcl?tag=$tag&page=$j\">$j</a>  "
            } else {puts "$j  "
            }
        }
    }
}
puts "<hr>"
}

############## замена кавычек и угловых скобок ##############
proc parse var {
    regsub -all {<} $var {\&lt;} var
    regsub -all {>} $var {\&gt;} var
    regsub -all {'} $var {''} var
    regsub -all {\"} $var {\'} var 
    #"'
    return $var
}

############ begin ###########
db_create $dbs
switch -- [ncgi::parse] {
    "delete" {
        #### удаление заметки ####
        puts "Content-type: text/html"
        puts ""
        db_del $dbs [ncgi::value delete]
        puts ncgi::redirect index.tcl?page=1
    "change" {
        #### показ страницы изменения заметки ####
        header
        db eval "select * from $dbs where id=\'[ncgi::value change]\';" {
            footer $id $name $teg $mess
        }}
    "id name tag body" {
        #### добавление/изменение заметки ####
        puts "Content-type: text/html"
        puts ""
        set name [parse [ncgi::value name]]
        set tag [parse [ncgi::value tag]]
        set body [parse [ncgi::value body]]
        if {$name ne "" && $body ne ""} {
            if {[ncgi::value id] eq "NULL"} {
                db_add $dbs $name $tag $body
            } else {
                db_upd $dbs [ncgi::value id] $name $tag $body
            }
            ncgi::redirect index.tcl?page=1
        } else {
            puts "Не все поля заполнены."
            ncgi::redirect index.tcl?page=1
        }
        }
    "" {
        #### отобразить 1 страницу если ничего не задано ####
        header
        puts "Метки: "
        showtags $dbs
        db_show $dbs 0 ""
        page_show $dbs 1 ""
        footer NULL "" "" ""
        }
    "page" {
        #### отображение страницы по номеру ####
        header
        puts "Метки: "
        showtags $dbs
        db_show $dbs [expr {([ncgi::value page]-1)*$nums}] ""
        page_show $dbs [ncgi::value page] ""
        footer NULL "" "" ""
        }
    "tag page" {
        #### отображение страницы по номеру с фильтрацией по метке ####
        header
        puts "Метки: "
        showtags $dbs
        db_show $dbs [expr {([ncgi::value page]-1)*$nums}] "where teg=\'[ncgi::value tag]\'"
        page_show $dbs [ncgi::value page] "[ncgi::value tag]"
        footer NULL "" "" ""
        }
    "default" {
        #### неправильный запрос ####
        puts "Content-type: text/html"
        puts ""
        puts "Bad Request:  [ncgi::parse]"}
}


файл стилей:
body {
  margin: 2;
  padding: 5px 0;
  font-family: Verdana, sans-serif;
  font-size: 12pt;
  line-height: 100%;
  color: #000;
  background-color: white;
  min-width: 780px;
}

h4 {
  font-size: 120%;
  color: #009967;
  border-bottom: 1px solid maroon;
  font-weight: normal;
  padding-bottom: 5px;
  margin: 1em 0 0;
}

a {
  text-decoration: none;
  color: blue;
}

A:visited {
 color: blue;
}

A:hover {
 color: blue;
 text-decoration: underline;
}

em {
 font-size: 70%;
}

hr {
  color: orange;
}

.text-area {
  width: 90%;
  height: 150px;
}

.inp {
  width: 90%;
}

.clock {
  font-size: 70%;
  color: #777777;
  float: left;
}

.text {
  border: dashed 1px #634F36;
  background: #fffff5;
  font-family: "Courier New", Courier, monospace;
  padding: 7px;
  margin: 0 0 0.3em;
  white-space: pre;
}
1748 просмотров комментировать

Интерактивный tclsh с автодополнением Мой первый скрипт (map lan viewer).