[LON-CAPA-cvs] cvs: modules /raeburn treescript.pl
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Tue, 14 Oct 2008 14:07:54 -0000
This is a MIME encoded message
--raeburn1223993274
Content-Type: text/plain
raeburn Tue Oct 14 10:07:54 2008 EDT
Added files:
/modules/raeburn treescript.pl
Log:
- Script for BS110 Tree Database project.
- Teams of students upload a file to essayresponse in three symbs.
- Script copies uploaded file to a group portfolio, provides metadata and sets public access.
- Keyword set to unique treeid.
--raeburn1223993274
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20081014100754.txt"
Index: modules/raeburn/treescript.pl
+++ modules/raeburn/treescript.pl
#! /usr/bin/perl
use strict;
use lib '/home/httpd/lib/perl';
use File::Copy;
use LONCAPA;
use LONCAPA::Configuration;
use Apache::lonnet;
use Apache::loncommon;
use Apache::loncoursedata;
use Apache::lonmsg();
my @symbs = ('uploaded/raeburn/252592161b1eb48a7raeburnl1/default_1223747108.sequence___3___raeburn/sturaeburn/TreeData/dbh.problem',
'uploaded/raeburn/252592161b1eb48a7raeburnl1/default_1223747108.sequence___4___raeburn/sturaeburn/TreeData/dbh.problem',
'uploaded/raeburn/252592161b1eb48a7raeburnl1/default_1223747108.sequence___5___raeburn/sturaeburn/TreeData/dbh.problem');
my $owner = 'bs110admin:raeburn';
my $author = 'bs110 administrator';
my $group = 'allstudents';
my $cdom = 'raeburn';
my $cnum = '252592161b1eb48a7raeburnl1';
my $nextnum;
my $currnum;
my $nextteam;
my $currteam;
my $basepath = &propath($cdom,$cnum);
my $logfh;
my @updates;
my %teams;
my @newteams;
if (!open($logfh, ">>$basepath/trees.log")) {
# Determine who we email in case of errors.
my $perlvar= LONCAPA::Configuration::read_conf('loncapa.conf');
my $defdom = $perlvar->{'lonDefDomain'};
my $origmail = $perlvar->{'lonAdmEMail'};
my $recipients = &Apache::loncommon::build_recipient_list(undef,
'errormail',$defdom,$origmail);
if ($recipients ne '') {
my $errormsg = 'treescript.pl failed to open logfile - '."$basepath/trees.log\n";
&Apache::lonmsg::sendemail($recipients,'treescript_error',$errormsg);
return;
}
} else {
print $logfh '********************'."\n".localtime(time).' Tree Method File upload messages start --'."\n";
}
my $earlyout = 0;
if (-e "$basepath/trees.dat") {
if (open(my $fh,"<$basepath/trees.dat")) {
$currnum = <$fh>;
close($fh);
chomp($currnum);
if ($currnum !~ /^\d+$/) {
print $logfh "Error: counter retrieved from $basepath/trees.dat is not a number\n";
$earlyout = 1;
}
} else {
print $logfh "Could not open $basepath/trees.dat\n";
$earlyout = 1;
}
} else {
$currnum = 1;
}
if (-e "$basepath/treeteams.dat") {
if (open(my $fh,"<$basepath/treeteams.dat")) {
$currteam = <$fh>;
close($fh);
chomp($currteam);
if ($currteam !~ /^\d+$/) {
print $logfh "Error: counter retrieved from $basepath/treeteams.dat is not a number\n";
$earlyout = 1;
}
} else {
print $logfh "Could not open $basepath/treeteams.dat\n";
$earlyout = 1;
}
} else {
$currteam = 1;
}
if (-e "$basepath/treeteamlookup.dat") {
if (open(my $fh,"<$basepath/treeteamlookup.dat")) {
my @allteams = <$fh>;
close($fh);
chomp(@allteams);
foreach my $team (@allteams) {
my ($key,$val) = split(',',$team);
$teams{$key} = $val;
}
} else {
print $logfh "Could not open $basepath/treeteamlookup.dat\n";
$earlyout = 1;
}
}
if ($earlyout) {
print $logfh '-- '.localtime(time).' Tree Method File upload messages end'."\n*******************\n\n";
close($logfh);
return;
}
$nextnum = $currnum;
$nextteam = $currteam;
my $filepath = $basepath.'/userfiles/groups/'.$group.'/portfolio';
my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
my $secidx = &Apache::loncoursedata::CL_SECTION();
while (my ($student,$data) = each %$classlist) {
my ($stuname,$studom) = split(':',$student);
my $section = $data->[$secidx];
&get_files($cdom,$cnum,$group,\@symbs,$filepath,$stuname,$studom,$section,\$nextnum,\$nextteam,$logfh,$owner,$author,\@updates,\%teams,\@newteams);
}
if (@updates > 0) {
print $logfh join("\n",@updates)."\n";
} else {
print $logfh "No updates required\n";
}
if (@newteams > 0) {
if (open(my $fh,">>$basepath/treeteamlookup.dat")) {
foreach my $team (@newteams) {
print $fh $team.','.$teams{$team}."\n";
}
close($fh);
} else {
print $logfh "Error opening $basepath/treeteamlookup.dat to store newteams.\n";
}
}
if ($nextnum > $currnum) {
if (open(my $fh,">$basepath/trees.dat")) {
print $fh "$nextnum\n";
close($fh);
} else {
print $logfh "Error opening $basepath/trees.dat to store $nextnum\n";
}
}
if ($nextteam > $currteam) {
if (open(my $fh,">$basepath/treeteams.dat")) {
print $fh "$nextteam\n";
close($fh);
} else {
print $logfh "Error opening $basepath/treeteams.dat to store $nextteam\n";
}
}
print $logfh "-- ".localtime(time).' Tree Method File upload messages end'."\n*******************\n\n";
close($logfh);
sub get_files {
my ($cdom,$cnum,$group,$symbs,$filepath,$stuname,$studom,$section,$nextnum,
$nextteam,$logfh,$owner,$author,$updates,$teams,$newteams) = @_;
if (ref($symbs) eq 'ARRAY') {
foreach my $symb (@{$symbs}) {
my %record = &Apache::lonnet::restore($symb,$cdom.'_'.$cnum,$studom,$stuname);
my $treeid = $record{'resource.dbh.11.submission'};
my $srcpath = &propath($studom,$stuname);
my $partid = '24';
my $respid = 'upload';
my $collablist = $record{'resource.'.$partid.'.'.$respid.'.collaborators'};
my $lastsubmit = $record{'timestamp'};
my @allfiles;
if ($record{'resource.'.$partid.'.'.$respid.'.uploadedfile'} ne '') {
my $file = $record{'resource.'.$partid.'.'.$respid.'.uploadedfile'};
push(@allfiles,$srcpath.'/userfiles/essayresponse/'.$file);
}
foreach my $file (split(',',$record{"resource.$partid.$respid.portfiles"})) {
push(@allfiles,$srcpath.'/userfiles/portfolio/'.$file);
}
if (@allfiles > 1) {
print $logfh "$stuname:$studom uploaded multiple files: ".join(', ',@allfiles);
} elsif (@allfiles == 1) {
my ($mime) = ($allfiles[0] =~ /\.(\w+)$/);
my @ok_collabs;
my @collabs = split(/,?\s+/,$collablist);
foreach my $item (@collabs) {
my $uname;
if ($item =~ /^($LONCAPA::match_username):$LONCAPA::match_domain$/) {
$uname = $1;
} else {
$uname = $item;
}
if (($uname ne '') && (!grep(/^\Q$uname\E$/,@ok_collabs))) {
push(@ok_collabs,$uname);
}
}
if (!grep(/^\Q$stuname\E$/,@ok_collabs)) {
unshift(@ok_collabs,$stuname);
}
my $stulist = join(',',@ok_collabs);
my @sort_collabs = sort(@ok_collabs);
my $team_id = join('_',@sort_collabs);
my $id;
if (ref($teams) eq 'HASH') {
if ($teams->{$team_id} ne '') {
$id = $teams->{$team_id};
}
}
if (!$id) {
$id = $$nextteam;
$teams->{$team_id} = $$nextteam;
$id = $teams->{$team_id};
$$nextteam ++;
if (ref($newteams) eq 'ARRAY') {
push(@{$newteams},$team_id);
}
}
my $destname = 'fs08bs110'.$section.'_'.$id.'_'.$treeid.'.'.$mime;
&write_metadata($allfiles[0],$filepath,$destname,$lastsubmit,$cdom,$cnum,$group,$treeid,$stulist,$lastsubmit,$mime,$nextnum,$owner,$author,$updates);
}
}
}
return;
}
sub write_metadata {
my ($srcname,$filepath,$fname,$lastsubmit,$cdom,$cnum,$group,$treeid,$stulist,$timestamp,$mime,$nextnum,$owner,$author,$updates) = @_;
my $uri = '/uploaded/'.$cdom.'/'.$cnum.'/groups/'.$group.'/portfolio/'.$fname;
my $metauri = $uri.'.meta';
my $fn=&Apache::lonnet::filelocation('',$metauri);
my %content;
my $title;
if (-e $fn) {
foreach my $item (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
$content{$item}=&Apache::lonnet::metadata($uri,$item);
}
if ($content{'timestamp'} == $lastsubmit) {
return;
} else {
$title = $content{'title'};
}
} else {
my $filenum = $$nextnum;
while (length($filenum) < 4) {
$filenum = '0'.$filenum;
}
$title = 'fs08bs110_'.$filenum;
$$nextnum ++;
}
my $dest = $filepath.'/'.$fname;
if (!©file($srcname,$dest)) {
print $logfh "Failed to copy $srcname to $filepath/$fname\n";
return;
}
my $file_content = "\n".
'<author>'.$author.'</author>'."\n".
'<copyright>default</copyright>'."\n".
'<courserestricted>course.'.$cdom.'_.'.$cnum.'</courserestricted>'."\n".
'<keywords>'.$treeid.'</keywords>'. "\n".
'<mime>'.$mime.'</mime>'."\n".
'<owner>'.$owner.'</owner>'."\n".
'<title>'.$title.'</title>'."\n".
'<students>'.$stulist.'</students>'."\n".
'<timestamp>'.$timestamp.'</timestamp>'."\n".
'<treeid>'.$treeid.'</treeid>'."\n";
if (!open(my $mfh,">$fn")) {
print $logfh "Failed to open $fn to store metadata\n";
} else {
print $mfh ($file_content);
close($mfh);
&Apache::lonnet::update_portfolio_table($cnum,$cdom,
$group.'/'.$fname,'portfolio_metadata',$group,'update');
&Apache::lonnet::make_public_indefinitely($uri);
if (ref($updates) eq 'ARRAY') {
push (@{$updates},"$fname -- $stulist");
}
}
return;
}
sub copyfile {
my ($src,$dest) = @_;
if (!copy($src,$dest)) {
return 0;
} elsif (!chmod(0660,$dest)) {
return 0;
} else {
return 1;
}
}
--raeburn1223993274--