--- loncom/interface/lonmeta.pm 2001/12/19 17:17:46 1.8
+++ loncom/interface/lonmeta.pm 2003/02/18 21:17:00 1.25
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Metadata display handler
#
-# $Id: lonmeta.pm,v 1.8 2001/12/19 17:17:46 albertel Exp $
+# $Id: lonmeta.pm,v 1.25 2003/02/18 21:17:00 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -29,19 +29,145 @@
#
# 05/29/00,05/30,10/11 Gerd Kortemeyer)
#
-# 10/19,10/21,10/23,11/27,08/09/01 Gerd Kortemeyer
+# 10/19,10/21,10/23,11/27,08/09/01,12/22,12/24,12/25 Gerd Kortemeyer
package Apache::lonmeta;
use strict;
use Apache::Constants qw(:common);
use Apache::lonnet();
+use Apache::loncommon();
+use Apache::lonmsg;
+use Apache::lonpublisher;
+
+# ----------------------------------------- Fetch and evaluate dynamic metadata
+
+sub dynamicmeta {
+ my $url=&Apache::lonnet::declutter(shift);
+ $url=~s/\.meta$//;
+ my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);
+ my $regexp=$url;
+ $regexp=~s/(\W)/\\$1/g;
+ $regexp='___'.$regexp.'___';
+ my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
+ $aauthor,$regexp);
+ my %sum;
+ my %cnt;
+ my %listitems=('count' => 'add',
+ 'course' => 'add',
+ 'avetries' => 'avg',
+ 'stdno' => 'add',
+ 'difficulty' => 'avg',
+ 'clear' => 'avg',
+ 'technical' => 'avg',
+ 'helpful' => 'avg',
+ 'correct' => 'avg',
+ 'depth' => 'avg',
+ 'comments' => 'app',
+ 'usage' => 'cnt'
+ );
+ foreach (keys %evaldata) {
+ $_=~/___(\w+)$/;
+ if (defined($cnt{$1})) { $cnt{$1}++; } else { $cnt{$1}=1; }
+ unless ($listitems{$1} eq 'app') {
+ if (defined($sum{$1})) {
+ $sum{$1}+=$evaldata{$_};
+ } else {
+ $sum{$1}=$evaldata{$_};
+ }
+ } else {
+ if (defined($sum{$1})) {
+ if ($evaldata{$_}) {
+ $sum{$1}.='<hr>'.$evaldata{$_};
+ }
+ } else {
+ $sum{$1}=''.$evaldata{$_};
+ }
+ }
+ }
+ my %returnhash=();
+ foreach (keys %cnt) {
+ if ($listitems{$_} eq 'avg') {
+ $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;
+ } elsif ($listitems{$_} eq 'cnt') {
+ $returnhash{$_}=$cnt{$_};
+ } else {
+ $returnhash{$_}=$sum{$_};
+ }
+ }
+ return %returnhash;
+}
+
+# ------------------------------------- Try to make an alt tag if there is none
+sub alttag {
+ my $src=shift;
+ return 'None';
+}
+
+# -------------------------------------------------------------- Pretty display
+
+sub evalgraph {
+ my $value=shift;
+ unless ($value) { return ''; }
+ my $val=int($value*10.+0.5)-10;
+ my $output='<table border=0 cellpadding=0 cellspacing=0><tr>';
+ if ($val>=20) {
+ $output.='<td width=20 bgcolor="#555555">  </td>';
+ } else {
+ $output.='<td width='.($val).' bgcolor="#555555"> </td>'.
+ '<td width='.(20-$val).' bgcolor="#FF3333"> </td>';
+ }
+ $output.='<td bgcolor="#FFFF33"> </td>';
+ if ($val>20) {
+ $output.='<td width='.($val-20).' bgcolor="#33FF33"> </td>'.
+ '<td width='.(40-$val).' bgcolor="#555555"> </td>';
+ } else {
+ $output.='<td width=20 bgcolor="#555555">  </td>';
+ }
+ $output.='<td> ('.$value.') </td></tr></table>';
+ return $output;
+}
+
+sub diffgraph {
+ my $value=shift;
+ unless ($value) { return ''; }
+ my $val=int(40.0*$value+0.5);
+ my @colors=('#FF9933','#EEAA33','#DDBB33','#CCCC33',
+ '#BBDD33','#CCCC33','#DDBB33','#EEAA33');
+ my $output='<table border=0 cellpadding=0 cellspacing=0><tr>';
+ for (my $i=0;$i<8;$i++) {
+ if ($val>$i*5) {
+ $output.='<td width=5 bgcolor="'.$colors[$i].'"> </td>';
+ } else {
+ $output.='<td width=5 bgcolor="#555555"> </td>';
+ }
+ }
+ $output.='<td> ('.$value.') </td></tr></table>';
+ return $output;
+}
# ================================================================ Main Handler
sub handler {
my $r=shift;
+
+ my $loaderror=&Apache::lonnet::overloaderror($r);
+ if ($loaderror) { return $loaderror; }
+
+
+ my $uri=$r->uri;
+
+ unless ($uri=~/^\/\~/) {
+# =========================================== This is not in construction space
+ my ($resdomain,$resuser)=
+ (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
+
+ $loaderror=
+ &Apache::lonnet::overloaderror($r,
+ &Apache::lonnet::homeserver($resuser,$resdomain));
+ if ($loaderror) { return $loaderror; }
+
my %content=();
# ----------------------------------------------------------- Set document type
@@ -52,44 +178,67 @@ sub handler {
return OK if $r->header_only;
# ------------------------------------------------------------------- Read file
-
- my $uri=$r->uri;
- map {
+ foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
$content{$_}=&Apache::lonnet::metadata($uri,$_);
- } split(/\,/,&Apache::lonnet::metadata($uri,'keys'));
-
+ }
# ------------------------------------------------------------------ Hide stuff
unless ($ENV{'user.adv'}) {
- map {
+ foreach ('keywords','notes','abstract','subject') {
$content{$_}='<i>- not displayed -</i>';
- } ('keywords','notes','abstract','subject');
+ }
}
# --------------------------------------------------------------- Render Output
-
-my $creationdate=localtime($content{'creationdate'});
-my $lastrevisiondate=localtime($content{'lastrevisiondate'});
-
+ my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
+my $creationdate=localtime(
+ &Apache::loncommon::unsqltime($content{'creationdate'}));
+my $lastrevisiondate=localtime(
+ &Apache::loncommon::unsqltime($content{'lastrevisiondate'}));
+my $language=&Apache::loncommon::languagedescription($content{'language'});
+my $mime=&Apache::loncommon::filedescription($content{'mime'});
+my $disuri=&Apache::lonnet::declutter($uri);
+ $disuri=~s/\.meta$//;
+my $currentversion=&Apache::lonnet::getversion($disuri);
+my $versiondisplay='';
+if ($thisversion) {
+ $versiondisplay='Version: '.$thisversion.
+ ' (most recent version: '.$currentversion.')';
+} else {
+ $versiondisplay='Version: '.$currentversion;
+}
+my $bodytag=&Apache::loncommon::bodytag
+ ('Catalog Information','','','',$resdomain);
$r->print(<<ENDHEAD);
<html><head><title>Catalog Information</title></head>
-<body bgcolor="#FFFFFF">
-<h1>Catalog Information</h1>
+$bodytag
<h2>$content{'title'}</h2>
-<h3>Author(s): $content{'author'}</h3>
-<b>Subject:</b> $content{'subject'}<br>
-<b>Keyword(s):</b> $content{'keywords'}<br>
-<b>Notes:</b> $content{'notes'}<br>
-<b>Abstract:</b>
-<blockquote>$content{'abstract'}</blockquote>
-<hr>
-<b>MIME Type:</b> $content{'mime'}<br>
-<b>Language:</b> $content{'language'}<br>
-<b>Creation Date:</b> $creationdate<br>
-<b>Last Revision Date:</b> $lastrevisiondate<br>
-<b>Publisher/Owner:</b> $content{'owner'}<br>
-<b>Copyright/Distribution:</b> $content{'copyright'}
-<hr>
+<h3><tt>$disuri</tt></h3>
+$versiondisplay<br />
+<table cellspacing=2 border=0>
+<tr><td bgcolor='#AAAAAA'>Author(s)</td>
+<td bgcolor="#CCCCCC">$content{'author'} </td></tr>
+<tr><td bgcolor='#AAAAAA'>Subject</td>
+<td bgcolor="#CCCCCC">$content{'subject'} </td></tr>
+<tr><td bgcolor='#AAAAAA'>Keyword(s)</td>
+<td bgcolor="#CCCCCC">$content{'keywords'} </td></tr>
+<tr><td bgcolor='#AAAAAA'>Notes</td>
+<td bgcolor="#CCCCCC">$content{'notes'} </td></tr>
+<tr><td bgcolor='#AAAAAA'>Abstract</td>
+<td bgcolor="#CCCCCC">$content{'abstract'} </td></tr>
+<tr><td bgcolor='#AAAAAA'>MIME Type</td>
+<td bgcolor="#CCCCCC">$mime ($content{'mime'}) </td></tr>
+<tr><td bgcolor='#AAAAAA'>Language</td>
+<td bgcolor="#CCCCCC">$language </td></tr>
+<tr><td bgcolor='#AAAAAA'>Creation Date</td>
+<td bgcolor="#CCCCCC">$creationdate </td></tr>
+<tr><td bgcolor='#AAAAAA'>
+Last Revision Date</td><td bgcolor="#CCCCCC">$lastrevisiondate </td></tr>
+<tr><td bgcolor='#AAAAAA'>Publisher/Owner</td>
+<td bgcolor="#CCCCCC">$content{'owner'} </td></tr>
+<tr><td bgcolor='#AAAAAA'>Copyright/Distribution</td>
+<td bgcolor="#CCCCCC">$content{'copyright'}
+</table>
ENDHEAD
delete($content{'title'});
delete($content{'author'});
@@ -104,26 +253,163 @@ ENDHEAD
delete($content{'owner'});
delete($content{'copyright'});
if ($ENV{'user.adv'}) {
- map {
+# ------------------------------------------------------------ Dynamic Metadata
+ $r->print(
+ '<h3>Dynamic Metadata (updated periodically)</h3>Processing ...<br>');
+ $r->rflush();
+ my %items=(
+ 'count' => 'Network-wide number of accesses (hits)',
+ 'course' => 'Network-wide number of courses using resource',
+ 'usage' => 'Number of resources using or importing resource',
+ 'clear' => 'Material presented in clear way',
+ 'depth' => 'Material covered with sufficient depth',
+ 'helpful' => 'Material is helpful',
+ 'correct' => 'Material appears to be correct',
+ 'technical' => 'Resource is technically correct',
+ 'avetries' => 'Average number of tries till solved',
+ 'stdno' => 'Total number of students who have worked on this problem',
+ 'difficulty' => 'Degree of difficulty');
+ my %dynmeta=&dynamicmeta($uri);
+ $r->print(
+'</table><h4>Access and Usage Statistics</h4><table cellspacing=2 border=0>');
+ foreach ('count','usage','course') {
+ $r->print(
+'<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
+$dynmeta{$_}." </td></tr>\n");
+ }
+ $r->print('</table>');
+ if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {
+ $r->print(
+'<h4>Assessment Statistical Data</h4><table cellspacing=2 border=0>');
+ foreach ('stdno','avetries') {
+ $r->print(
+'<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
+$dynmeta{$_}." </td></tr>\n");
+ }
+ foreach ('difficulty') {
+ $r->print(
+'<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
+&diffgraph($dynmeta{$_})."</td></tr>\n");
+ }
+ $r->print('</table>');
+ }
+ $r->print('<h4>Evaluation Data</h4><table cellspacing=2 border=0>');
+ foreach ('clear','depth','helpful','correct','technical') {
+ $r->print(
+'<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
+&evalgraph($dynmeta{$_})."</td></tr>\n");
+ }
+ $r->print('</table>');
+ $disuri=~/^(\w+)\/(\w+)\//;
+ if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))
+ || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
+ $r->print(
+ '<h4>Evaluation Comments (visible to author and co-authors only)</h4>'.
+ '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
+ $r->print(
+ '<h4>Error Messages (visible to author and co-authors only)</h4>');
+ my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$1,$2);
+ foreach (keys %errormsgs) {
+ if ($_=~/^$disuri\_\d+$/) {
+ my %content=&Apache::lonmsg::unpackagemsg($errormsgs{$_});
+ $r->print('<b>'.$content{'time'}.'</b>: '.$content{'message'}.
+ '<br />');
+ }
+ }
+ }
+# ------------------------------------------------------------- All other stuff
+ $r->print(
+ '<h3>Additional Metadata (non-standard, parameters, exports)</h3>');
+ foreach (sort keys %content) {
my $name=$_;
my $display=&Apache::lonnet::metadata($uri,$name.'.display');
unless ($display) { $display=$name; };
my $otherinfo='';
- map {
+ foreach ('name','part','type','default') {
if (defined(&Apache::lonnet::metadata($uri,$name.'.'.$_))) {
$otherinfo.=' '.$_.'='.
&Apache::lonnet::metadata($uri,$name.'.'.$_).'; ';
}
- } ('name','part','type','default');
+ }
$r->print('<b>'.$display.':</b> '.$content{$name});
if ($otherinfo) {
$r->print(' ('.$otherinfo.')');
}
$r->print("<br>\n");
- } sort keys %content;
+ }
+ }
+# ===================================================== End Resource Space Call
+ } else {
+# ===================================================== Construction Space Call
+
+# ----------------------------------------------------------- Set document type
+
+ $r->content_type('text/html');
+ $r->send_http_header;
+
+ return OK if $r->header_only;
+# ---------------------------------------------------------------------- Header
+ my $bodytag=&Apache::loncommon::bodytag('Edit Catalog Information');
+ my $disuri=$uri;
+ my $fn=&Apache::lonnet::filelocation('',$uri);
+ $disuri=~s/^\/\~\w+//;
+ $disuri=~s/\.meta$//;
+ my $displayfile='Catalog Information for '.$disuri;
+ if ($disuri=~/\/default$/) {
+ my $dir=$disuri;
+ $dir=~s/default$//;
+ $displayfile='Default Cataloging Information for Directory '.$dir;
+ }
+ %Apache::lonpublisher::metadatafields=();
+ %Apache::lonpublisher::metadatakeys=();
+ &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));
+ $r->print(<<ENDEDIT);
+<html><head><title>Edit Catalog Information</title></head>
+$bodytag
+<h1>$displayfile</h1>
+<form method="post">
+ENDEDIT
+ foreach ('author','title','subject','keywords','abstract','notes',
+ 'copyright','language') {
+ if ($ENV{'form.new_'.$_}) {
+ $Apache::lonpublisher::metadatafields{$_}=$ENV{'form.new_'.$_};
+ }
+ $r->print(
+ &Apache::lonpublisher::textfield($_,'new_'.$_,
+ $Apache::lonpublisher::metadatafields{$_}));
+ }
+ if ($ENV{'form.store'}) {
+ my $mfh;
+ unless ($mfh=Apache::File->new('>'.$fn)) {
+ $r->print(
+ '<p><font color=red>Could not write metadata, FAIL</font>');
+ } else {
+ foreach (sort keys %Apache::lonpublisher::metadatafields) {
+ unless ($_=~/\./) {
+ my $unikey=$_;
+ $unikey=~/^([A-Za-z]+)/;
+ my $tag=$1;
+ $tag=~tr/A-Z/a-z/;
+ print $mfh "\n\<$tag";
+ foreach
+ (split(/\,/,$Apache::lonpublisher::metadatakeys{$unikey})) {
+ my $value=
+ $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
+ $value=~s/\"/\'\'/g;
+ print $mfh ' '.$_.'="'.$value.'"';
+ }
+ print $mfh '>'.
+ &HTML::Entities::encode($Apache::lonpublisher::metadatafields{$unikey})
+ .'</'.$tag.'>';
+ }
+ }
+ $r->print('<p>Wrote Metadata');
+ }
+ }
+ $r->print(
+ '<br /><input type="submit" name="store" value="Store Catalog Information"></form></body></html>');
+ return OK;
}
- $r->print('</body></html>');
- return OK;
}
1;