#!/usr/bin/perl -w use lib '.'; use l3config; our @Command_Lines; # vvv Инициализация переменных выполняется процедурой init_variables our @Day_Name; our @Month_Name; our @Of_Month_Name; our %Search_Machines; our %Elements_Visibility; # ^^^ sub search_buy; sub make_comment; sub load_command_lines_from_xml; sub print_command_lines; sub init_variables; sub main; main(); sub main { $| = 1; init_variables(); init_config(); load_command_lines_from_xml($Config{"backend_datafile"}); print_command_lines($Config{"output"}); } sub search_by { my $sm = shift; my $topic = shift; $topic =~ s/ /+/; return ""; } sub make_comment { my $commands = $_[0]; my $files = $_[1]; chomp $commands; chomp $files; return if (!$commands && !$files); my $comment=""; # Commands for my $command (split /\s+/,$commands) { $command =~ s/'//g; my $description=""; eval { $description=`mywi-client '$command'`; } ; $description = join ("
\n", grep(/\([18]\)/, split(/\n/, $description))); $description =~ s/.*?-//; next if $description =~ /^\s*$/; my $query=$command." ".$Config{"keywords"}; $query =~ s/\ /+/g; my $search= search_by("opennet",$query). search_by("local",$command). search_by("google",$query); $comment .= "$command". "$search". "". "$description"; } # Files for my $file (split /\s+/,$files) { $file =~ s@.*/@@; $file =~ s/'//g; next if $file =~ /^\s*$/; next if $file =~ /^-/; my $description=`mywi '$file'`; $description = join ("
\n", grep(/\(5\)/, split(/\n/, $description))); next if $description =~ /^\s*$/; my $query=$file." ".$Config{"files_keywords"}; $query =~ s/\ /+/g; my $search= search_by("opennet",$query). search_by("local",$file). search_by("google",$query); $comment .= "$file". "$search". "". "$description"; } return $comment; } =cut Процедура load_command_lines_from_xml выполняет загрузку разобранного lab-скрипта из XML-документа в переменную @Command_Lines Предупреждение! Процедура не в состоянии обрабатывать XML-документ любой структуры. В действительности файл cache из которого загружаются данные просто напоминает XML с виду. =cut sub load_command_lines_from_xml { my $datafile = $_[0]; open (CLASS, $datafile) or die "Can't open file of the class ",$datafile,"\n"; local $/; $data = ; close(CLASS); for $command ($data =~ m@(.*?)@sg) { my %cl; while ($command =~ m@<([^>]*?)>(.*?)@sg) { $cl{$1} = $2; } push @Command_Lines, \%cl; } } =cut Процедура print_command_lines выводит HTML-представление разобранного lab-скрипта. Разобранный lab-скрипт должен находиться в массиве @Command_Lines =cut sub print_command_lines { my $output_filename=$_[0]; my $course_name = $Config{"course-name"}; my $course_code = $Config{"course-code"}; my $course_date = $Config{"course-date"}; my $course_center = $Config{"course-center"}; my $course_trainer = $Config{"course-trainer"}; my $course_student = $Config{"course-student"}; # Результат выполнения процедуры равен # join("", @Result{header,body,stat,help,about,footer}) my %Result; my $toc =""; # Хранит оглавление по дням $Result{"body"} = "\n"; my $cl; my $last_tty=""; my $last_day=""; my $in_range=0; for my $cl (@Command_Lines) { if ($Config{"from"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"from"}/) { $in_range=1; next; } if ($Config{"to"} && $cl->{"cline"} =~ /$Config{"signature"}\s*$Config{"to"}/) { $in_range=0; next; } next if ($Config{"from"} && $Config{"to"} && !$in_range) || ($Config{"skip_empty"} =~ /^y/i && $cl->{"cline"} =~ /^\s*$/ ) || ($Config{"skip_wrong"} =~ /^y/i && $cl->{"err"} != 0) || ($Config{"skip_interrupted"} =~ /^y/i && $cl->{"err"} == 130); #my @new_commands=@{$cl->{"new_commands"}}; #my @new_files=@{$cl->{"new_files"}}; my $cl_class="cline"; my $out_class="output"; if ($cl->{"class"}) { $cl_class = $cl->{"class"}."_".$cl_class; $out_class = $cl->{"class"}."_".$out_class; } my @new_commands; my @new_files; @new_commands = split (/\s+/, $cl->{"new_commands"}) if defined $cl->{"new_commands"}; @new_files = split (/\s+/, $cl->{"new_files"}) if defined $cl->{"new_files"}; my $output=""; if ($Config{"head_lines"} || $Config{"tail_lines"}) { # Partialy output my @lines = split '\n', $cl->{"output"}; # head my $mark=1; for (my $i=0; $i<= $#lines && $i < $Config{"head_lines"}; $i++) { $output .= $lines[$i]."\n"; } # tail my $start=$#lines-$Config{"tail_lines"}+1; if ($start < 0) { $start=0; $mark=0; } if ($start < $Config{"head_lines"}) { $start=$Config{"head_lines"}; $mark=0; } $output .= $Config{"skip_text"}."\n" if $mark; for (my $i=$start; $i<= $#lines; $i++) { $output .= $lines[$i]."\n"; } } else { # Full output $output .= $cl->{"output"}; } #$output .= "^C\n" if ($cl->{"err"} eq "130"); # ## ## Начинается собственно вывод ## # # my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime($cl->{time}); # Добавляем спереди 0 для удобочитаемости $min = "0".$min if $min =~ /^.$/; $hour = "0".$hour if $hour =~ /^.$/; $sec = "0".$sec if $sec =~ /^.$/; $class=$cl->{"out_class"}; $class =~ s/output$//; $Result{"body"} .= "\n"; # DAY CHANGE if ( $last_day ne $day) { #$Result{"body"} .= ""; $Result{"body"} .= ""; $toc .= "
  • ".$Day_Name[$wday]."
  • \n"; $last_day=$day; } # CONSOLE CHANGE if ( $last_tty ne $cl->{"tty"}) { $Result{"body"} .= ""; $last_tty=$cl->{"tty"}; } # TIME if ($Config{"show_time"} =~ /^y/i) { $Result{"body"} .= ""; } else { $Result{"body"} .= "\n"; $Result{"body"} .= "\n"; } $Result{"body"} .= "

    День ",$day,"

    ".$Day_Name[$wday]."

    ".$cl->{"tty"}."
    ".
    				$hour. ":". $min. ":". $sec.
    				"
    " } # COMMAND $Result{"body"} .= "\n"; $Result{"body"} .= "
    \n";
    		my $cline = $cl->{"cline"};
    		$cline =~ s/\n//;
    		$Result{"body"} .= $cl->{"prompt"}.$cl->{"cline"};
    		$Result{"body"} .= "
    \n"; my $last_command = $cl->{"last_command"}; if (!( $Config{"suppress_editors"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"editors"}}) || $Config{"suppress_pagers"} =~ /^y/i && grep ($_ eq $last_command, @{$Config{"pagers"}}) || $Config{"suppress_terminal"}=~ /^y/i && grep ($_ eq $last_command, @{$Config{"terminal"}}) )) { $Result{"body"} .= "
    ";
    			$Result{"body"} .= $output;
    			$Result{"body"} .= "
    \n"; } # DIFF if ( $Config{"show_diffs"} =~ /^y/i && $cl->{"diff"}) { $Result{"body"} .= "
    ";
    			$Result{"body"} .= $cl->{"diff"};
    			$Result{"body"} .= "
    "; } # COMMENT if ( $Config{"show_comments"} =~ /^y/i) { my $comment = make_comment(join(" ",@new_commands), join (" ",@new_files)); if ($comment) { $Result{"body"} .= "". "
    "; $Result{"body"} .= ""; $Result{"body"} .= $comment; $Result{"body"} .= "
    \n"; $Result{"body"} .= "
    "; } } # Вывод очередной команды окончен $Result{"body"} .= "
    \n"; $Result{"stat"} = "
    "; $Result{"stat"} .= "

    Статистика

    "; $Result{"stat"} .= "Статистическая информация о журнале
    "; $Result{"help"} .= "
    "; $Result{"help"} .= "

    Справка

    "; $Result{"help"} .= "$Html_Help
    "; $Result{"about"} .= "
    "; $Result{"about"} .= "

    О программе

    "; $Result{"about"} .= "$Html_About"; $Result{"footer"} .= "\n"; $Result{"footer"} .= "\n"; # Заголовок генерируется позже всего # Тогда, когда известно уже, что должно быть написано в # оглавлении $Result{"header"} = <

    Журнал лабораторных работ

    Выполнил $course_student
    Проверил $course_trainer
    Курс $course_name ($course_code), $course_date
    Учебный центр $course_center

    Журнал

    HEADER $Result{"header"} .= "
    \n"; for my $element (keys %Elements_Visibility) { my @e = split /\s+/, $element; my $showhide = join "", map { "ShowHide('$_');" } @e ; $Result{"header"} .= "". $Elements_Visibility{$element}. "
    \n"; } $Result{"header"} .= "
    \n"; if ($output_filename eq "-") { print $Result{"header"}, $Result{"body"}, $Result{"stat"}, $Result{"help"}, $Result{"about"}, $Result{"footer"}; } else { open(OUT, ">", $output_filename) or die "Can't open $output_filename for writing\n"; print OUT $Result{"header"}, $Result{"body"}, $Result{"stat"}, $Result{"help"}, $Result{"about"}, $Result{"footer"}; close(OUT); } } sub init_variables { $Html_Help = < LiLaLo (L3) расшифровывается как Live Lab Log.
    Программа разработана для повышения эффективности обучения
    Unix/Linux-системам.
    (c) Игорь Чубин, 2004-2005

    ABOUT $Html_About.='$Id$

    '; $Html_JavaScript = <0) subelems[j].style.display = "none"; else subelems[j].style.display = ""; } } } } JS %Search_Machines = ( "google" => { "query" => "http://www.google.com/search?q=" , "icon" => "google.ico" }, "freebsd" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=", "icon" => "freebsd.ico" }, "linux" => { "query" => "http://man.he.net/?topic=", "icon" => "linux.ico"}, "opennet" => { "query" => "http://www.opennet.ru/search.shtml?words=", "icon" => "opennet.ico"}, "local" => { "query" => "http://www.freebsd.org/cgi/man.cgi?query=", "icon" => "freebsd.ico" }, ); %Elements_Visibility = ( "note" => "замечания", "diff" => "редактор", "time" => "время", "ttychange" => "терминал", "wrong_output wrong_cline wrong_root_output wrong_root_cline" => "команды с ошибками", "interrupted_output interrupted_cline interrupted_root_output interrupted_root_cline" => "прерванные команды", "tab_completion_output tab_completion_cline" => "продолжение с помощью tab" ); @Day_Name = qw/ Воскресенье Понедельник Вторник Среда Четверг Пятница Суббота /; @Month_Name = qw/ Январь Февраль Март Апрель Май Июнь Июль Август Сентябрь Октябрь Ноябрь Декабрь /; @Of_Month_Name = qw/ Января Февраля Марта Апреля Мая Июня Июля Августа Сентября Октября Ноября Декабря /; }