--- loncom/interface/lonmeta.pm 2001/08/10 17:20:19 1.7
+++ loncom/interface/lonmeta.pm 2004/01/02 19:23:47 1.56
@@ -1,108 +1,711 @@
# The LearningOnline Network with CAPA
-#
# Metadata display handler
#
-# (TeX Content Handler
+# $Id: lonmeta.pm,v 1.56 2004/01/02 19:23:47 www Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
#
-# 05/29/00,05/30,10/11 Gerd Kortemeyer)
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
#
-# 10/19,10/21,10/23,11/27,08/09/01 Gerd Kortemeyer
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+
package Apache::lonmeta;
use strict;
use Apache::Constants qw(:common);
use Apache::lonnet();
+use Apache::loncommon();
+use Apache::lonhtmlcommon();
+use Apache::lonmsg;
+use Apache::lonpublisher;
+use Apache::lonlocal;
+use Apache::lonmysql;
+use Apache::lonmsg;
+
+# MySQL table columns
+
+my @columns;
+
+# ----------------------------------------- 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 %concat=();
+ my %listitems=(
+ 'course' => 'add',
+ 'goto' => 'add',
+ 'comefrom' => 'add',
+ 'avetries' => 'avg',
+ 'stdno' => 'add',
+ 'difficulty' => 'avg',
+ 'clear' => 'avg',
+ 'technical' => 'avg',
+ 'helpful' => 'avg',
+ 'correct' => 'avg',
+ 'depth' => 'avg',
+ 'comments' => 'app',
+ 'usage' => 'cnt'
+ );
+ while ($_=each(%evaldata)) {
+ my ($item,$purl,$cat)=split(/___/,$_);
+ ### Apache->request->print("\n".$_.' - '.$item.' ');
+ if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }
+ unless ($listitems{$cat} eq 'app') {
+ if (defined($sum{$cat})) {
+ $sum{$cat}+=$evaldata{$_};
+ $concat{$cat}.=','.$item;
+ } else {
+ $sum{$cat}=$evaldata{$_};
+ $concat{$cat}=$item;
+ }
+ } else {
+ if (defined($sum{$cat})) {
+ if ($evaldata{$_}) {
+ $sum{$cat}.=''.$evaldata{$_};
+ }
+ } else {
+ $sum{$cat}=''.$evaldata{$_};
+ }
+ }
+ }
+ my %returnhash=();
+ while ($_=each(%cnt)) {
+ if ($listitems{$_} eq 'avg') {
+ $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;
+ } elsif ($listitems{$_} eq 'cnt') {
+ $returnhash{$_}=$cnt{$_};
+ } else {
+ $returnhash{$_}=$sum{$_};
+ }
+ $returnhash{$_.'_list'}=$concat{$_};
+ ### Apache->request->print("\n".$_.': '.$returnhash{$_}.' '.$returnhash{$_.'_list'});
+ }
+ #
+ # Deal with 'count' separately
+ $returnhash{'count'} = &access_count($url,$aauthor,$adomain);
+ # since "usage" is reserved word in MySQL ...
+ $returnhash{'sequsage'}=$returnhash{'usage'};
+ $returnhash{'sequsage_list'}=$returnhash{'usage_list'};
+
+ return %returnhash;
+}
+
+sub access_count {
+ my ($src,$author,$adomain) = @_;
+ my %countdata=&Apache::lonnet::dump('nohist_accesscount',$adomain,
+ $author,$src);
+ if (! exists($countdata{$src})) {
+ return &mt('Not Available');
+ } else {
+ return $countdata{$src};
+ }
+}
+
+# ------------------------------------- Try to make an alt tag if there is none
+
+sub alttag {
+ my ($base,$src)=@_;
+ my $fullpath=&Apache::lonnet::hreflocation($base,$src);
+ my $alttag=&Apache::lonnet::metadata($fullpath,'title').' '.
+ &Apache::lonnet::metadata($fullpath,'subject').' '.
+ &Apache::lonnet::metadata($fullpath,'abstract');
+ $alttag=~s/\s+/ /gs;
+ $alttag=~s/\"//gs;
+ $alttag=~s/\'//gs;
+ $alttag=~s/\s+$//gs;
+ $alttag=~s/^\s+//gs;
+ if ($alttag) { return $alttag; } else
+ { return &mt('No information available'); }
+}
+
+# -------------------------------------------------------------- Author display
+
+sub authordisplay {
+ my ($aname,$adom)=@_;
+ return &Apache::loncommon::aboutmewrapper(
+ &Apache::loncommon::plainname($aname,$adom),
+ $aname,$adom,'preview').' ['.$aname.'@'.$adom.']';
+}
+
+# -------------------------------------------------------------- Pretty display
+
+sub evalgraph {
+ my $value=shift;
+ unless ($value) { return ''; }
+ my $val=int($value*10.+0.5)-10;
+ my $output='
';
+ if ($val>=20) {
+ $output.='
';
+ } else {
+ $output.='
'.
+ '
';
+ }
+ $output.='
';
+ if ($val>20) {
+ $output.='
'.
+ '
';
+ } else {
+ $output.='
';
+ }
+ $output.='
('.$value.')
';
+ 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='
';
+ for (my $i=0;$i<8;$i++) {
+ if ($val>$i*5) {
+ $output.='
';
+ } else {
+ $output.='
';
+ }
+ }
+ $output.='
('.$value.')
';
+ return $output;
+}
+
+# ==================================================== Turn MySQL row into hash
+
+sub metadata_col_to_hash {
+ my @cols=@_;
+ my %hash=();
+ for (my $i=0; $i<=$#columns; $i++) {
+ $hash{$columns[$i]}=$cols[$i];
+ }
+ return %hash;
+}
+
+# ============================================================= The field names
+
+sub fieldnames {
+ return &Apache::lonlocal::texthash(
+ 'title' => 'Title',
+ 'author' =>'Author(s)',
+ 'authorspace' => 'Author Space',
+ 'modifyinguser' => 'Last Modifying User',
+ 'subject' => 'Subject',
+ 'keywords' => 'Keyword(s)',
+ 'notes' => 'Notes',
+ 'abstract' => 'Abstract',
+ 'lowestgradelevel' => 'Lowest Grade Level',
+ 'highestgradelevel' => 'Highest Grade Level',
+ 'standards' => 'Standards',
+ 'mime' => 'MIME Type',
+ 'language' => 'Language',
+ 'creationdate' => 'Creation Date',
+ 'lastrevisiondate' => 'Last Revision Date',
+ 'owner' => 'Publisher/Owner',
+ 'copyright' => 'Copyright/Distribution',
+ 'customdistributionfile' => 'Custom Distribution File',
+ 'obsolete' => 'Obsolete',
+ 'obsoletereplacement' => 'Suggested Replacement for Obsolete File',
+ 'count' => 'Network-wide number of accesses (hits)',
+ 'course' => 'Network-wide number of courses using resource',
+ 'course_list' => 'Network-wide courses using resource',
+ 'sequsage' => 'Number of resources using or importing resource',
+ 'sequsage_list' => 'Resources using or importing resource',
+ 'goto' => 'Number of resources that follow this resource in maps',
+ 'goto_list' => 'Resources that follow this resource in maps',
+ 'comefrom' => 'Number of resources that lead up to this resource in maps',
+ 'comefrom_list' => 'Resources that lead up to this resource in maps',
+ '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'
+ );
+}
+# =========================================== Pretty printing of metadata field
+
+sub prettyprint {
+ my ($type,$value)=@_;
+ unless (defined($value)) { return ' '; }
+# Title
+ if ($type eq 'title') {
+ return ''.$value.'';
+ }
+# Dates
+ if (($type eq 'creationdate') ||
+ ($type eq 'lastrevisiondate')) {
+ return ($value?&Apache::lonlocal::locallocaltime(
+ &Apache::lonmysql::unsqltime($value)):
+ &mt('not available'));
+ }
+# Language
+ if ($type eq 'language') {
+ return &Apache::loncommon::languagedescription($value);
+ }
+# Copyright
+ if ($type eq 'copyright') {
+ return &Apache::loncommon::copyrightdescription($value);
+ }
+# MIME
+ if ($type eq 'mime') {
+ return ' '.
+ &Apache::loncommon::filedescription($value);
+ }
+# Person
+ if (($type eq 'author') ||
+ ($type eq 'owner') ||
+ ($type eq 'modifyinguser') ||
+ ($type eq 'authorspace')) {
+ $value=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;
+ return $value;
+ }
+# Gradelevel
+ if (($type eq 'lowestgradelevel') ||
+ ($type eq 'highestgradelevel')) {
+ return &Apache::loncommon::gradeleveldescription($value);
+ }
+# Only for advance users below
+ unless ($ENV{'user.adv'}) { return '- '.&mt('not displayed').' -' };
+# File
+ if (($type eq 'customdistributionfile') ||
+ ($type eq 'obsoletereplacement') ||
+ ($type eq 'goto_list') ||
+ ($type eq 'comefrom_list') ||
+ ($type eq 'sequsage_list')) {
+ return join(' ',map {
+ my $url=&Apache::lonnet::clutter($_);
+ ' '.&Apache::lonnet::gettitle($url).''.
+ &Apache::lonhtmlcommon::crumbs($url,'preview','');
+ } split(/\s*\,\s*/,$value));
+ }
+# Evaluations
+ if (($type eq 'clear') ||
+ ($type eq 'depth') ||
+ ($type eq 'helpful') ||
+ ($type eq 'correct') ||
+ ($type eq 'technical')) {
+ return &evalgraph($value);
+ }
+# Difficulty
+ if ($type eq 'difficulty') {
+ return &diffgraph($value);
+ }
+# List of courses
+ if ($type=~/\_list/) {
+ return join(' ',map {
+ my %courseinfo=&Apache::lonnet::coursedescription($_);
+ ''.
+ $courseinfo{'description'}.'';
+ } split(/\s*\,\s*/,$value));
+ }
+# No pretty print found
+ return $value;
+}
+# ============================================== Pretty input of metadata field
+
+sub direct {
+ return shift;
+}
+
+sub selectbox {
+ my ($name,$value,$functionref,@idlist)=@_;
+ unless (defined($functionref)) { $functionref=\&direct; }
+ my $selout='';
+}
+
+sub relatedfield {
+ my ($show,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue)=@_;
+ unless ($relatedsearchflag) { return ''; }
+ unless (defined($relatedsep)) { $relatedsep=' '; }
+ unless ($show) { return $relatedsep.' '; }
+ return $relatedsep.'';
+}
+
+sub prettyinput {
+ my ($type,$value,$fieldname,$formname,
+ $relatedsearchflag,$relatedsep,$relatedvalue)=@_;
+# Language
+ if ($type eq 'language') {
+ return &selectbox($fieldname,
+ $value,
+ \&Apache::loncommon::languagedescription,
+ (&Apache::loncommon::languageids)).
+ &relatedfield(0,$relatedsearchflag,$relatedsep);
+ }
+# Copyright
+ if ($type eq 'copyright') {
+ return &selectbox($fieldname,
+ $value,
+ \&Apache::loncommon::copyrightdescription,
+ (&Apache::loncommon::copyrightids)).
+ &relatedfield(0,$relatedsearchflag,$relatedsep);
+ }
+# Gradelevels
+ if (($type eq 'lowestgradelevel') ||
+ ($type eq 'highestgradelevel')) {
+ return &Apache::loncommon::select_level_form($value,$fieldname).
+ &relatedfield(0,$relatedsearchflag,$relatedsep);
+ }
+# Obsolete
+ if ($type eq 'obsolete') {
+ return ''.
+ &relatedfield(0,$relatedsearchflag,$relatedsep);
+ }
+# Obsolete replacement file
+ if ($type eq 'obsoletereplacement') {
+ return '".&mt('Select').''.
+ &relatedfield(0,$relatedsearchflag,$relatedsep);
+ }
+# Customdistribution file
+ if ($type eq 'customdistributionfile') {
+ return '".&mt('Select').''.
+ &relatedfield(0,$relatedsearchflag,$relatedsep);
+ }
+# Dates
+ if (($type eq 'creationdate') ||
+ ($type eq 'lastrevisiondate')) {
+ return &Apache::lonhtmlcommon::date_setter($formname,
+ $fieldname,$value).
+ &relatedfield(0,$relatedsearchflag,$relatedsep);
+ }
+# No pretty input found
+ $value=~s/^\s+//gs;
+ $value=~s/\s+$//gs;
+ $value=~s/\s+/ /gs;
+ $value=~s/\"/\&quod\;/gs;
+ return
+ ''.
+ &relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue);
+}
# ================================================================ 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
- $r->content_type('text/html');
+ &Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
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 {
- $content{$_}='- not displayed -';
- } ('keywords','notes','abstract','subject');
}
-
# --------------------------------------------------------------- Render Output
+# displayed url
+ my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
+ $uri=~s/\.meta$//;
+ my $disuri=&Apache::lonnet::clutter($uri);
+# version
+ my $currentversion=&Apache::lonnet::getversion($disuri);
+ my $versiondisplay='';
+ if ($thisversion) {
+ $versiondisplay=&mt('Version').': '.$thisversion.
+ ' ('.&mt('most recent version').': '.
+ ($currentversion>0?$currentversion:&mt('information not available')).')';
+ } else {
+ $versiondisplay='Version: '.$currentversion;
+ }
+# crumbify displayed URL
+ $disuri=&Apache::lonhtmlcommon::crumbs($disuri);
+# obsolete
+ my $obsolete=$content{'obsolete'};
+ my $obsoletewarning='';
+ if (($obsolete) && ($ENV{'user.adv'})) {
+ $obsoletewarning='
'.
+ &mt('This resource has been marked obsolete by the author(s)').'