lilalo
annotate l3-cgi-lite @ 153:0414adc06059
Создана программа l3prompt.c (аналог l3prompt, написанного на Perl).
Занимается тем, что разбивает строку на блоки
и вставляет между ними строки-разделители.
По сути это нужно, чтобы сделать приглашение невидимым.
Сишная версия работает в 2-3 раза быстрее чем перловая.
По умолчанию не инсталлируется.
Для использования нужно откомпилировать
и положить вместо l3prompt
gcc -o l3prompt l3prompt.c
mv l3prompt ~/.lilalo/
Занимается тем, что разбивает строку на блоки
и вставляет между ними строки-разделители.
По сути это нужно, чтобы сделать приглашение невидимым.
Сишная версия работает в 2-3 раза быстрее чем перловая.
По умолчанию не инсталлируется.
Для использования нужно откомпилировать
и положить вместо l3prompt
gcc -o l3prompt l3prompt.c
mv l3prompt ~/.lilalo/
| author | igor@book.xt.vpn | 
|---|---|
| date | Thu Dec 03 12:23:22 2009 +0200 (2009-12-03) | 
| 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 | 
