lilalo

annotate l3-cgi-lite @ 107:54fbf2041159

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