lilalo
annotate l3-frontend @ 119:71bd999bcb04
Исправлено несколько багов:
* выполняется корректная привязка diff'ов
* правильно запоминается raw_start и проч raw_*
* временно отключен вывод признака нажатия ctrl-c (он ставился неверно)
* в приглашение добавлен случайный nonce (для правильной отработки tab)
* выполняется корректная привязка diff'ов
* правильно запоминается raw_start и проч raw_*
* временно отключен вывод признака нажатия ctrl-c (он ставился неверно)
* в приглашение добавлен случайный nonce (для правильной отработки tab)
author | igor |
---|---|
date | Thu Mar 13 12:19:42 2008 +0200 (2008-03-13) |
parents | 9e6359b7ad55 |
children | 58c869722fd0 |
rev | line source |
---|---|
devi@23 | 1 #!/usr/bin/perl -w |
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(" \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 |