lilalo

annotate l3-cgi-lite @ 150:822b36252d7f

find changesets by author, revision, files, or words in the commit message
Вывод больших фрагментов текста не теряется.

Большие фрагменты текста теперь не вырезаются бесследно.
Там, откуда они вырезаются, вставляются ссылки,
по которым можно посмотреть полную версию вывода.
Испытано на больших фрагментах текста,
содержащих до 5000 строк (фрагменты более 5000 строк по умолчанию
обрезаются административно; допустимые размеры задаются в l3config.pm).
Исправлены ошибки, из-за которых большие фрагменты
обрабатывались некорректно.
author igor@chub.in
date Tue Jun 23 01:15:02 2009 +0300 (2009-06-23)
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