[LON-CAPA-cvs] cvs: modules /albertel course_info.pl
albertel
lon-capa-cvs@mail.lon-capa.org
Wed, 20 Dec 2006 22:43:20 -0000
albertel Wed Dec 20 17:43:20 2006 EDT
Modified files:
/modules/albertel course_info.pl
Log:
- much prettier status screens
Index: modules/albertel/course_info.pl
diff -u modules/albertel/course_info.pl:1.8 modules/albertel/course_info.pl:1.9
--- modules/albertel/course_info.pl:1.8 Wed Sep 27 23:22:01 2006
+++ modules/albertel/course_info.pl Wed Dec 20 17:43:19 2006
@@ -4,32 +4,51 @@
use lib '/home/httpd/lib/perl';
use IO::File;
use Apache::lonnet;
-use Apache::lonxml;
+#use Apache::lonxml;
use Apache::lonuserstate;
use Apache::loncoursedata;
use LONCAPA::Configuration;
use GDBM_File;
use Date::Manip;
use Getopt::Long;
+use Term::Screen;
use POSIX;
my $year;
my $domain = 'all';
-my $result = GetOptions ("year=i" => \$year,
- "domain=s" => \$domain,);
+my $skip_tries = 0;
+my $help;
+my $result = GetOptions ("year=i" => \$year,
+ "domain=s" => \$domain,
+ "skiptries" => \$skip_tries,
+ "help" => \$help,);
+if ($help) {
+ print <<END;
+course_info.pl - create a set of files documenting course activity
+Options:
+ --help Display this help.
+ --year= Do only course create in the specified year
+ --domain= Do only courses in the specified domain
+
+Examples:
+ course_info.pl --year=2004 --domain=msu
+END
+ exit;
+}
my $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
my $ver=&get_loncapa_version();
-
+my $screen;
&main();
sub main {
my @domains = &Apache::lonnet::current_machine_domains();
my @hostids = &Apache::lonnet::current_machine_ids();
my @domains_do = split(',',$domain);
+ &init_screen();
foreach my $dom (sort(@domains)) {
if ($domain ne 'all') {
if (!grep(/\Q$dom\E/,@domains_do)) { next; }
@@ -38,7 +57,8 @@
&log("\n\n$dom\n");
&increaselog();
my %courses =
- &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@hostids,'.');
+ &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@hostids,'.',1);
+ my $course_count=0;
foreach my $key (sort
{
my ($acdom,$acnum) = split('_',$a);
@@ -46,18 +66,23 @@
return &creation_date($acdom,$acnum) <=>
&creation_date($bcdom,$bcnum)
} keys(%courses)) {
+ $course_count++;
my ($cdom,$cnum) = split('_',$key);
- if (&creation_date($cdom,$cnum) < &UnixDate("$year","%s")) {
- next;
- }
- if (&creation_date($cdom,$cnum) > &UnixDate($year+1,"%s")) {
- next;
+ if ($year) {
+ if (&creation_date($cdom,$cnum) < &UnixDate("$year","%s")) {
+ next;
+ }
+ if (&creation_date($cdom,$cnum) > &UnixDate($year+1,"%s")) {
+ next;
+ }
}
+ &status(2,"$dom Course $course_count of ".scalar(keys(%courses)));
&course_stats($key);
&log("-"x50);
}
&decreaselog();
}
+ &finish_screen();
}
sub course_stats {
@@ -69,14 +94,17 @@
&log('Created on: '.scalar(localtime(&creation_date($cdom,$cnum)))."\n");
&log_adv_users($cdom,$cnum);
&log_classlist($cdom,$cnum);
- #&log_course_info($cdom,$cnum);
+ &log_course_info($cdom,$cnum);
&decreaselog();
}
sub log_course_info {
my ($cdom,$cnum) = @_;
my $hash = &tie_course($cdom,$cnum);
- if (!$hash) { return; }
+ if (!$hash) {
+ &log("Couldn't get course info");
+ return;
+ }
my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
@@ -141,11 +169,13 @@
$tries+=$grades{$key};
}
}
- &status("$tries on ".&Apache::lonnet::gettitle($symb));
- &status("$cur_item of $items");
+ &status(0,"$tries on ".&Apache::lonnet::gettitle($symb));
$total_tries += $tries;
+ &status(1,"$cur_item of $items ($total_tries)");
}
}
+ &status(0);
+ &status(1);
&log("Course has $items items.");
&log("Total number of tries on problems $total_tries .");
&increaselog();
@@ -164,11 +194,11 @@
sub tie_course {
my ($cdom,$cnum) = @_;
-
+ &status(1," tieing course ");
my ($furl,$ferr) = &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
tie(my %hash,'GDBM_File',$env{"request.course.fn"}.".db",
&GDBM_READER(),0640);
-
+ &status(1);
return \%hash;
}
@@ -191,7 +221,6 @@
my $endcol = &Apache::loncoursedata::CL_END();
&log("Total \# of students: ".scalar(keys(%{ $classlist })));
&log("Section list: ".join(', ',keys(%sections)));
-print $sections{''};
&increaselog();
foreach my $section (sort(keys(%sections))) {
my $cl_section = $section;
@@ -199,6 +228,8 @@
my ($active_users,$total_logins) = (0,0);
foreach my $user (keys(%{ $classlist })) {
if ($classlist->{$user}[$seccol] ne $cl_section) { next; }
+ &status(1," user $section ");
+ &status(0," user $user ");
my $act_key;
if ($classlist->{$user}[$startcol]) {
$act_key .= strftime("%F",localtime($classlist->{$user}[$startcol]));
@@ -223,6 +254,7 @@
" -- $active_users have logged in ".
($active_users ? "$total_logins times" : q{}));
}
+ &status(1);&status(0);
foreach my $timespan (sort(keys(%activity_count))) {
my ($start,$end)=split(':',$timespan,2);
&log(sprintf("%4s from %10s til %10s",$activity_count{$timespan},
@@ -301,6 +333,9 @@
{
my $logfile;
my $level=0;
+ my @lines;
+ my ($max_width,$max_height);
+ my $lines_of_status;
sub increaselog { $level++; }
sub decreaselog { $level--; }
sub logfile {
@@ -321,13 +356,40 @@
sub log {
my $msg = join('',@_);
if ($msg !~ /\n/) { $msg .= "\n"; }
- print(" "x$level.$msg);
+ my $loc = $max_height-$lines_of_status-1;
+ $screen->at(0,0) ->dl()
+ ->at($loc+1,0) ->il()
+ ->at($loc, 0) ->clreol()
+ ->at($loc, 3*$level) ->puts($msg)
+ ->at(0,0);
+ &update_screen();
print $logfile (" "x$level.$msg);
}
sub status {
- my $msg = join('',@_);
- if ($msg !~ /\n/) { $msg .= "\n"; }
- print(" "x$level.$msg);
+ my ($line,$msg) = @_;
+ if (length($msg) > $max_width-2) {
+ $msg=substr($msg,0,$max_width-2);
+ }
+ $lines[$line] = $msg;
+ &update_screen();
+ }
+ sub update_screen {
+ for my $line (0..$lines_of_status-1) {
+ my $loc = $max_height-1-$line;
+ $screen->at($loc,0) ->clreol()
+ ->at($loc,3) ->puts($lines[$line])
+ }
+ $screen->at(0,0);
+ }
+ sub init_screen {
+ $screen = new Term::Screen;
+ $max_width = $screen->cols();
+ $max_height = $screen->rows();
+ $screen->clrscr();
+ $lines_of_status=3;
+ }
+ sub finish_screen {
+ $screen->at($max_height-1,0)->il();
}
}