[LON-CAPA-cvs] cvs: modules /raeburn FIE_usage.pl
raeburn
lon-capa-cvs@mail.lon-capa.org
Fri, 31 Mar 2006 16:52:57 -0000
This is a MIME encoded message
--raeburn1143823977
Content-Type: text/plain
raeburn Fri Mar 31 11:52:57 2006 EDT
Added files:
/modules/raeburn FIE_usage.pl
Log:
Script used to retrieve usage data for FIE paper.
--raeburn1143823977
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20060331115257.txt"
Index: modules/raeburn/FIE_usage.pl
+++ modules/raeburn/FIE_usage.pl
#!/usr/bin/perl
use strict;
use lib '/home/httpd/lib/perl';
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonuserstate;
use Apache::lonnavmaps;
use Scalar::Util qw(weaken);
use Apache::lonratsrv;
use Apache::lonratedt;
use Apache::lonroles;
use Apache::grades;
use LONCAPA::Configuration;
use GDBM_File;
use HTML::LCParser;
# Determine the library server's domain and hostID
my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
my $logfile = $$perlvarref{'lonDaemons'}.'/logs/usage.log';
my @domains = &Apache::lonnet::current_machine_domains();
my @hostids = &Apache::lonnet::current_machine_ids();
my @allowners = ();
my %ownernames = ();
my %owneremails = ();
my %ownercourses = ();
my %ownedcourses = ();
my %lastactivity = ();
my %totals = ();
my %sizes = ();
my %publish = ();
my %external = ();
my %crscount = ();
my %homegrown = ();
my %homedomain = ();
my %uploaded = ();
my %uploadtotal = ();
my %supplemental = ();
my %supplementaltotal = ();
my %extweb = ();
my %folders = ();
my %pages = ();
my %nodiscussion;
my %withdiscussion;
my %totalposts;
my %src_counts = ();
my %prob_types = ();
my %response_types = ();
my %numparts;
my %numresponses = ();
my %numhidden = ();
my %numencrypted = ();
my %numconditional = ();
my %numrandompicks = ();
my %numimportmaps = ();
my %numdocmaps = ();
my %randompicks = ();
my %duplicates = ();
my %scripting = ();
my %scriptdetails = ();
my %alltags = ();
my %hints = ();
my %displays = ();
my %allfunctions = ();
my %allvars = ();
my %crsitems = ();
my %cparms = ();
my %broadcast = ();
my %critical = ();
my %usernotes = ();
my %allembedded = ();
my %codebase = ();
my %chatcount = ();
my %calcount = ();
my %library = ();
my %numscantrons = ();
my %studentphotos = ();
@domains = ('northwood5');
# Determine the present time;
my $timenow = time();
# For each domain ......
foreach my $dom (@domains) {
open(LOG,">/home/raeburn/fie/data/domain_$dom.txt");
my $dc = 'fietester';
my $lonidsdir='/home/httpd/lonIDs';
my $handle = 'fietester_1142656989_northwood5_northwood5l1';
$env{'user.name'} = $dc;
my $authhost = &Apache::lonnet::homeserver($dc,$dom);
$env{'user.home'} = $authhost;
$env{'user.domain'} = $dom;
$env{'user.adv'} = 1;
&Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
my $now=time;
my $then=$env{'user.login.time'};
my @instcodes = ('ss06');
my %courses = ();
foreach my $code (@instcodes) {
# %{$courses{$code}} = &Apache::lonnet::courseiddump($dom,'.',1,$code,'.','.',1,\@hostids);
# %courses = ('northwood5_1w268410c6d0744e2northwood5l1' => 'Some course');
%{$courses{$code}} = ('northwood5_3e24151fbf51a4411northwood5l1' => 'Other course');
foreach my $cid (sort keys %{$courses{$code}}) {
print "course is $cid\n";
$env{'request.course.id'} = $cid;
$env{'request.course.sec'} = '';
my ($cdom,$crs) = split/_/,$cid;
delete($env{'request.role'});
my $lastvisit = 0;
# get timestamp for activity log
my $longcrs;
if ($crs =~ m/^(\w)(\w)(\w)/) {
$longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
}
my $crsdir = $$perlvarref{'lonUsersDir'}.'/'.$cdom.'/'.$longcrs;
my $acfile = $crsdir.'/activity.log';
my $classlist = $crsdir.'/classlist.db';
if (-e $acfile) {
my @statinfo = stat($acfile);
$lastvisit = $statinfo[9];
}
my $stucount = 0;
if (-e "$classlist") {
my %classlist = &Apache::lonnet::dump('classlist',$cdom,$crs);
foreach my $item (sort keys %classlist) {
$stucount ++;
}
}
my %crsenv = &Apache::lonnet::dump('environment',$cdom,$crs);
my $owner;
my $ownerdom;
my $ownername;
my $ownermail;
$owner = $crsenv{'internal.courseowner'};
%{$cparms{$cid}} = (
coursecode => $crsenv{'internal.coursecode'},
grading => $crsenv{'grading'},
showphotos => $crsenv{'internal.showphotos'},
allow_discussion_edit => $crsenv{'allow_discussion_post_editing'},
chat_roles_denied => $crsenv{'plc.roles.denied'},
chat_users_denied => $crsenv{'plc.users.denied'},
discussion_roles_denied => $crsenv{'pch.roles.denied'},
discussion_users_denied => $crsenv{'pch.users.denied'},
cloners => $crsenv{'cloners'},
disable_receipt_display => $crsenv{'disable_receipt_display'},
languages => $crsenv{'languages'},
clonedfrom => $crsenv{'clonedfrom'},
);
my %roles = &Apache::lonnet::get_course_adv_roles($cdom.'_'.$crs);
foreach my $role (sort keys %roles) {
if ($role eq 'Course Coordinator') {
my @ccroles = split/,/,$roles{$role};
foreach (@ccroles) {
my ($uname,$udom) = split/:/,$_;
if ($uname eq $owner) {
$ownerdom = $udom;
} elsif ($uname ne 'felicia' && $uname ne 'raeburn' && $uname ne 'albertelli') {
if (!$owner) {
$owner = $uname;
$ownerdom = $udom;
}
}
}
}
}
if ($owner) {
if (!$ownerdom) {
$ownerdom = $cdom;
}
print LOG "$code - Owner is $owner, ownerdom is $ownerdom\n";
push(@{$ownedcourses{$owner.':'.$ownerdom}},$cid);
unless (grep/^$owner:$ownerdom/,@allowners) {
push @allowners, $owner.':'.$ownerdom;
}
unless (defined($ownercourses{$owner.':'.$ownerdom})) {
$ownercourses{$owner.':'.$ownerdom} = 0;
}
my %ownerhash = &Apache::lonnet::dump('environment',$ownerdom,$owner);
foreach my $key (sort keys %ownerhash) {
if ($key eq 'firstname') {
$ownername = $ownerhash{$key};
} elsif ($key eq 'lastname') {
$ownername .= ' '.$ownerhash{$key};
} elsif ($key =~ /notification/) {
$ownermail = $ownerhash{$key};
$owneremails{$owner.':'.$ownerdom} = $ownermail;
}
}
$ownernames{$owner.':'.$ownerdom} = $ownername;
my %emailstatus = &Apache::lonnet::dump('email_status',$ownerdom,$owner);
foreach my $key (sort keys %emailstatus) {
if ($key eq 'logout') {
$lastactivity{$owner.':'.$ownerdom} = $emailstatus{$key};
}
}
}
# if ($stucount > 0 && $lastvisit > 0) {
$crsitems{$cid} = 0;
&Apache::lonroles::set_privileges($dom,$crs);
print LOG "$cid =".&Apache::lonnet::unescape($courses{$code}{$cid})."\n";
print LOG "lastvisit ".localtime($lastvisit)." count is $stucount owner is $ownername, e-mail is $ownermail\n";
$ownercourses{$owner.':'.$ownerdom} ++;
unless (defined($external{$cid})) {
$external{$cid} = 0;
}
unless (defined($homegrown{$cid})) {
$homegrown{$cid} = 0;
}
unless (defined($homedomain{$cid})) {
$homedomain{$cid} = 0;
}
unless (defined($uploaded{$cid})) {
$uploaded{$cid} = 0;
}
unless (defined($uploadtotal{$cid})) {
$uploaded{$cid} = 0;
}
unless (defined($crscount{$cid})) {
%{$crscount{$cid}} = ();
}
unless (defined($library{$cid})) {
$library{$cid} = 0;
}
unless (defined($numscantrons{$cid})) {
$numscantrons{$cid} = 0;
}
unless (defined($studentphotos{$cid})) {
$studentphotos{$cid} = 0;
}
%{$src_counts{$cid}} = ();
%{$prob_types{$cid}} = ();
%{$response_types{$cid}} = ();
%{$numparts{$cid}} = ();
%{$scripting{$cid}} = ();
%{$scriptdetails{$cid}} = ();
%{$alltags{$cid}} = ();
%{$hints{$cid}} = ();
%{$displays{$cid}} = ();
%{$duplicates{$cid}} = ();
%{$numdocmaps{$cid}} = ();
%{$allembedded{$cid}} = ();
%{$allembedded{$cid}{'uploaded'}} = ();
%{$allembedded{$cid}{'res'}} = ();
%{$codebase{$cid}} = ();
%{$codebase{$cid}{'uploaded'}} = ();
%{$codebase{$cid}{'res'}} = ();
my ($furl,$ferr) = &Apache::lonuserstate::readmap($cdom.'/'.$crs);
my %chathash = &Apache::lonnet::dump('nohist_chatroom',$cdom,$crs);
my %calhash = &Apache::lonnet::dump('calendar',$cdom,$crs);
my $chaterror = 0;
my $calerror = 0;
foreach my $key (sort(keys(%chathash))) {
if ($key =~ /^error:/) {
$chaterror = 1;
last;
}
}
foreach my $key (sort(keys(%calhash))) {
if ($key =~ /^error:/) {
$calerror = 1;
last;
}
}
unless ($chaterror) {
$chatcount{$cid} = scalar(keys(%chathash));
}
unless ($calerror) {
$calcount{$cid} = scalar(keys(%calhash));
}
# look for scantron files
my @scantronfiles = &Apache::grades::scantron_filenames();
$numscantrons{$cid} = scalar(@scantronfiles);
# look for user notes, broadcast messages, critical messages
my %broadcastmsg = ();
my %criticalmsg = ();
my %records=&Apache::lonnet::dump('nohist_email',$cdom,$crs);
foreach my $key (sort keys %records) {
unless ($key =~ /^error:/) {
my ($timestamp) = split(/:/,&Apache::lonnet::unescape($key));
my %content=&Apache::lonmsg::unpackagemsg($records{$key});
next if ($content{'senderdomain'} eq '');
if ($content{'subject'}=~/^Record/) {
$usernotes{$cid} ++;
} elsif ($content{'subject'}=~/^Broadcast/) {
if ($content{'subject'}=~/^Broadcast\./) {
if (defined($content{'coursemsgid'})) {
$broadcast{$cid} ++;
} else {
unless (exists($broadcastmsg{$timestamp})) {
$broadcastmsg{$timestamp} = 1;
$broadcast{$cid} ++;
}
}
} else {
if (defined($content{'coursemsgid'})) {
$critical{$cid} ++;
} else {
unless (exists($criticalmsg{$timestamp})) {
$criticalmsg{$timestamp} = 1;
$critical{$cid} ++;
}
}
}
}
}
}
# look for supplemental docs
&supp_docs_tree($cid,$crs,$cdom,$crsdir,'supplemental.sequence',$owner,$ownerdom);
# Discussion postings
my $navmap = Apache::lonnavmaps::navmap->new();
my @allres=$navmap->retrieveResources();
my %unread = ();
my $discussiondata = $navmap->get_discussion_data();
my %parse_done = ();
foreach my $resource (@allres) {
my $src = $resource->src();
$crsitems{$cid} ++;
&course_items($src,$cid,$cdom,$crs,$crsdir,$ownerdom,$owner,\%homegrown,\%homedomain,\%crscount,\%external,\%folders,\%pages,\%uploaded,\%uploadtotal,$allembedded{$cid},$codebase{$cid},\$studentphotos{$cid});
my $symb = $resource->symb();
if ($resource->is_problem()) {
my $responses = $resource->countResponses();
my %responseTypes = $resource->responseTypes();
foreach my $resptype (keys(%responseTypes)) {
$response_types{$cid}{$resptype} ++;
}
$numresponses{$cid} ++;
my @parts = @{$resource->parts()};
foreach my $part (@parts) {
my $type = $resource->type($part);
if ($type eq '') {$type = 'problem'; }
$prob_types{$cid}{$type} ++;
}
unless(defined($numparts{$cid}{$src})) {
$numparts{$cid}{$src} = scalar(@parts);
}
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my $respath = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res';
my $filepath = &Apache::lonnet::filelocation($respath,$url);
unless ($parse_done{$filepath}) {
%{$scripting{$cid}{$filepath}} = ();
%{$scriptdetails{$cid}{$filepath}} = ();
my $contents = &Apache::lonnet::getfile($filepath);
if ($contents == -1) {
print "$filepath had no contents\n";
} else {
&parse_problem($contents,$scripting{$cid}{$filepath},$scriptdetails{$cid}{$filepath},$alltags{$cid},$hints{$cid},$displays{$cid},\$library{$cid});
}
$parse_done{$filepath} = 1;
}
}
$src_counts{$cid}{$src} ++;
if ($resource->encrypted()) {
$numencrypted{$cid} ++;
}
if ($resource->is_map()) {
if ($src =~ /default(_?\d*)\.(sequence|page)$/) {
$numdocmaps{$cid}{$2} ++;
} else {
$numimportmaps{$cid} ++;
}
my $numpick = $resource->randompick();
$randompicks{$cid}{$numpick} ++;
if ($numpick) {
$numrandompicks{$cid} ++;
}
}
if ($resource->randomout()) {
$numhidden{$cid} ++;
}
if ($resource->condition() != 1) {
$numconditional{$cid} ++;
} elsif (!$resource->condval()) {
$numconditional{$cid} ++;
}
my $ressymb = $resource->wrap_symb();
%{$unread{$ressymb}} = ();
$unread{$ressymb}{'symb'} = $symb;
my $unreadcount = 0;
my $discsymb = $ressymb;
if ($ressymb =~ m-^(bulletin___\d+___)adm/wrapper/(adm/\w+/\w+/\d+/bulletinboard)$-) {
$discsymb = $1.$2;
}
my $version = $$discussiondata{'version:'.$discsymb};
if ($version) {
my $hiddenflag = 0;
my $deletedflag = 0;
my ($hidden,$deleted);
for (my $id=$version; $id>0; $id--) {
my $vkeys=$$discussiondata{$id.':keys:'.$discsymb};
my @keys=split(/:/,$vkeys);
if (grep/^hidden$/,@keys) {
unless ($hiddenflag) {
$hidden = $$discussiondata{$id.':'.$discsymb.':hidden'};
$hiddenflag = 1;
}
} elsif (grep/^deleted$/,@keys) {
unless ($deletedflag) {
$deleted = $$discussiondata{$id.':'.$discsymb.':deleted'};
$deletedflag = 1;
}
} else {
unless (($hidden =~/\.$id\./) || ($deleted =~/\.$id\./)) {
$unreadcount ++;
$unread{$ressymb}{$unreadcount} = $id.': '.
$$discussiondata{$id.':'.$discsymb.':subject'};
}
}
}
}
if ($unreadcount) {
$withdiscussion{$cid} ++;
$totalposts{$cid} += $unreadcount;
} else {
$nodiscussion{$cid} ++;
}
}
# }
}
}
delete($env{'user.name'});
delete($env{'user.home'});
delete($env{'user.domain'});
close(LOG);
}
# For each course owner..
foreach my $cc (@allowners) {
foreach my $cid (@{$ownedcourses{$cc}}) {
my ($sem) = ($cparms{$cid}{'coursecode'} =~ /^(\w{2}\d{2})/);
open(FILE,">/home/raeburn/fie/data/$sem/$cid.txt");
print FILE "total items = $crsitems{$cid}\n";
foreach my $key (sort(keys(%{$cparms{$cid}}))) {
print FILE "$key = $cparms{$cid}{$key}\n";
}
print FILE "chat entries = $chatcount{$cid}\n";
print FILE "calendar entries - $calcount{$cid}\n";
foreach my $src (sort keys %{$src_counts{$cid}}) {
if ($src_counts{$cid}{$src} > 1) {
$duplicates{$cid}{$src_counts{$cid}{$src}} ++;
}
}
my %histoparts = ();
my %function_calls = ();
my %script_vars = ();
print FILE "Hidden total = $numhidden{$cid}\n";
print FILE "Encrypted total = $numencrypted{$cid}\n";
print FILE "Conditional total = $numconditional{$cid}\n";
print FILE "Randompick total = $numrandompicks{$cid}\n";
print FILE "Imported maps = $numimportmaps{$cid}\n";
print FILE "Folders/Composite Pages added in DOCS: ";
foreach my $map (sort(keys(%{$numdocmaps{$cid}}))) {
print FILE "$map=$numdocmaps{$cid}{$map} ";
}
print FILE "\n";
foreach my $src (sort(keys(%{$numparts{$cid}}))) {
$histoparts{$numparts{$cid}{$src}} ++;
}
print FILE "Types: ";
foreach my $type (sort(keys(%{$prob_types{$cid}}))) {
print FILE "$type=$prob_types{$cid}{$type} ";
}
print FILE "\n";
print FILE "Response types: ";
foreach my $resptype (sort(keys(%{$response_types{$cid}}))) {
print FILE "$resptype=$response_types{$cid}{$resptype} ";
}
print FILE "\n";
print FILE "Total number of responses is $numresponses{$cid}\n";
foreach my $tag (sort(keys(%{$alltags{$cid}}))) {
print FILE "tag is $tag, number is $alltags{$cid}{$tag}\n";
}
foreach my $tag (sort(keys(%{$hints{$cid}}))) {
print FILE "hint types is $tag, number is $hints{$cid}{$tag}\n";
}
foreach my $tag (sort(keys(%{$displays{$cid}}))) {
print FILE "display type is $tag, number is $displays{$cid}{$tag}\n";
}
foreach my $filepath (sort(keys(%{$scripting{$cid}}))) {
foreach my $item (keys(%{$scripting{$cid}{$filepath}})) {
$function_calls{$filepath} .= "$item - $scripting{$cid}{$filepath}{$item} ";
$allfunctions{$cid}{$item} += $scripting{$cid}{$filepath}{$item};
}
}
foreach my $filepath (sort(keys(%{$scriptdetails{$cid}}))) {
foreach my $item (sort keys(%{$scriptdetails{$cid}{$filepath}})) {
$script_vars{$filepath} .= "$item - $scriptdetails{$cid}{$filepath}{$item} ";
$allvars{$cid}{$item} += $scriptdetails{$cid}{$filepath}{$item};
}
}
print FILE "Number of library files imported = $library{$cid}\n";
print FILE "Parts: ";
foreach my $num (sort(keys(%histoparts))) {
print FILE "$num - $histoparts{$num} ";
}
print FILE "\nRandompicks: ";
foreach my $num (sort(keys(%{$randompicks{$cid}}))) {
if ($num) {
print FILE "$num - $randompicks{$cid}{$num} ";
}
}
print FILE "\nDuplicates: ";
foreach my $num (sort(keys(%{$duplicates{$cid}}))) {
print FILE "$num - $duplicates{$cid}{$num} ";
}
print FILE "\nFunctions: \n";
my @filepaths = sort(keys(%function_calls));
for (my $i=0; $i<@filepaths; $i++) {
my $showcounter = $i+1;
print FILE "$showcounter: $function_calls{$filepaths[$i]}\n";
}
print FILE "Total functions: ";
foreach my $func (sort(keys(%{$allfunctions{$cid}}))) {
print FILE "$func=$allfunctions{$cid}{$func} ";
}
print FILE "\nScript Vars: \n";
my @filepaths = sort(keys(%script_vars));
for (my $i=0; $i<@filepaths; $i++) {
my $showcounter = $i+1;
print FILE "$showcounter: $script_vars{$filepaths[$i]}\n";
}
print FILE "Total variables: ";
foreach my $var (sort(keys(%{$allvars{$cid}}))) {
print FILE "$var=$allvars{$cid}{$var} ";
}
print FILE "\n";
foreach my $item (sort(keys(%{$allembedded{$cid}}))) {
my %embedcount = ();
foreach my $file (sort(keys(%{$allembedded{$cid}{$item}}))) {
my ($extension)=($file=~/\.(\w+)$/);
$extension = lc($extension);
if ($extension) {
$embedcount{$extension} ++;
}
}
print FILE "Embedded items in html files in $item ";
foreach my $ext (sort(keys(%embedcount))) {
print FILE "$ext=$embedcount{$ext} ";
}
print FILE "\n";
}
foreach my $item (sort(keys(%{$codebase{$cid}}))) {
foreach my $file (sort(keys(%{$codebase{$cid}{$item}}))) {
my ($extension)=($file=~/\.(\w+)$/);
print "codebase $item is $file, extension is $extension\n";
}
}
print FILE "Scantron files = $numscantrons{$cid}\n";
print FILE "Files with student photos = $studentphotos{$cid}\n";
print FILE "Imported total = $external{$cid}\n";
print FILE "Homegrown total = $homegrown{$cid}\n";
print FILE "Homedomain total = $homedomain{$cid}\n";
print FILE "Uploaded total = $uploaded{$cid}\n";
print FILE "Uploaded total bytes = $uploadtotal{$cid}\n";
print FILE "Supplemental total = $supplemental{$cid}\n";
print FILE "Supplemental total bytes = $supplementaltotal{$cid}\n";
print FILE "External web sites total = $extweb{$cid}\n";
print FILE "With discussion = $withdiscussion{$cid}\n";
print FILE "No discussion = $nodiscussion{$cid}\n";
print FILE "Total posts = $totalposts{$cid}\n";
print FILE "Total broadcast messages = $broadcast{$cid}\n";
print FILE "Total critical messages = $critical{$cid}\n";
print FILE "Total user notes = $usernotes{$cid}\n";
foreach my $key (sort keys %{$crscount{$cid}}) {
print FILE "Course item -- $key, value is $crscount{$cid}{$key}\n";
}
}
close(FILE);
my ($uname,$udom) = split/:/,$cc;
open(OWNER,">/home/raeburn/fie/data/$uname$udom.dat");
print OWNER "Total number of courses for $ownernames{$cc} ($cc) = $ownercourses{$cc}\n";
%{$totals{$cc}} = ();
%{$sizes{$cc}} = ();
%{$publish{$cc}} = ();
if (grep/^$udom/,@domains) {
print OWNER "Last activity ".localtime($lastactivity{$cc})." $uname uses this server as a homeserver\n";
if (-e "/home/$uname/public_html") {
# &readtree("/home/$uname/public_html",\%totals,\%sizes,\%publish,$cc,$uname,$udom);
}
foreach my $type (sort keys %{$totals{$cc}}) {
print OWNER "$cc -- $type - total files = $totals{$cc}{$type}\n";
print OWNER "$cc -- $type - total published = $publish{$cc}{$type}\n";
print OWNER "$cc -- $type - total bytes = $sizes{$cc}{$type}\n";
}
} else {
print OWNER "$ownernames{$cc} ($cc) uses $udom server as a homeserver\n";
}
close(OWNER);
}
sub supp_docs_tree {
my ($cid,$crs,$cdom,$crsdir,$folder,$owner,$ownerdom) = @_;
my $errtext='';
my $fatal=0;
my $idx=0;
($errtext,$fatal)=
&Apache::lonratedt::mapread('/uploaded/'.$cdom.'/'.$crs.'/'.
$folder);
if ($#Apache::lonratedt::order<1) {
$idx=&Apache::lonratedt::getresidx();
if ($idx<=0) { $idx=1; }
$Apache::lonratedt::order[0]=$idx;
$Apache::lonratedt::resources[$idx]='';
}
foreach (@Apache::lonratedt::order) {
my ($name,$url)=split(/\:/,$Apache::lonratedt::resources[$_]);
$name=&Apache::lonratsrv::qtescape($name);
$url=&Apache::lonratsrv::qtescape($url);
unless ($name) { $name=(split(/\//,$url))[-1]; }
unless ($name) { $idx++; next; }
if (($url=~ m-^http\&colon\;|:-) || ($url=~m|^/ext/|)) {
$extweb{$cid} ++;
next;
}
my ($extension)=($url=~/\.(\w+)$/);
$crscount{$cid}{$extension} ++;
$supplemental{$cid} ++;
if ($extension eq 'sequence') {
$folders{$cid} ++;
my ($folder) = ($url=~ m-/([^/]+\.\Q$extension\E)$-);
&supp_docs_tree($crs,$cdom,$crsdir,$folder,$owner,$ownerdom);
} elsif ($extension eq 'page') {
$pages{$cid} ++;
my $folder = ($url=~ m-/([^/]+\.\Q$extension\E)$-);
&supp_docs_tree($crs,$cdom,$1);
} else {
my $filepath = $url;
$filepath =~ s#^/uploaded/$cdom/$crs#$crsdir/userfiles/#;
if (-e "$filepath") {
my @fileinfo = stat($filepath);
$supplementaltotal{$cid} += $fileinfo[7];
}
}
$idx++;
}
}
sub readtree {
my ($dir,$totals,$sizes,$publish,$author,$uname,$udom) = @_;
opendir(DIR,$dir);
my @items = grep(!/^\.\.?/,readdir(DIR));
closedir(DIR);
foreach my $item (@items) {
if (-d "$dir/$item") {
$$totals{$author}{dirs} ++;
my $resdir = "$dir/$item";
$resdir =~ s#/home/$uname/public_html#/home/httpd/html/res/$udom/$uname#;
if (-d $resdir) {
$$publish{$author}{dirs} ++;
}
&readtree("$dir/$item",$totals,$sizes,$publish,$author,$uname,$udom);
} else {
my @statinfo = stat("$dir/$item");
my $published = 0;
my $size = $statinfo[7];
my $resitem = "$dir/$item";
$resitem =~ s#/home/$uname/public_html#/home/httpd/html/res/$udom/$uname#;
if (-e "$resitem") {
$published = 1;
}
if ($item =~/\.(\w+)$/) {
my $curfext = $1;
$curfext = lc($curfext);
unless ($curfext eq 'bak' || $curfext eq 'log' ||$curfext eq 'meta' || $curfext eq 'save') {
$$totals{$author}{$curfext} ++;
if ($published) {
$$publish{$author}{$curfext} ++;
}
$$sizes{$author}{$curfext} += $size;
my $embstyle = &Apache::loncommon::fileembstyle($curfext);
if ($embstyle eq 'img') {
$$totals{$author}{img} ++;
if ($published) {
$$publish{$author}{img} ++;
}
$$sizes{$author}{img} += $size;
}
}
} else {
$$totals{$author}{noext} ++;
if ($published) {
$$publish{$author}{noext} ++;
}
$$sizes{$author}{noext} += $size;
}
}
}
}
sub parse_problem {
my ($content,$scripting,$scriptdetails,$alltags,$hints,$displays,$library) = @_;
my @tags = ('window','gnuplot','img','import','script','part','block','randomlist','while','problemtype');
my @displaytags = ('postanswerdate','preduedate','solved','notsolved');
my @hinttags = ('stringhint','optionhint','radiobuttonhint','numericalhint','formulahint');
my $p = HTML::LCParser->new(\$content);
while (my $t=$p->get_token()) {
if ($t->[0] eq 'S') {
my ($tagname, $attr) = ($t->[1],$t->[2]);
if (grep/^$tagname$/,@tags) {
if ($tagname eq 'import') {
my $value=$p->get_text('/'.$tagname);
if ($value =~ /\.library$/) {
$$library ++;
}
}
$$alltags{$tagname} ++;
} elsif (grep/^$tagname$/,@hinttags) {
$$hints{$tagname} ++;
} elsif (grep/^$tagname$/,@displaytags) {
$$displays{$tagname} ++;
}
if ($tagname eq 'script') {
if ($$attr{type} eq 'loncapa/perl') {
my @uniqarrays = ();
my @uniqhashes = ();
my @uniqscalars = ();
my @uniqsubs = ();
my $value=$p->get_text('/'.$tagname);
my (@functions) = ($value =~ /=\s*\&(\w+)\(/gs);
my (@arrayitems) = ($value =~ /\$(\w+)\[[\$\w]+\]/gs);
my (@hashitems) = ($value =~ /\$(\w+)\{[\$\w]+\}/gs);
my (@allscalars) = ($value =~ /\$(\w+)[^\[\{\w]/gs);
my (@subroutines) = ($value =~ /sub\s+(\w+)\s*\{/gs);
foreach my $name (@allscalars) {
unless (grep/^$name$/,@uniqscalars) {
push (@uniqscalars,$name);
}
}
my @allarrays = ($value =~ /\@(\w+)/gs);
push(@allarrays,@arrayitems);
foreach my $name (@allarrays) {
unless (grep/^$name$/,@uniqarrays) {
push (@uniqarrays,$name);
}
}
my (@allhashes) = ($value =~ /\%(\w+)/gs);
push(@allhashes,@hashitems);
foreach my $name (@allhashes) {
unless (grep/^$name$/,@uniqhashes) {
push (@uniqhashes,$name);
}
}
foreach my $func (@functions) {
if (grep/^$func$/,@subroutines) {
unless (grep/^$func$/,@uniqsubs) {
push (@uniqsubs,$func);
}
}
$$scripting{$func} ++;
}
my @lines = split/\n/,$value;
$$scriptdetails{'lines'} += scalar(@lines);
$$scriptdetails{'scalars'} += scalar(@uniqscalars);
$$scriptdetails{'arrays'} += scalar(@uniqarrays);
$$scriptdetails{'hashes'} += scalar(@uniqhashes);
$$scriptdetails{'subs'} += scalar(@uniqsubs);
}
}
}
}
return;
}
sub course_items {
my ($src,$cid,$cdom,$crs,$crsdir,$ownerdom,$owner,$homegrown,$homedomain,$crscount,$external,$folders,$pages,$uploaded,$uploadtotal,$allembedded,$codebase,$studentphotos) = @_;
my $extension;
$src =~ s#^/adm/wrapper##;
if ($src =~ m-^/res/([^/]+)/([^/]+)/-) {
if ($1 eq $ownerdom && $2 eq $owner) {
$$homegrown{$cid} ++;
} elsif ($1 eq $ownerdom) {
$$homedomain{$cid} ++;
} else {
if ($1 eq 'lib' && $2 eq 'templates') {
if ($src =~ m-/([^/]+)\.problem$-) {
$$crscount{$cid}{$1} ++;
}
} else {
$$external{$cid} ++;
}
}
($extension) = ($src =~ m/\.([^\.]+)$/);
$$crscount{$cid}{$extension} ++;
} elsif (($src =~ m-^/adm/-) && ($src !~ m-/coursedocs/showdoc-)) {
$src =~ s/\?[^\?]*$//g;
($extension) = ($src =~ m-/([^/]+)$-);
$$crscount{$cid}{$extension} ++;
} elsif ($src =~ m-/uploaded/-) {
($extension) = ($src =~ m-\.([^\.]+)$-);
$$crscount{$cid}{$extension} ++;
if ($extension eq 'sequence') {
$$folders{$cid} ++;
} elsif ($extension eq 'page') {
$$pages{$cid} ++;
} else {
$$uploaded{$cid} ++;
my $filepath = $src;
$filepath =~ s#^/uploaded/$cdom/$crs#$crsdir/userfiles/#;
if (-e "$filepath") {
my @fileinfo = stat($filepath);
$$uploadtotal{$cid} += $fileinfo[7];
}
}
} elsif ($src =~ m-^/public/-) {
$src =~ s/\?[^\?]*$//g;
if ($src =~ m-syllabus$-) {
$$crscount{$cid}{syllabus} ++;
} else {
$$crscount{$cid}{public} ++;
}
}
if ($extension =~ /html?$/i) {
my $filepath = $src;
my $origin;
if ($src =~ m-^/res/-) {
$origin = 'res';
$filepath = $Apache::lonnet::perlvar{'lonDocRoot'}.$src;
} else {
$origin = 'upload';
$filepath =~ s#^/uploaded/$cdom/$crs#$crsdir/userfiles/#;
}
my $content = &Apache::lonnet::getfile($filepath);
if ($content == -1) {
print "$filepath had no contents\n";
} elsif ($content) {
&Apache::lonnet::extract_embedded_items(undef,undef,$$allembeddea{$origin},$$codebase{$origin},\$content);
if ($content =~ m-<displaystudentphoto\s*/>-i) {
$$studentphotos ++;
}
}
}
}
--raeburn1143823977--