[LON-CAPA-cvs] cvs: modules /albertel course_info.pl

[albertel]

albertel		Mon Nov 14 00:42:17 2005 EDT

  Added files:                 
    /modules/albertel	course_info.pl 
  Log:
  - generates some basic info (users, sections, items in a course)
  
  

Index: modules/albertel/course_info.pl
+++ modules/albertel/course_info.pl
use strict;
#use Apache2::compat;
use strict;
use lib '/home/httpd/lib/perl';
use IO::File;
use Apache::lonnet;
use Apache::lonuserstate;
use Apache::loncoursedata;
use LONCAPA::Configuration;
use GDBM_File;
my $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');


my $ver=&get_loncapa_version();

&main();

sub main {
    my @domains = &Apache::lonnet::current_machine_domains();
    my @hostids = &Apache::lonnet::current_machine_ids();
    foreach my $dom (sort(@domains)) {
	&logfile("output/$dom.info");
	&log("\n\n$dom\n");
	&increaselog();
	my %courses = 
	    &Apache::lonnet::courseiddump($dom,'.',1,'.','.','.',1,\@hostids);
	foreach my $key (sort 
			 { 
			     my ($acdom,$acnum) = split('_',$a);
			     my ($bcdom,$bcnum) = split('_',$b);
			     return &creation_date($acdom,$acnum) <=>
				 &creation_date($bcdom,$bcnum)
			 } keys(%courses)) {
	    &course_stats($key);
	    &log("-"x50);
	}
	&decreaselog();
    }
}

sub course_stats {
    my ($course) = @_;
    my ($cdom,$cnum) = split('_',$course);
    my %crsenv = &Apache::lonnet::dump('environment',$cdom,$cnum);
    &log($crsenv{'description'}." ($cdom $cnum)\n");
    &increaselog();
    &log('Created on: '.scalar(localtime(&creation_date($cdom,$cnum)))."\n");
    &log_adv_users($cdom,$cnum);
    &log_classlist($cdom,$cnum);
    &log_course_info($cdom,$cnum);
    &decreaselog();
}

sub log_course_info {
    my ($cdom,$cnum) = @_;
    my $hash = &tie_course($cdom,$cnum);
    if (!$hash) { return; }

    my ($items, %types, $other, @others);
    my %classes = ( 'Problem' => '\.problem$',
		    'Exam' => '\.exam$',
		    'Survey' => '\.survey$',
		    'Sequence' => '\.sequence$',
		    'Page' => '\.page$',
		    'Powerpoint' => '\.ppt$',
		    'PDF' => '\.pdf$',
		    'Web Page' => '\.(xml|htm|html)$',
		    'Simple' => 'simpleproblem.problem$',
		    'Bulletin Board' => '/bulletinboard',
		    'Simple Page' => '/smppg',
		    'Nav' => '/navmaps',
		    'Syllabus' => '/syllabus',
		    'Simple' => 'simpleproblem.problem$',
		    'Supplemental' => '/coursedocs/showdoc/',
		    'External' => '/wrapper/ext/',
		    'Instructor Info' => '/aboutme',
		    );
		    
    foreach my $item (keys(%{ $hash })) {
	if ($item !~ /^src_/) { next; }
	my $src = $hash->{$item};
	if ($src =~ /^\s*$/) { next; }
	$items++;
	my $match;
	foreach my $type (keys(%classes)) {
	    if ($src =~ /$classes{$type}/i) {
		$types{$type}++;
		$match=1;
	    }
	}
	if (!$match) {
	    $other++;
	    push(@others,$src);
	}
    }
    &log("Course has $items items.");
    &increaselog();
    foreach my $item (keys(%classes)) {
	if ($types{$item}) {
	    &log($item.' '.$types{$item});
	}
    }
    if ($other) {
	&log("Other: ".$other."\n".join("\n",@others)."\n");
    }
    &decreaselog();

    &untie_course($hash,$cdom,$cnum);
}

sub tie_course {
    my ($cdom,$cnum) = @_;

    my ($furl,$ferr) = &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
    tie(my %hash,'GDBM_File',$env{"request.course.fn"}.".db",
	&GDBM_READER(),0640);

    return \%hash;
}

sub untie_course {
    my ($hash,$cdom,$cnum) = @_;
    untie($hash);
}

sub log_classlist {
    my ($cdom,$cnum) = @_;

    my $classlist = ($ver =~ /^2\.0/) 
	? &Apache::loncoursedata::get_classlist($cdom.'_'.$cnum,$cdom,$cnum)
	: &Apache::loncoursedata::get_classlist($cdom,$cnum);
    my %sections;
    my $numsections = &Apache::loncommon::get_sections($cdom,$cnum,\%sections);
    &log("Total \# of students: ".scalar(keys(%{ $classlist })));
    &increaselog();
    foreach my $section (sort(keys(%sections))) {
	&log("Section: $section (".$sections{$section}.")");
    }
    &decreaselog();
    my $seccol = &Apache::loncoursedata::CL_SECTION();
    foreach my $section (sort(keys(%sections))) {
	if ($section eq 'NONE') { $section=''; }
	my ($active_users,$total_logins) = (0,0);
	foreach my $user (keys(%{ $classlist })) {
	    if ($classlist->{$user}[$seccol] ne $section) { next; }
	    my ($uname,$udom) = split(':',$user);
	    my $num_logins = &num_logins($cdom,$cnum,$udom,$uname);
	    if ($num_logins > 2) {
		$active_users++;
		$total_logins += $num_logins;
	    }
	}
	&log("Activity for Section $section ",
	     "$active_users have logged in $total_logins times")
    }
}

my %login_cache;
sub num_logins {
    my ($cdom,$cnum,$udom,$uname) = @_;
    if (exists($login_cache{"$udom:$uname"})) {
	return $login_cache{"$udom:$uname"};
    }
    my $logins = 0;
    my $userdir = &Apache::loncommon::propath($udom,$uname);
    open(ACTIVITY,"<$userdir/activity.log");
#    &log("<$userdir/activity.log");
    while (my $line=<ACTIVITY>) {
	my ($date,$mahine,$action) = split(':',$line);
	if ($action =~ /Login/) {
	    $logins++;
	}
    }
    $login_cache{"$udom:$uname"}=$logins;
    return $logins;
}

sub log_adv_users {
    my ($cdom,$cnum) = @_;
    my %users = &Apache::lonnet::get_course_adv_roles($cdom.'_'.$cnum);
    foreach my $class (sort(keys(%users))) {
	&log($class);
	&increaselog();
	foreach my $user (split(',',$users{$class})) {
	    &log($user);
	}
	&decreaselog();
    }
}

my %creation_cache;
sub creation_date {
    my ($cdom,$cnum)=@_;
    if (exists($creation_cache{$cdom.'_'.$cnum})) {
	return $creation_cache{$cdom.'_'.$cnum};
    }
    my $crsdir = &Apache::loncommon::propath($cdom,$cnum);
    open(ENVHIST,"<$crsdir/environment.hist");
    my $line=<ENVHIST>;
    my (undef,$date) = split(':',$line);
    $creation_cache{$cdom.'_'.$cnum}=$date; 
    return $date;
}

sub get_loncapa_version {
    open(REL,'</etc/loncapa-release');
    my $line = <REL>;
    $line =~ s/LON\-CAPA release//;
    $line =~ s/-\d+//;
    $line =~ s/\s//g;
    return $line;
}

{
    my $logfile;
    my $level=0;
    sub increaselog { $level++; }
    sub decreaselog { $level--; }
    sub logfile {
	my ($name) = @_;
	if ($logfile) { $logfile->close; }
	$logfile = new IO::File ">$name";
    }

    sub log {
	my $msg = join('',@_);
	if ($msg !~ /\n/) { $msg .= "\n"; }
	print("   "x$level.$msg);
	print $logfile ("   "x$level.$msg);
    }
}