lilalo

annotate l3-frontend @ 150:822b36252d7f

find changesets by author, revision, files, or words in the commit message
Вывод больших фрагментов текста не теряется.

Большие фрагменты текста теперь не вырезаются бесследно.
Там, откуда они вырезаются, вставляются ссылки,
по которым можно посмотреть полную версию вывода.
Испытано на больших фрагментах текста,
содержащих до 5000 строк (фрагменты более 5000 строк по умолчанию
обрезаются административно; допустимые размеры задаются в l3config.pm).
Исправлены ошибки, из-за которых большие фрагменты
обрабатывались некорректно.
author igor@chub.in
date Tue Jun 23 01:15:02 2009 +0300 (2009-06-23)
parents 266dae9ce2a1
children 80691b40e6db
rev   line source
igor@121 1 #!/usr/bin/perl
devi@23 2
igor@109 3 use POSIX qw(strftime);
igor@115 4 use lib '/etc/lilalo';
devi@23 5 use l3config;
devi@88 6 use utf8;
devi@23 7
devi@23 8 our @Command_Lines;
devi@31 9 our @Command_Lines_Index;
devi@31 10 our %Commands_Description;
devi@31 11 our %Args_Description;
devi@32 12 our %Sessions;
igor@145 13 our %Uploads;
devi@89 14
igor@109 15 our $debug_output=""; # Используйте эту переменную, если нужно передать отладочную информацию
igor@109 16
devi@84 17 our %filter;
devi@89 18 our $filter_url;
devi@89 19 sub init_filter;
devi@23 20
devi@69 21 our %Files;
devi@69 22
devi@23 23 # vvv Инициализация переменных выполняется процедурой init_variables
devi@23 24 our @Day_Name;
devi@23 25 our @Month_Name;
devi@23 26 our @Of_Month_Name;
devi@23 27 our %Search_Machines;
devi@23 28 our %Elements_Visibility;
devi@23 29 # ^^^
devi@23 30
igor@109 31 our $First_Command=$0;
igor@109 32 our $Last_Command=40;
igor@109 33
devi@31 34 our %Stat;
devi@87 35 our %frequency_of_command; # Сколько раз в журнале встречается какая команда
devi@63 36 our $table_number=1;
igor@109 37 our %tigra_hints;
devi@31 38
devi@55 39 my %mywi_cache_for; # Кэш для экономии обращений к mywi
devi@55 40
igor@109 41 sub count_frequency_of_commands;
devi@23 42 sub make_comment;
devi@63 43 sub make_new_entries_table;
devi@23 44 sub load_command_lines_from_xml;
devi@32 45 sub load_sessions_from_xml;
igor@145 46 sub load_uploads;
devi@31 47 sub sort_command_lines;
devi@31 48 sub process_command_lines;
devi@23 49 sub init_variables;
devi@23 50 sub main;
devi@31 51 sub collapse_list($);
devi@23 52
devi@87 53 sub minutes_passed;
devi@87 54
devi@88 55 sub print_all_txt;
devi@88 56 sub print_all_html;
devi@89 57 sub print_edit_all_html;
devi@88 58 sub print_command_lines_html;
devi@89 59 sub print_command_lines_txt;
devi@88 60 sub print_files_html;
devi@88 61 sub print_stat_html;
devi@88 62 sub print_header_html;
devi@88 63 sub print_footer_html;
igor@109 64 sub tigra_hints_generate;
igor@109 65
igor@145 66
igor@109 67 #### mywi
igor@109 68 #
igor@109 69 sub mywi_init;
igor@109 70 sub load_mywitxt;
igor@109 71 sub mywi_process_query($);
igor@109 72 #
igor@109 73 sub add_to_log($$);
igor@109 74 sub parse_query;
igor@109 75 sub search_in_txt;
igor@109 76 sub add_to_log($$);
igor@109 77 sub mywi_guess($);
igor@109 78 #
devi@56 79
devi@23 80 main();
devi@23 81
devi@23 82 sub main
devi@23 83 {
devi@49 84 $| = 1;
devi@23 85
devi@49 86 init_variables();
devi@49 87 init_config();
devi@68 88 $Config{frontend_ico_path}=$Config{frontend_css};
devi@68 89 $Config{frontend_ico_path}=~s@/[^/]*$@@;
devi@89 90 init_filter();
igor@109 91 mywi_init();
devi@23 92
devi@49 93 load_command_lines_from_xml($Config{"backend_datafile"});
igor@145 94 load_uploads($Config{"upload_dir"});
devi@49 95 load_sessions_from_xml($Config{"backend_datafile"});
devi@49 96 sort_command_lines;
devi@49 97 process_command_lines;
devi@89 98 if (defined($filter{action}) && $filter{action} eq "edit") {
devi@89 99 print_edit_all_html($Config{"output"});
devi@89 100 }
devi@89 101 else {
devi@89 102 print_all_html($Config{"output"});
devi@89 103 }
devi@23 104 }
devi@23 105
devi@89 106 sub init_filter
devi@89 107 {
devi@89 108 if ($Config{filter}) {
devi@89 109 # Инициализация фильтра
igor@141 110 for (split /;;/,$Config{filter}) {
igor@141 111 my ($var, $val) = split /::/;
devi@89 112 $filter{$var} = $val || "";
devi@89 113 }
devi@89 114 }
igor@141 115 $filter_url = join (";;", map("$_::$filter{$_}", keys %filter));
devi@89 116 }
devi@89 117
devi@56 118 # extract_from_cline
devi@23 119
devi@56 120 # In: $what = commands | args
devi@56 121 # Out: return ссылка на хэш, содержащий результаты разбора
devi@56 122 # команда => позиция
devi@23 123
devi@31 124 # Разобрать командную строку $_[1] и возвратить хэш, содержащий
devi@31 125 # номер первого появление команды в строке:
devi@49 126 # команда => первая позиция
devi@56 127 sub extract_from_cline
devi@31 128 {
devi@49 129 my $what = $_[0];
devi@49 130 my $cline = $_[1];
devi@49 131 my @lists = split /\;/, $cline;
devi@49 132
devi@49 133
devi@56 134 my @command_lines = ();
devi@56 135 for my $command_list (@lists) {
devi@56 136 push(@command_lines, split(/\|/, $command_list));
devi@49 137 }
devi@31 138
devi@56 139 my %position_of_command;
devi@56 140 my %position_of_arg;
devi@49 141 my $i=0;
devi@56 142 for my $command_line (@command_lines) {
devi@56 143 $command_line =~ s@^\s*@@;
devi@56 144 $command_line =~ /\s*(\S+)\s*(.*)/;
devi@49 145 if ($1 && $1 eq "sudo" ) {
devi@56 146 $position_of_command{"$1"}=$i++;
devi@56 147 $command_line =~ s/\s*sudo\s+//;
devi@49 148 }
devi@56 149 if ($command_line !~ m@^\s*\S*/etc/@) {
devi@56 150 $command_line =~ s@^\s*\S+/@@;
devi@56 151 }
devi@56 152
devi@56 153 $command_line =~ /\s*(\S+)\s*(.*)/;
devi@56 154 my $command = $1;
devi@56 155 my $args = $2;
devi@56 156 if ($command && !defined $position_of_command{"$command"}) {
devi@56 157 $position_of_command{"$command"}=$i++;
devi@49 158 };
devi@56 159 if ($args) {
devi@49 160 my @args = split (/\s+/, $args);
devi@49 161 for my $a (@args) {
devi@56 162 $position_of_arg{"$a"}=$i++
devi@56 163 if !defined $position_of_arg{"$a"};
devi@49 164 };
devi@49 165 }
devi@49 166 }
devi@31 167
devi@49 168 if ($what eq "commands") {
devi@56 169 return \%position_of_command;
devi@49 170 } else {
devi@56 171 return \%position_of_arg;
devi@49 172 }
devi@49 173
devi@31 174 }
devi@31 175
igor@109 176 sub mywrap($)
devi@31 177 {
igor@109 178 return '<div class="t"><div class="b"><div class="l"><div class="r"><div class="bl"><div class="br"><div class="tl"><div class="tr">'.$_[0].
igor@109 179 '</div></div></div></div></div></div></div></div>';
devi@31 180 }
devi@31 181
igor@109 182 sub tigra_hints_generate
devi@31 183 {
igor@109 184 my $tigra_hints_items="";
igor@109 185 for my $hint_id (keys %tigra_hints) {
igor@109 186 $tigra_hints{$hint_id} =~ s@\n@<br/>@gs;
igor@109 187 $tigra_hints{$hint_id} =~ s@ - @ — @gs;
igor@109 188 $tigra_hints{$hint_id} =~ s@'@\\'@gs;
igor@109 189 # $tigra_hints_items .= "'$hint_id' : mywrap('".$tigra_hints{$hint_id}."'),";
igor@109 190 $tigra_hints_items .= "'$hint_id' : '".mywrap($tigra_hints{$hint_id})."',";
igor@109 191 }
igor@109 192 $tigra_hints_items =~ s/,$//;
igor@109 193 return <<TIGRA;
igor@109 194
igor@109 195 var HINTS_CFG = {
igor@109 196 'top' : 5, // a vertical offset of a hint from mouse pointer
igor@109 197 'left' : 5, // a horizontal offset of a hint from mouse pointer
igor@109 198 'css' : 'hintsClass', // a style class name for all hints, TD object
igor@109 199 'show_delay' : 500, // a delay between object mouseover and hint appearing
igor@109 200 'hide_delay' : 2000, // a delay between hint appearing and hint hiding
igor@109 201 'wise' : true,
igor@109 202 'follow' : true,
igor@109 203 'z-index' : 0 // a z-index for all hint layers
igor@109 204 },
igor@109 205
igor@109 206 HINTS_CFG_NEW = {
igor@109 207 'wise' : true, // don't go off screen, don't overlap the object in the document
igor@109 208 'margin' : 10, // minimum allowed distance between the hint and the window edge (negative values accepted)
igor@109 209 'gap' : 20, // minimum allowed distance between the hint and the origin (negative values accepted)
igor@109 210 'align' : 'bctl', // align of the hint and the origin (by first letters origin's top|middle|bottom left|center|right to hint's top|middle|bottom left|center|right)
igor@109 211 'css' : 'hintsClass', // a style class name for all hints, applied to DIV element (see style section in the header of the document)
igor@109 212 'show_delay' : 0, // a delay between initiating event (mouseover for example) and hint appearing
igor@109 213 'hide_delay' : 200, // a delay between closing event (mouseout for example) and hint disappearing
igor@109 214 'follow' : true, // hint follows the mouse as it moves
igor@109 215 'z-index' : 100, // a z-index for all hint layers
igor@109 216 'IEfix' : false, // fix IE problem with windowed controls visible through hints (activate if select boxes are visible through the hints)
igor@109 217 'IEtrans' : ['blendTrans(DURATION=.3)', null], // [show transition, hide transition] - nice transition effects, only work in IE5+
igor@109 218 'opacity' : 90 // opacity of the hint in %%
igor@109 219 },
igor@109 220
igor@109 221 HINTS_ITEMS = {
igor@109 222 $tigra_hints_items
igor@109 223 };
igor@109 224 var myHint = new THints (HINTS_CFG, HINTS_ITEMS);
igor@109 225
igor@109 226
igor@109 227 function mywrap (s_) {
igor@109 228 return '<div class="t"><div class="b"><div class="l"><div class="r"><div class="bl"><div class="br"><div class="tl"><div class="tr">'+s_+
igor@109 229 '</div></div></div></div></div></div></div></div>';
igor@109 230
igor@109 231 }
igor@109 232 TIGRA
igor@109 233 $a=<<TIGRA;
igor@109 234 TIGRA
devi@31 235 }
devi@31 236
devi@31 237
igor@109 238 sub count_frequency_of_commands
devi@31 239 {
igor@109 240 my $cline = $_[0];
igor@109 241 my @commands = keys %{extract_from_cline("commands", $cline)};
igor@109 242 for my $command (@commands) {
igor@109 243 $frequency_of_command{$command}++;
devi@49 244 }
devi@31 245 }
devi@31 246
devi@23 247 sub make_comment
devi@23 248 {
devi@49 249 my $cline = $_[0];
devi@49 250 #my $files = $_[1];
devi@23 251
devi@55 252 my @comments;
devi@49 253 my @commands = keys %{extract_from_cline("commands", $cline)};
devi@49 254 my @args = keys %{extract_from_cline("args", $cline)};
devi@49 255 return if (!@commands && !@args);
devi@49 256 #return "commands=".join(" ",@commands)."; files=".join(" ",@files);
devi@23 257
devi@49 258 # Commands
devi@49 259 for my $command (@commands) {
devi@49 260 $command =~ s/'//g;
igor@109 261 #$frequency_of_command{$command}++;
devi@49 262 if (!$Commands_Description{$command}) {
igor@109 263 $mywi_cache_for{$command} ||= mywi_process_query($command) || "";
devi@63 264 my $mywi = join ("\n", grep(/\([18]|sh|script\)/, split(/\n/, $mywi_cache_for{$command})));
devi@49 265 $mywi =~ s/\s+/ /;
devi@49 266 if ($mywi !~ /^\s*$/) {
devi@49 267 $Commands_Description{$command} = $mywi;
devi@49 268 }
devi@49 269 else {
devi@49 270 next;
devi@49 271 }
devi@49 272 }
devi@23 273
devi@49 274 push @comments, $Commands_Description{$command};
devi@49 275 }
devi@49 276 return join("&#10;\n", @comments);
devi@49 277
devi@49 278 # Files
devi@49 279 for my $arg (@args) {
devi@49 280 $arg =~ s/'//g;
devi@49 281 if (!$Args_Description{$arg}) {
devi@49 282 my $mywi;
devi@49 283 $mywi = mywi_client ($arg);
devi@49 284 $mywi = join ("\n", grep(/\([5]\)/, split(/\n/, $mywi)));
devi@49 285 $mywi =~ s/\s+/ /;
devi@49 286 if ($mywi !~ /^\s*$/) {
devi@49 287 $Args_Description{$arg} = $mywi;
devi@49 288 }
devi@49 289 else {
devi@49 290 next;
devi@49 291 }
devi@49 292 }
devi@23 293
devi@49 294 push @comments, $Args_Description{$arg};
devi@49 295 }
devi@23 296
devi@23 297 }
devi@23 298
devi@23 299 =cut
devi@23 300 Процедура load_command_lines_from_xml выполняет загрузку разобранного lab-скрипта
devi@23 301 из XML-документа в переменную @Command_Lines
devi@23 302
devi@56 303 # In: $datafile имя файла
devi@56 304 # Out: @CommandLines загруженные командные строки
devi@56 305
devi@23 306 Предупреждение!
devi@23 307 Процедура не в состоянии обрабатывать XML-документ любой структуры.
devi@23 308 В действительности файл cache из которого загружаются данные
devi@23 309 просто напоминает XML с виду.
devi@23 310 =cut
devi@23 311 sub load_command_lines_from_xml
devi@23 312 {
devi@49 313 my $datafile = $_[0];
devi@23 314
devi@49 315 open (CLASS, $datafile)
devi@81 316 or die "Can't open file with xml lablog ",$datafile,"\n";
devi@49 317 local $/;
devi@89 318 binmode CLASS, ":utf8";
devi@49 319 $data = <CLASS>;
devi@49 320 close(CLASS);
devi@23 321
devi@49 322 for $command ($data =~ m@<command>(.*?)</command>@sg) {
devi@49 323 my %cl;
devi@49 324 while ($command =~ m@<([^>]*?)>(.*?)</\1>@sg) {
devi@49 325 $cl{$1} = $2;
devi@49 326 }
devi@49 327 push @Command_Lines, \%cl;
devi@49 328 }
devi@23 329 }
devi@23 330
devi@32 331 sub load_sessions_from_xml
devi@32 332 {
devi@49 333 my $datafile = $_[0];
devi@32 334
devi@89 335 open (CLASS, $datafile)
devi@81 336 or die "Can't open file with xml lablog ",$datafile,"\n";
devi@49 337 local $/;
devi@89 338 binmode CLASS, ":utf8";
devi@49 339 my $data = <CLASS>;
devi@49 340 close(CLASS);
devi@32 341
devi@84 342 my $i=0;
devi@84 343 for my $session ($data =~ m@<session>(.*?)</session>@msg) {
devi@84 344 my %session_hash;
devi@49 345 while ($session =~ m@<([^>]*?)>(.*?)</\1>@sg) {
devi@84 346 $session_hash{$1} = $2;
devi@49 347 }