lilalo
view l3-cgi-lite @ 104:77f033a04361
Пофиксил приглашение
| author | devi |
|---|---|
| date | Tue Jun 27 10:58:57 2006 +0300 (2006-06-27) |
| parents | |
| children | 53b890d1ae90 |
line source
1 #!/usr/bin/perl
3 use strict;
4 use CGI qw(:standard);
5 use utf8;
7 BEGIN {
8 chdir("/home/devi/cvs/lilalo");
9 require l3config;
10 l3config::init_config();
11 };
13 sub path_is_correct($);
14 sub error($);
15 sub remove_extra_slashes_from($);
16 sub print_header($);
17 sub print_footer;
18 sub nav_bar;
20 my $print="";
21 my $path = $ENV{PATH_INFO};
22 remove_extra_slashes_from($path);
24 my $real_path = $l3config::Config{"backend_datadir"} ;
25 my $cgi_path = $l3config::Config{"cgi_path"} ;
26 my $style_files = $l3config::Config{"frontend_files"} ;
27 my $frontend_css = $l3config::Config{"frontend_css"} ;
28 my $data_file = "data.xml";
30 path_is_correct($path)
31 or error ("Путь $path содержит недопустимые символы или комбинации символов.");
33 $real_path .= $path;
34 remove_extra_slashes_from($real_path);
36 # Чувак, ты хотел бы посмотреть на журнал $path
37 # Он должен находиться в каталоге $real_path файловой системы\n";
39 (-d $real_path)
40 or error("Каталог <b>$real_path</b> не существует. Проверьте, пожалуйста, URL\n");
42 if (-e $real_path."/$data_file") {
44 # В каталоге есть файл $data_file
45 # Отлично! Сейчас будем показывать журнал
47 # Если существуют html и xml файлы,
48 # html файл новее чем xml,
49 # и CGI-скрипту не передано дополнительных параметров,
50 # используем html файл, иначе перегенируем его
52 unless ( -e "$real_path/$data_file"
53 && -e "$real_path/index.html"
54 && (stat("$real_path/index.html"))[9] > (stat("$real_path/$data_file"))[9] ) {
56 my $l3_frontend = "/home/devi/cvs/lilalo/l3-frontend --backend_datafile $real_path/$data_file --output $real_path/index.html";
57 system($l3_frontend) == 0
58 or error("Файл журнала найден, но возникла ошибка при его обработке:<br/> $!");
59 $print .= "(перегенирован)<br/>";
60 }
62 {
63 local $/;
64 open(HTML, "<:utf8", "$real_path/index.html");
65 my $html = <HTML>;
67 # Добавим в начало документа навигационную строку
68 my $nav_bar = nav_bar;
69 $html =~ s/(<body[^>]*>)/$1$nav_bar/;
71 $print .= $html;
72 close(HTML);
73 }
75 }
76 else {
78 # В этом каталоге нет файла data.xml
79 # Но в нём должны быть подкаталоги!
80 # Если и их тут нет, то тут вообще делать нечего
82 $print .= nav_bar;
84 my @dirs = glob("$real_path/*");
85 my $folder_link = "$cgi_path/$path";
86 remove_extra_slashes_from($folder_link);
88 $folder_link =~ s@/[^\/]*/?$@@;
89 if ($folder_link) {
90 $print .= "<img src='$style_files/folder.up.gif'/><a href='$folder_link'>..</a><br/>";
91 }
93 for my $dir (@dirs) {
94 next unless (-d $dir);
95 my ($folder_name) = $dir =~ m@.*/(.*)@;
96 $folder_link = "$cgi_path/$path/$folder_name";
97 $folder_link =~ s@//@/@g;
98 $print .= "<img src='$style_files/folder.gif'/><a href='$folder_link'>$folder_name</a><br/>";
99 }
101 $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path"))
102 .$print
103 .print_footer;
104 };
106 binmode STDOUT, ":utf8";
107 print header(-charset => "utf-8");
108 print $print;
109 exit(0);
111 #----------------------------------------------
114 sub error($)
115 {
116 my $message = $_[0];
118 binmode STDOUT, ":utf8";
119 print header(-charset => "utf-8");
121 my $print = "<h2>Извините, произошла ошибка</h2>";
122 $print .= $message;
124 print $print;
125 exit(0);
126 }
129 sub path_is_correct($)
130 {
131 my $path = $_[0];
132 return 0 if $path =~ m@/../@;
133 return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@;
134 return 1;
135 }
137 sub remove_extra_slashes_from($)
138 {
139 while ($_[0] =~ s@//@/@g) {1;};
140 return $_[0];
141 }
143 sub print_header($)
144 {
145 my $title = $_[0];
146 "<html>"
147 ."<head>"
148 ."<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />"
149 ."<link rel='stylesheet' href='$frontend_css' type='text/css'/>"
150 ."<title>$title</title>"
151 ."</head>"
152 }
154 sub print_footer()
155 {
156 "</html>";
157 }
159 sub nav_bar()
160 {
161 my $nav_bar="";
162 my $skip_first=1;
163 my $current_path="";
164 for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) {
165 if ($skip_first) {
166 $skip_first--;
167 next;
168 }
169 $current_path .= "/$path_part";
170 $nav_bar .= "/<a href='$current_path'>$path_part</a>";
171 }
172 return "<table class='nav_bar' cellpadding='0' cellspacing='0' width='100%'><tr><td>$nav_bar</td></tr></table>";
173 }