lilalo

annotate l3-frontend @ 146:f4008c71ab92

find changesets by author, revision, files, or words in the commit message
mass upload
author igor@book.xt.vpn
date Tue Dec 16 00:15:39 2008 +0200 (2008-12-16)
parents 2c9ea8e4fa14
children 94f587855947
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 }
devi@84 348 $Sessions{$session_hash{local_session_id}} = \%session_hash;
devi@49 349 }
devi@32 350 }