lilalo
view l3-cgi-lite @ 118:73fb48eb8110
typo fixed
| author | igor | 
|---|---|
| date | Mon Mar 10 16:35:37 2008 +0200 (2008-03-10) | 
| parents | 2fc1f3f08760 | 
| children | 078fab45d863 | 
 line source
     1 #!/usr/bin/perl
     3 use strict;
     4 use CGI qw(:standard);
     5 use utf8;
     7 BEGIN {
     8     chdir("/etc/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 sub count_command_lines($);
    22 my $print="";
    23 my $path = $ENV{PATH_INFO};
    24 remove_extra_slashes_from($path);
    27 my $commands_to_show_at_a_go = $l3config::Config{"commands_to_show_at_a_go"};
    28 my $start_from_command = "0";
    29 my $this_page_number=0;
    30 if ($path =~ s/:(.*)//) {
    31     $this_page_number = $1;
    32     $start_from_command = $this_page_number*$commands_to_show_at_a_go;
    33 }
    35 my $real_path = $l3config::Config{"backend_datadir"} ;
    36 my $cgi_path = $l3config::Config{"cgi_path"} ;
    37 my $style_files = $l3config::Config{"frontend_files"} ;
    38 my $frontend_css = $l3config::Config{"frontend_css"} ;
    40 my $data_file = "data.xml";
    42 path_is_correct($path)
    43     or error ("Путь $path содержит недопустимые символы или комбинации символов.");
    45 $real_path .= $path;
    46 remove_extra_slashes_from($real_path);
    48 # Чувак, ты хотел бы посмотреть на журнал $path
    49 # Он должен находиться в каталоге $real_path файловой системы\n";
    51 (-d $real_path)
    52     or error("Каталог <b>$real_path</b> не существует. Проверьте, пожалуйста, URL\n");
    54 if (-e $real_path."/$data_file") {
    56 # В каталоге есть файл $data_file
    57 # Отлично! Сейчас будем показывать журнал
    59 # Если существуют html и xml файлы,
    60 # html файл новее чем xml,
    61 # и CGI-скрипту не передано дополнительных параметров, 
    62 # используем html файл, иначе перегенируем его
    64     unless ( -e "$real_path/$data_file"
    65              && -e "$real_path/index.html" 
    66              && (stat("$real_path/index.html"))[9] > (stat("$real_path/$data_file"))[9] && 0!=0 ) {
    68         my $l3_frontend = "/home/devi/cvs/lilalo/l3-frontend --backend_datafile $real_path/$data_file --output $real_path/index.html --start_from_command $start_from_command ";
    69         system($l3_frontend) == 0
    70             or error("Файл журнала найден, но возникла ошибка при его обработке:<br/> $!");
    71         #$print .= "(перегенирован)<br/>";
    72     }
    74     {
    75         local $/;
    76         open(HTML, "<:utf8", "$real_path/index.html");
    77         my $html = <HTML>;
    79 # Добавим в начало документа навигационную строку
    80         my $nav_bar = nav_bar;
    81         $html =~ s/(<body[^>]*>)/$1$nav_bar/;
    83         $print .= $html;
    84         close(HTML);
    85     }
    87 }
    88 else {
    90 # В этом каталоге нет файла data.xml
    91 # Но в нём должны быть подкаталоги!
    92 # Если и их тут нет, то тут вообще делать нечего
    94     $print .= nav_bar;
    96     my @dirs = glob("$real_path/*");
    97     my $folder_link = "$cgi_path/$path";
    98     remove_extra_slashes_from($folder_link);
   100     $folder_link =~ s@/[^\/]*/?$@@;
   101     if ($folder_link) {
   102         $print .= "<img src='$style_files/folder.up.gif'/><a href='$folder_link'>..</a><br/>";
   103     }
   105     for my $dir (@dirs) {
   106         next unless (-d $dir);
   107         my ($folder_name) = $dir =~ m@.*/(.*)@;
   108         $folder_link = "$cgi_path/$path/$folder_name";
   109         $folder_link =~ s@//@/@g;
   110         $print .= "<img src='$style_files/folder.gif'/><a href='$folder_link'>$folder_name</a><br/>";
   111     }
   113     $print = print_header("LiLaLo -- ".remove_extra_slashes_from("$cgi_path/$path"))
   114             .$print
   115             .print_footer;
   116 };
   118 binmode STDOUT, ":utf8";
   119 print header(-charset => "utf-8");
   120 print $print;
   121 exit(0);
   123 #----------------------------------------------
   126 sub error($)
   127 {
   128 my $message = $_[0];
   130 binmode STDOUT, ":utf8";
   131 print header(-charset => "utf-8");
   133 my $print = "<h2>Извините, произошла ошибка</h2>";
   134 $print .= $message;
   136 print $print;
   137 exit(0);
   138 }
   141 sub path_is_correct($)
   142 {
   143     my $path = $_[0];
   144    # return 0 if $path =~ m@/../@;
   145     return 0 unless $path =~ m@^[a-zA-Z0-9./\@\-]*$@;
   146     return 1;
   147 }
   149 sub remove_extra_slashes_from($) 
   150 {
   151   while ($_[0] =~ s@//@/@g) {1;};
   152   return $_[0];
   153 }
   155 sub print_header($)
   156 {
   157     my $title = $_[0];
   158     "<html>"
   159     ."<head>"
   160     ."<meta content='text/html; charset=utf-8' http-equiv='Content-Type' />"
   161     ."<link rel='stylesheet' href='$frontend_css' type='text/css'/>"
   162     ."<title>$title</title>"
   163     ."</head>"
   164 }
   166 sub print_footer()
   167 {
   168     "</html>";
   169 }
   171 sub nav_bar()
   172 {
   173     my $nav_bar="";
   174     my $skip_first=1;
   175     my $current_path="";
   176     for my $path_part (split("/", remove_extra_slashes_from("$cgi_path/$path"))) {
   177         if ($skip_first) {
   178             $skip_first--;
   179             next;
   180         }
   181         $current_path .= "/$path_part";
   182         $nav_bar .= "/<a href='$current_path'>$path_part</a>";
   183     }
   184     my $pages=int(count_command_lines("$real_path/$data_file")/$commands_to_show_at_a_go)+1;
   185     my $i=1;
   186     while ($i<$pages) {
   187         if ($i==$this_page_number) {
   188             $nav_bar .= " <b>:$i</b>";
   189         } 
   190         else {
   191             $nav_bar .= " <a href='$current_path:$i'>:$i</a>";
   192         }
   193         $i++;
   194     }
   195     return "<table class='nav_bar' cellpadding='0' cellspacing='0' width='100%'><tr><td>$nav_bar</td></tr></table>";
   196 }
   198 sub count_command_lines($)
   199 #
   200 # Считает количество строк в файле с данными
   201 # Грязный временный хак
   202 #
   203 {
   204     my $filename= $_[0];
   205     return int(`grep '<command>' $filename |wc -l`);
   206 #    return $filename;
   207 }
