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(" \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 }
|
|