lilalo

diff l3-cgi-lite @ 101:c41cc9a4b5ea

* Пофиксил ошибку с неправильной кодировкой mywi-хинтов.
* Подготовил к переходу в иерархию /l3/
** Исправил пути для стилей,
** Забацал красивый l3-cgi-lite


l3-cgi-lite пока что не доделан до нужного уровня,
но я его скоро дорисую.
Уже сейчас это намного более качественный скрипт
через уродский l3-cgi

Он, конечно, поработал в свое время,
но лучше его заменить l3-cgi-lite


Из функционала добавилось:
* Кэширование страниц в html
* Навигация по каталогам
* Навигационная строка в журнале сверху
author devi
date Sat Jun 24 22:53:37 2006 +0300 (2006-06-24)
parents
children 53b890d1ae90
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/l3-cgi-lite	Sat Jun 24 22:53:37 2006 +0300
     1.3 @@ -0,0 +1,174 @@
     1.4 +#!/usr/bin/perl
     1.5 +
     1.6 +use strict;
     1.7 +use CGI qw(:standard);
     1.8 +use utf8;
     1.9 +
    1.10 +BEGIN {
    1.11 +    chdir("/home/devi/cvs/lilalo");
    1.12 +    require l3config;
    1.13 +    l3config::init_config();
    1.14 +};
    1.15 +
    1.16 +sub path_is_correct($);
    1.17 +sub error($);
    1.18 +sub remove_extra_slashes_from($);
    1.19 +sub print_header($);
    1.20 +sub print_footer;
    1.21 +sub nav_bar;
    1.22 +
    1.23 +my $print="";
    1.24 +my $path = $ENV{PATH_INFO};
    1.25 +remove_extra_slashes_from($path);
    1.26 +
    1.27 +my $real_path = $l3config::Config{"backend_datadir"} ;
    1.28 +my $cgi_path = $l3config::Config{"cgi_path"} ;
    1.29 +my $style_files = $l3config::Config{"frontend_files"} ;
    1.30 +my $frontend_css = $l3config::Config{"frontend_css"} ;
    1.31 +my $data_file = "data.xml";
    1.32 +
    1.33 +path_is_correct($path)
    1.34 +    or error ("Путь $path содержит недопустимые символы или комбинации символов.");
    1.35 +
    1.36 +$real_path .= $path;
    1.37 +remove_extra_slashes_from($real_path);
    1.38 +
    1.39 +# Чувак, ты хотел бы посмотреть на журнал $path
    1.40 +# Он должен находиться в каталоге $real_path файловой системы\n";
    1.41 +
    1.42 +(-d $real_path)
    1.43 +    or error("Каталог <b>$real_path</b> не существует. Проверьте, пожалуйста, URL\n");
    1.44 +
    1.45 +if (-e $real_path."/$data_file") {
    1.46 +
    1.47 +# В каталоге есть файл $data_file
    1.48 +# Отлично! Сейчас будем показывать журнал
    1.49 +
    1.50 +# Если существуют html и xml файлы,
    1.51 +# html файл новее чем xml,
    1.52 +# и CGI-скрипту не передано дополнительных параметров, 
    1.53 +# используем html файл, иначе перегенируем его
    1.54 +
    1.55 +    unless ( -e "$real_path/$data_file"
    1.56 +             && -e "$real_path/index.html" 
    1.57 +             && (stat("$real_path/index.html"))[9] > (stat("$real_path/$data_file"))[9] ) {
    1.58 +
    1.59 +        my $l3_frontend = "/home/devi/cvs/lilalo/l3-frontend --backend_datafile $real_path/$data_file --output $real_path/index.html";
    1.60 +        system($l3_frontend) == 0
    1.61 +            or error("Файл журнала найден, но возникла ошибка при его обработке:<br/> $!");
    1.62 +        $print .= "(перегенирован)<br/>";
    1.63 +    }
    1.64 +
    1.65 +    {
    1.66 +        local $/;
    1.67 +        open(HTML, "<:utf8", "$real_path/index.html");
    1.68 +        my $html = <HTML>;
    1.69 +
    1.70 +# Добавим в начало документа навигационную строку
    1.71 +        my $nav_bar = nav_bar;
    1.72 +        $html =~ s/(<body[^>]*>)/$1$nav_bar/;
    1.73 +
    1.74 +        $print .= $html;
    1.75 +        close(HTML);
    1.76 +    }
    1.77 +
    1.78 +}
    1.79 +else {
    1.80 +
    1.81 +# В этом каталоге нет файла data.xml
    1.82 +# Но в нём должны быть подкаталоги!
    1.83 +# Если и их тут нет, то тут вообще делать нечего
    1.84 +
    1.85 +    $print .= nav_bar;
    1.86 +
    1.87 +    my @dirs = glob("$real_path/*");
    1.88 +    my $folder_link = "$cgi_path/$path";
    1.89 +    remove_extra_slashes_from($folder_link);
    1.90 +
    1.91 +    $folder_link =~ s@/[^\/]*/?$@@;
    1.92 +    if ($folder_link) {
    1.93 +        $print .= "<img src='$style_files/folder.up.gif'/><a href='$folder_link'>..</a><br/>";
    1.94 +    }
    1.95 +
    1.96 +    for my $dir (@dirs) {
    1.97 +        next unless (-d $dir);
    1.98 +        my ($folder_name) = $dir =~ m@.*/(.*)@;
    1.99 +        $folder_link = "$cgi_path/$path/$folder_name";
   1.100 +        $folder_link =~ s@//@/@g;
   1.101 +        $print .= "<img src='$style_files/folder.gif'/><a href='$folder_link'>$folder_name</a><br/>";
   1.102 +    }
   1.103 +
   1.104 +    $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path"))
   1.105 +            .$print
   1.106 +            .print_footer;
   1.107 +};
   1.108 +
   1.109 +binmode STDOUT, ":utf8";
   1.110 +print header(-charset => "utf-8");
   1.111 +print $print;
   1.112 +exit(0);
   1.113 +
   1.114 +#----------------------------------------------
   1.115 +
   1.116 +
   1.117 +sub error($)
   1.118 +{
   1.119 +my $message = $_[0];
   1.120 +
   1.121 +binmode STDOUT, ":utf8";
   1.122 +print header(-charset => "utf-8");
   1.123 +
   1.124 +my $print = "<h2>Извините, произошла ошибка</h2>";
   1.125 +$print .= $message;
   1.126 +
   1.127 +print $print;
   1.128 +exit(0);
   1.129 +}
   1.130 +
   1.131 +
   1.132 +sub path_is_correct($)
   1.133 +{
   1.134 +    my $path = $_[0];
   1.135 +    return 0 if $path =~ m@/../@;
   1.136 +    return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@;
   1.137 +    return 1;
   1.138 +}
   1.139 +
   1.140 +sub remove_extra_slashes_from($) 
   1.141 +{
   1.142 +  while ($_[0] =~ s@//@/@g) {1;};
   1.143 +  return $_[0];
   1.144 +}
   1.145 +
   1.146 +sub print_header($)
   1.147 +{
   1.148 +    my $title = $_[0];
   1.149 +    "<html>"
   1.150 +    ."<head>"
   1.151 +    ."<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />"
   1.152 +    ."<link rel='stylesheet' href='$frontend_css' type='text/css'/>"
   1.153 +    ."<title>$title</title>"
   1.154 +    ."</head>"
   1.155 +}
   1.156 +
   1.157 +sub print_footer()
   1.158 +{
   1.159 +    "</html>";
   1.160 +}
   1.161 +
   1.162 +sub nav_bar()
   1.163 +{
   1.164 +    my $nav_bar="";
   1.165 +    my $skip_first=1;
   1.166 +    my $current_path="";
   1.167 +    for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) {
   1.168 +        if ($skip_first) {
   1.169 +            $skip_first--;
   1.170 +            next;
   1.171 +        }
   1.172 +        $current_path .= "/$path_part";
   1.173 +        $nav_bar .= "/<a href='$current_path'>$path_part</a>";
   1.174 +    }
   1.175 +    return "<table class='nav_bar' cellpadding='0' cellspacing='0' width='100%'><tr><td>$nav_bar</td></tr></table>";
   1.176 +}
   1.177 +