lilalo

annotate l3-frontend @ 127:a92b17c77b57

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