--- loncom/interface/lonmeta.pm 2000/10/21 10:46:35 1.1
+++ loncom/interface/lonmeta.pm 2003/12/29 17:11:53 1.46
@@ -1,107 +1,619 @@
# The LearningOnline Network with CAPA
-#
# Metadata display handler
#
-# (TeX Content Handler
+# $Id: lonmeta.pm,v 1.46 2003/12/29 17:11:53 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.
+#
+# 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.
#
-# 05/29/00,05/30,10/11 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
#
-# 10/19,10/21 Gerd Kortemeyer
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+
package Apache::lonmeta;
use strict;
-use Apache::File;
use Apache::Constants qw(:common);
-use HTML::TokeParser;
+use Apache::lonnet();
+use Apache::loncommon();
+use Apache::lonhtmlcommon();
+use Apache::lonmsg;
+use Apache::lonpublisher;
+use Apache::lonlocal;
+use Apache::lonmysql;
+
+# 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);
+ return %returnhash;
+}
-# ================================================= Unpack metadata into a hash
+sub access_count {
+ my ($src,$author,$adomain) = @_;
+ my %countdata=&Apache::lonnet::dump('nohist_accesscount',$adomain,
+ $author,$src);
+ if (! exists($countdata{$src})) {
+ return 'Not Available';
+ } else {
+ return $countdata{$src};
+ }
+}
-sub unpackagemeta {
- my ($datastring,$fordisplay)=@_;
- my %content=();
- my $parser=HTML::TokeParser->new(\$datastring);
- my $token;
- while ($token=$parser->get_token) {
- if ($token->[0] eq 'S') {
- my $entry=$token->[1];
- my $value=$parser->get_text('/'.$entry);
- if (($token->[2]->{'display'}) && ($fordisplay)) {
- $value.='__dis__'.$token->[2]->{'display'};
- }
- $content{$entry}=$value;
- }
+# ------------------------------------- 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 '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)',
+ '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',
+ 'usage' => 'Number of resources using or importing resource',
+ 'goto' => 'Number of resources that follow this resource in maps',
+ 'comefrom' => 'Number of 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.'';
}
- return %content;
+# Dates
+ if (($type eq 'creationdate') ||
+ ($type eq 'lastrevisiondate')) {
+ return &Apache::lonlocal::locallocaltime(
+ &Apache::lonmysql::unsqltime($value));
+ }
+# 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;
+ }
+# File
+ if (($type eq 'customdistributionfile') ||
+ ($type eq 'obsoletereplacement') ||
+ ($type eq 'goto_list') ||
+ ($type eq 'comefrom_list') ||
+ ($type eq 'sequsage_list')) {
+ return join('
',map {
+ &Apache::lonnet::gettitle($_).' ['.
+ &Apache::lonhtmlcommon::crumbs(&Apache::lonnet::clutter($_),'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 prettyinput {
+ my ($type,$value,$fieldname)=@_;
}
# ================================================================ Main Handler
sub handler {
my $r=shift;
- my @metacontents;
- my %content;
+
+ 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 $fh=Apache::File->new($r->filename);
- @metacontents=<$fh>;
+ foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
+ $content{$_}=&Apache::lonnet::metadata($uri,$_);
}
+# ------------------------------------------------------------------ Hide stuff
- %content=&unpackagemeta(join("\n",@metacontents),1);
+ unless ($ENV{'user.adv'}) {
+ foreach ('keywords','notes','abstract','subject') {
+ $content{$_}='- '.&mt('not displayed').' -';
+ }
+ }
# --------------------------------------------------------------- Render Output
-
+# displayed url
+ my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
+ my $disuri=&Apache::lonnet::clutter($uri);
+ $disuri=~s/\.meta$//;
+ $disuri=&Apache::lonhtmlcommon::crumbs($disuri);
+# version
+ my $currentversion=&Apache::lonnet::getversion($disuri);
+ my $versiondisplay='';
+ if ($thisversion) {
+ $versiondisplay=&mt('Version').': '.$thisversion.
+ ' ('.&mt('most recent version').': '.$currentversion.')';
+ } else {
+ $versiondisplay='Version: '.$currentversion;
+ }
+# obsolete
+ my $obsolete=$content{'obsolete'};
+ my $obsoletewarning='';
+ if (($obsolete) && ($ENV{'user.adv'})) {
+ $obsoletewarning=''.
+ &mt('This resource has been marked obsolete by the author(s)').'
';
+ }
+
+ my %lt=&fieldnames();
+ my $table='';
+ my $bodytag=&Apache::loncommon::bodytag
+ ('Catalog Information','','','',$resdomain);
+ foreach ('title',
+ 'author',
+ 'subject',
+ 'keywords',
+ 'notes',
+ 'abstract',
+ 'mime',
+ 'language',
+ 'creationdate',
+ 'lastrevisiondate',
+ 'owner',
+ 'copyright',
+ 'customdistributionfile',
+ 'obsolete',
+ 'obsoletereplacement') {
+ $table.=''.$lt{$_}.
+ ' | '.
+ &prettyprint($_,$content{$_}).' |
';
+ delete $content{$_};
+ }
+
$r->print(<Catalog Information
-
-Catalog Information
+$bodytag
$content{'title'}
-Author(s): $content{'author'}
-Subject: $content{'subject'}
-Keyword(s): $content{'keywords'}
-Notes: $content{'notes'}
-Abstract:
-$content{'abstract'}
-
-MIME Type: $content{'mime'}
-Language: $content{'language'}
-Creation Date: $content{'creationdate'}
-Last Revision Date: $content{'lastrevisiondate'}
-Publisher/Owner: $content{'owner'}
-Copyright/Distribution: $content{'copyright'}
-
+$disuri
+$obsoletewarning
+$versiondisplay
+
ENDHEAD
- delete($content{'title'});
- delete($content{'author'});
- delete($content{'subject'});
- delete($content{'keywords'});
- delete($content{'notes'});
- delete($content{'abstract'});
- delete($content{'mime'});
- delete($content{'language'});
- delete($content{'creationdate'});
- delete($content{'lastrevisiondate'});
- delete($content{'owner'});
- delete($content{'copyright'});
- map {
- my ($value,$name)=split(/\_\_dis\_\_/,$content{$_});
- unless ($name) { $name=$_; }
- $r->print(''.$name.': '.$value.'
');
- } sort keys %content;
- $r->print('