lilalo

annotate l3-cgi-lite @ 155:8ee5e59f1bd3

find changesets by author, revision, files, or words in the commit message
Локальное хранение и анализ данных с помощью SQlite

Очень много изменений, касающихся работы с sqlite
и локального использования результатов записи.
Подробнее:
README.l3text
author Igor Chubin <igor@chub.in>
date Tue Mar 16 20:05:30 2010 +0200 (2010-03-16)
parents 51a232faeb27
children
rev   line source
devi@101 1 #!/usr/bin/perl
devi@101 2
devi@101 3 use strict;
devi@101 4 use CGI qw(:standard);
devi@101 5 use utf8;
devi@101 6
devi@101 7 BEGIN {
igor@115 8 chdir("/etc/lilalo/");
igor@150 9 require "/etc/lilalo/l3config.pm"
igor@150 10 or die " Can't open l3config.pm ";
devi@101 11 l3config::init_config();
devi@101 12 };
devi@101 13
devi@101 14 sub path_is_correct($);
devi@101 15 sub error($);
devi@101 16 sub remove_extra_slashes_from($);
devi@101 17 sub print_header($);
devi@101 18 sub print_footer;
devi@101 19 sub nav_bar;
devi@101 20
igor@109 21 sub count_command_lines($);
igor@109 22
devi@101 23 my $print="";
devi@101 24 my $path = $ENV{PATH_INFO};
devi@101 25 remove_extra_slashes_from($path);
devi@101 26
igor@109 27
igor@109 28 my $commands_to_show_at_a_go = $l3config::Config{"commands_to_show_at_a_go"};
igor@110 29 my $start_from_command = "0";
igor@109 30 my $this_page_number=0;
igor@150 31 my $page_id;
igor@109 32 if ($path =~ s/:(.*)//) {
igor@109 33 $this_page_number = $1;
igor@109 34 $start_from_command = $this_page_number*$commands_to_show_at_a_go;
igor@109 35 }
igor@150 36 $page_id=$this_page_number;
igor@109 37
devi@101 38 my $real_path = $l3config::Config{"backend_datadir"} ;
devi@101 39 my $cgi_path = $l3config::Config{"cgi_path"} ;
devi@101 40 my $style_files = $l3config::Config{"frontend_files"} ;
devi@101 41 my $frontend_css = $l3config::Config{"frontend_css"} ;
igor@109 42
igor@141 43 my $filter=$ENV{QUERY_STRING};
igor@150 44 if ($filter =~ s@command_id=([0-9]+)@@){
igor@150 45 $l3config::Config{"command_id"}=$1;
igor@150 46 $page_id=$1;
igor@150 47 }
igor@143 48 if ($filter =~ /page=([^&]*)/ ) {
igor@143 49 open(PAGE_NAME, "grep $1 $real_path/sessions-index | tail -1 | sed 's^-<.*^^; s^/[^/]*\$^^'| ");
igor@143 50 my $page_name;
igor@143 51 $page_name=<PAGE_NAME>;
igor@143 52 chomp $page_name;
igor@143 53 my $id="";
igor@143 54 if ($filter =~ /id=([^&]*)/) {
igor@143 55 $id="#$1";
igor@143 56 }
igor@143 57 print "Status: 302 Moved\nLocation: http://xgu.ru/l3/$page_name$id\n\n";
igor@143 58 exit(0);
igor@143 59 }
igor@143 60 elsif ($filter !~ /filter=/) {
igor@141 61 # $filter="";
igor@141 62 }
igor@141 63 else {
igor@141 64 $filter =~ s@.*filter=@@;
igor@141 65 $filter =~ s@\&.*@@;
igor@141 66 }
igor@141 67
devi@101 68 my $data_file = "data.xml";
devi@101 69
devi@101 70 path_is_correct($path)
devi@101 71 or error ("Путь $path содержит недопустимые символы или комбинации символов.");
devi@101 72
devi@101 73 $real_path .= $path;
devi@101 74 remove_extra_slashes_from($real_path);
devi@101 75
devi@101 76 # Чувак, ты хотел бы посмотреть на журнал $path
devi@101 77 # Он должен находиться в каталоге $real_path файловой системы\n";
devi@101 78
devi@101 79 (-d $real_path)
devi@101 80 or error("Каталог <b>$real_path</b> не существует. Проверьте, пожалуйста, URL\n");
devi@101 81
devi@101 82 if (-e $real_path."/$data_file") {
devi@101 83
devi@101 84 # В каталоге есть файл $data_file
devi@101 85 # Отлично! Сейчас будем показывать журнал
devi@101 86
devi@101 87 # Если существуют html и xml файлы,
devi@101 88 # html файл новее чем xml,
devi@101 89 # и CGI-скрипту не передано дополнительных параметров,
devi@101 90 # используем html файл, иначе перегенируем его
devi@101 91
devi@101 92 unless ( -e "$real_path/$data_file"
devi@101 93 && -e "$real_path/index.html"
igor@150 94 && (stat("$real_path/index$page_id.html"))[9] > (stat("$real_path/$data_file"))[9]) {
devi@101 95
igor@150 96 my $fragment_options;
igor@150 97 if ($l3config::Config{"command_id"}) {
igor@150 98 $fragment_options = " --command_id ".$l3config::Config{"command_id"};
igor@150 99 }
igor@150 100 else {
igor@150 101 $fragment_options = " --start_from_command $start_from_command ";
igor@150 102 }
igor@141 103 my $l3_frontend = "l3-frontend --backend_datafile $real_path/$data_file".
igor@150 104 $fragment_options.
igor@150 105 " --output $real_path/index$page_id.html".
igor@141 106 " --filter '$filter'";
devi@101 107 system($l3_frontend) == 0
devi@101 108 or error("Файл журнала найден, но возникла ошибка при его обработке:<br/> $!");
devi@101 109 }
devi@101 110
devi@101 111 {
devi@101 112 local $/;
igor@150 113 open(HTML, "<:utf8", "$real_path/index$page_id.html");
devi@101 114 my $html = <HTML>;
devi@101 115
devi@101 116 # Добавим в начало документа навигационную строку
devi@101 117 my $nav_bar = nav_bar;
devi@101 118 $html =~ s/(<body[^>]*>)/$1$nav_bar/;
devi@101 119
devi@101 120 $print .= $html;
devi@101 121 close(HTML);
devi@101 122 }
devi@101 123
devi@101 124 }
devi@101 125 else {
devi@101 126
devi@101 127 # В этом каталоге нет файла data.xml
devi@101 128 # Но в нём должны быть подкаталоги!
devi@101 129 # Если и их тут нет, то тут вообще делать нечего
devi@101 130
devi@101 131 $print .= nav_bar;
devi@101 132
devi@101 133 my @dirs = glob("$real_path/*");
devi@101 134 my $folder_link = "$cgi_path/$path";
devi@101 135 remove_extra_slashes_from($folder_link);
devi@101 136
devi@101 137 $folder_link =~ s@/[^\/]*/?$@@;
devi@101 138 if ($folder_link) {
devi@101 139 $print .= "<img src='$style_files/folder.up.gif'/><a href='$folder_link'>..</a><br/>";
devi@101 140 }
devi@101 141
devi@101 142 for my $dir (@dirs) {
devi@101 143 next unless (-d $dir);
devi@101 144 my ($folder_name) = $dir =~ m@.*/(.*)@;
devi@101 145 $folder_link = "$cgi_path/$path/$folder_name";
devi@101 146 $folder_link =~ s@//@/@g;
devi@101 147 $print .= "<img src='$style_files/folder.gif'/><a href='$folder_link'>$folder_name</a><br/>";
devi@101 148 }
devi@101 149
devi@101 150 $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path"))
devi@101 151 .$print
devi@101 152 .print_footer;
devi@101 153 };
devi@101 154
devi@101 155 binmode STDOUT, ":utf8";
devi@101 156 print header(-charset => "utf-8");
devi@101 157 print $print;
devi@101 158 exit(0);
devi@101 159
devi@101 160 #----------------------------------------------
devi@101 161
devi@101 162
devi@101 163 sub error($)
devi@101 164 {
devi@101 165 my $message = $_[0];
devi@101 166
devi@101 167 binmode STDOUT, ":utf8";
devi@101 168 print header(-charset => "utf-8");
devi@101 169
devi@101 170 my $print = "<h2>Извините, произошла ошибка</h2>";
devi@101 171 $print .= $message;
devi@101 172
devi@101 173 print $print;
devi@101 174 exit(0);
devi@101 175 }
devi@101 176
devi@101 177
devi@101 178 sub path_is_correct($)
devi@101 179 {
devi@101 180 my $path = $_[0];
devi@106 181 # return 0 if $path =~ m@/../@;
devi@101 182 return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@;
devi@101 183 return 1;
devi@101 184 }
devi@101 185
devi@101 186 sub remove_extra_slashes_from($)
devi@101 187 {
devi@101 188 while ($_[0] =~ s@//@/@g) {1;};
devi@101 189 return $_[0];
devi@101 190 }
devi@101 191
devi@101 192 sub print_header($)
devi@101 193 {
devi@101 194 my $title = $_[0];
devi@101 195 "<html>"
devi@101 196 ."<head>"
devi@101 197 ."<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />"
devi@101 198 ."<link rel='stylesheet' href='$frontend_css' type='text/css'/>"
devi@101 199 ."<title>$title</title>"
devi@101 200 ."</head>"
devi@101 201 }
devi@101 202
devi@101 203 sub print_footer()
devi@101 204 {
devi@101 205 "</html>";
devi@101 206 }
devi@101 207
devi@101 208 sub nav_bar()
devi@101 209 {
devi@101 210 my $nav_bar="";
devi@101 211 my $skip_first=1;
devi@101 212 my $current_path="";
devi@101 213 for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) {
devi@101 214 if ($skip_first) {
devi@101 215 $skip_first--;
devi@101 216 next;
devi@101 217 }
devi@101 218 $current_path .= "/$path_part";
devi@101 219 $nav_bar .= "/<a href='$current_path'>$path_part</a>";
devi@101 220 }
igor@109 221 my $pages=int(count_command_lines("$real_path/$data_file")/$commands_to_show_at_a_go)+1;
igor@109 222 my $i=1;
igor@109 223 while ($i<$pages) {
igor@109 224 if ($i==$this_page_number) {
igor@109 225 $nav_bar .= " <b>:$i</b>";
igor@109 226 }
igor@109 227 else {
igor@109 228 $nav_bar .= " <a href='$current_path:$i'>:$i</a>";
igor@109 229 }
igor@109 230 $i++;
igor@109 231 }
igor@141 232 $filter = "($filter)" if $filter;
igor@141 233 return "<table class='nav_bar' cellpadding='0' cellspacing='0' width='100%'><tr><td>$nav_bar $filter</td></tr></table>";
devi@101 234 }
devi@101 235
igor@109 236 sub count_command_lines($)
igor@109 237 #
igor@109 238 # Считает количество строк в файле с данными
igor@109 239 # Грязный временный хак
igor@109 240 #
igor@109 241 {
igor@109 242 my $filename= $_[0];
igor@109 243 return int(`grep '<command>' $filename |wc -l`);
igor@109 244 # return $filename;
igor@109 245 }
igor@109 246