File:
[LON-CAPA] /
loncom /
interface /
lonmeta.pm
Revision
1.135:
download - view:
text,
annotated -
select for diffs
Thu Dec 8 02:17:56 2005 UTC (18 years, 5 months ago) by
banghart
Branches:
MAIN
CVS tags:
HEAD
New lables for buttons if portfolio metadata (not catalog info)
Better message telling what course provides metadata framework
Don't display the courserestricting metadata field in case
of no course restricting metadata.
Minor style stuff
# The LearningOnline Network with CAPA
# Metadata display handler
#
# $Id: lonmeta.pm,v 1.135 2005/12/08 02:17:56 banghart 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.
#
# 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 LONCAPA::lonmetadata();
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;
############################################################
############################################################
##
## &get_dynamic_metadata_from_sql($url)
##
## Queries sql database for dynamic metdata
## Returns a hash of hashes, with keys of urls which match $url
## Returned fields are given below.
##
## Examples:
##
## %DynamicMetadata = &Apache::lonmeta::get_dynmaic_metadata_from_sql
## ('/res/msu/korte/');
##
## $DynamicMetadata{'/res/msu/korte/example.problem'}->{$field}
##
############################################################
############################################################
sub get_dynamic_metadata_from_sql {
my ($url) = shift();
my ($authordom,$author)=($url=~m:^/res/(\w+)/(\w+)/:);
if (! defined($authordom)) {
$authordom = shift();
}
if (! defined($author)) {
$author = shift();
}
if (! defined($authordom) || ! defined($author)) {
return ();
}
my @Fields = ('url','count','course',
'goto','goto_list',
'comefrom','comefrom_list',
'sequsage','sequsage_list',
'stdno','stdno_list',
'dependencies',
'avetries','avetries_list',
'difficulty','difficulty_list',
'disc','disc_list',
'clear','technical','correct',
'helpful','depth');
#
my $query = 'SELECT '.join(',',@Fields).
' FROM metadata WHERE url LIKE "'.$url.'%"';
my $server = &Apache::lonnet::homeserver($author,$authordom);
my $reply = &Apache::lonnet::metadata_query($query,undef,undef,
,[$server]);
return () if (! defined($reply) || ref($reply) ne 'HASH');
my $filename = $reply->{$server};
if (! defined($filename) || $filename =~ /^error/) {
return ();
}
my $max_time = time + 10; # wait 10 seconds for results at most
my %ReturnHash;
#
# Look for results
my $finished = 0;
while (! $finished && time < $max_time) {
my $datafile=$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename;
if (! -e "$datafile.end") { next; }
my $fh;
if (!($fh=Apache::File->new($datafile))) { next; }
while (my $result = <$fh>) {
chomp($result);
next if (! $result);
my @Data =
map {
&Apache::lonnet::unescape($_);
} split(',',$result);
my $url = $Data[0];
for (my $i=0;$i<=$#Fields;$i++) {
$ReturnHash{$url}->{$Fields[$i]}=$Data[$i];
}
}
$finished = 1;
}
#
return %ReturnHash;
}
# 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 %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
my %Data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,
\%DynamicData);
#
# Deal with 'count' separately
$Data{'count'} = &access_count($url,$aauthor,$adomain);
#
# Debugging code I will probably need later
if (0) {
&Apache::lonnet::logthis('Dynamic Metadata');
while(my($k,$v)=each(%Data)){
&Apache::lonnet::logthis(' "'.$k.'"=>"'.$v.'"');
}
&Apache::lonnet::logthis('-------------------');
}
return %Data;
}
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').' <tt>['.$aname.'@'.$adom.']</tt>';
}
# Pretty display
sub evalgraph {
my $value=shift;
if (! $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> ('.sprintf("%5.2f",$value).') </td></tr></table>';
return $output;
}
sub diffgraph {
my $value=shift;
if (! $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> ('.sprintf("%3.2f",$value).') </td></tr></table>';
return $output;
}
# The field names
sub fieldnames {
my $file_type=shift;
my %fields =
('title' => 'Title',
'author' =>'Author(s)',
'authorspace' => 'Author Space',
'modifyinguser' => 'Last Modifying User',
'subject' => 'Subject',
'standards' => 'Standards',
'keywords' => 'Keyword(s)',
'notes' => 'Notes',
'abstract' => 'Abstract',
'lowestgradelevel' => 'Lowest Grade Level',
'highestgradelevel' => 'Highest Grade Level',
'courserestricted' => 'Course Restricting Metadata');
if (! defined($file_type) || $file_type ne 'portfolio') {
%fields =
(%fields,
'domain' => 'Domain',
'mime' => 'MIME Type',
'language' => 'Language',
'creationdate' => 'Creation Date',
'lastrevisiondate' => 'Last Revision Date',
'owner' => 'Publisher/Owner',
'copyright' => 'Copyright/Distribution',
'customdistributionfile' => 'Custom Distribution File',
'sourceavail' => 'Source Available',
'sourcerights' => 'Source 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',
'disc' => 'Degree of discrimination',
'dependencies' => 'Resources used by this resource',
);
}
return &Apache::lonlocal::texthash(%fields);
}
sub select_course {
my ($r)=@_;
my %courses;
foreach my $key (keys (%env)) {
if ($key =~ m/\.metadata\./) {
$key =~ m/^course\.(.+)(\.metadata.+$)/;
my $course = $1;
my $coursekey = 'course.'.$course.'.description';
my $value = $env{$coursekey};
$courses{$coursekey} = $value;
}
}
$r->print('<h3>Course Related Meta-Data</h3><br />');
$r->print('<form action="" method="post">');
$r->print('Select course restrictions<br />');
$r->print('<select name="metacourse" >');
my $meta_not_found = 1;
foreach my $key (keys (%courses)) {
if ($meta_not_found) {
undef($meta_not_found);
$r->print('<h3>Portfolio Meta-Data</h3><br />');
$r->print('<form action="" method="post">');
$r->print('Select your course<br />');
$r->print('<select name="metacourse" >');
}
$key =~ m/(^.+)\.description$/;
$r->print('<option value="'.$1.'">');
$r->print($courses{$key});
$r->print('</option>');
}
unless ($meta_not_found) {
$r->print('</select><br />');
$r->print('<input type="submit" value="Assign Portfolio Metadata" />');
$r->print('</form>');
}
return 'ok';
}
# Pretty printing of metadata field
sub prettyprint {
my ($type,$value,$target,$prefix,$form,$noformat)=@_;
# $target,$prefix,$form are optional and for filecrumbs only
if (! defined($value)) {
return ' ';
}
# Title
if ($type eq 'title') {
return '<font size="+1" face="arial">'.$value.'</font>';
}
# 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);
}
# Copyright
if ($type eq 'sourceavail') {
return &Apache::loncommon::source_copyrightdescription($value);
}
# MIME
if ($type eq 'mime') {
return '<img src="'.&Apache::loncommon::icon($value).'" /> '.
&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
if (! $env{'user.adv'}) {
return '<i>- '.&mt('not displayed').' -</i>';
}
# File
if (($type eq 'customdistributionfile') ||
($type eq 'obsoletereplacement') ||
($type eq 'goto_list') ||
($type eq 'comefrom_list') ||
($type eq 'sequsage_list') ||
($type eq 'dependencies')) {
return '<ul><font size="-1">'.join("\n",map {
my $url = &Apache::lonnet::clutter($_);
my $title = &Apache::lonnet::gettitle($url);
if ($title eq '') {
$title = 'Untitled';
if ($url =~ /\.sequence$/) {
$title .= ' Sequence';
} elsif ($url =~ /\.page$/) {
$title .= ' Page';
} elsif ($url =~ /\.problem$/) {
$title .= ' Problem';
} elsif ($url =~ /\.html$/) {
$title .= ' HTML document';
} elsif ($url =~ m:/syllabus$:) {
$title .= ' Syllabus';
}
}
$_ = '<li>'.$title.' '.
&Apache::lonhtmlcommon::crumbs($url,$target,$prefix,$form,'-1',$noformat).
'</li>'
} split(/\s*\,\s*/,$value)).'</ul></font>';
}
# 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' || $type eq 'disc') {
return &diffgraph($value);
}
# List of courses
if ($type=~/\_list/) {
my @Courses = split(/\s*\,\s*/,$value);
my $Str;
foreach my $course (@Courses) {
my %courseinfo = &Apache::lonnet::coursedescription($course);
if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
next;
}
if ($Str ne '') { $Str .= '<br />'; }
$Str .= '<a href="/public/'.$courseinfo{'domain'}.'/'.
$courseinfo{'num'}.'/syllabus" target="preview">'.
$courseinfo{'description'}.'</a>';
}
return $Str;
}
# No pretty print found
return $value;
}
# Pretty input of metadata field
sub direct {
return shift;
}
sub selectbox {
my ($name,$value,$functionref,@idlist)=@_;
if (! defined($functionref)) {
$functionref=\&direct;
}
my $selout='<select name="'.$name.'">';
foreach (@idlist) {
$selout.='<option value=\''.$_.'\'';
if ($_ eq $value) {
$selout.=' selected>'.&{$functionref}($_).'</option>';
}
else {$selout.='>'.&{$functionref}($_).'</option>';}
}
return $selout.'</select>';
}
sub relatedfield {
my ($show,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue)=@_;
if (! $relatedsearchflag) {
return '';
}
if (! defined($relatedsep)) {
$relatedsep=' ';
}
if (! $show) {
return $relatedsep.' ';
}
return $relatedsep.'<input type="checkbox" name="'.$fieldname.'_related"'.
($relatedvalue?' checked="1"':'').' />';
}
sub prettyinput {
my ($type,$value,$fieldname,$formname,
$relatedsearchflag,$relatedsep,$relatedvalue,$size,$course_key)=@_;
if (! defined($size)) {
$size = 80;
}
my $output;
if (defined($course_key)) {
my $stu_add;
my $only_one;
my %meta_options;
my @cur_values_inst;
my $cur_values_stu;
my $values = $env{$course_key.'.metadata.'.$type.'.values'};
if ($env{$course_key.'.metadata.'.$type.'.options'} =~ m/stuadd/) {
$stu_add = 'true';
}
if ($env{$course_key.'.metadata.'.$type.'.options'} =~ m/onlyone/) {
$only_one = 'true';
}
# need to take instructor values out of list where instructor and student
# values may be mixed.
if ($values) {
foreach my $item (split(/,/,$values)) {
$item =~ s/^\s+//;
$meta_options{$item} = $item;
}
foreach my $item (split(/,/,$value)) {
$item =~ s/^\s+//;
if ($meta_options{$item}) {
push(@cur_values_inst,$item);
} else {
$cur_values_stu .= $item.',';
}
}
} else {
$cur_values_stu = $value;
}
if ($type eq 'courserestricted') {
return ('<input type="hidden" name="new_courserestricted" value="'.$course_key.'" />');
}
if (($type eq 'keywords') || ($type eq 'subject')
|| ($type eq 'author')||($type eq 'notes')
|| ($type eq 'abstract')|| ($type eq 'title')|| ($type eq 'standards')) {
if ($values) {
if ($only_one) {
$output .= (&Apache::loncommon::select_form($cur_values_inst[0],'new_'.$type,%meta_options));
} else {
$output .= (&Apache::loncommon::multiple_select_form('new_'.$type,\@cur_values_inst,undef,\%meta_options));
}
}
if ($stu_add) {
$output .= '<input type="text" name="'.$fieldname.'" size="'.$size.'" '.
'value="'.$cur_values_stu.'" />'.
&relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,
$relatedvalue);
}
return ($output);
}
if (($type eq 'lowestgradelevel') ||
($type eq 'highestgradelevel')) {
return &Apache::loncommon::select_level_form($value,$fieldname).
&relatedfield(0,$relatedsearchflag,$relatedsep);
}
return();
}
# 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);
}
# Source Copyright
if ($type eq 'sourceavail') {
return &selectbox($fieldname,
$value,
\&Apache::loncommon::source_copyrightdescription,
(&Apache::loncommon::source_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 '<input type="checkbox" name="'.$fieldname.'"'.
($value?' checked="1"':'').' />'.
&relatedfield(0,$relatedsearchflag,$relatedsep);
}
# Obsolete replacement file
if ($type eq 'obsoletereplacement') {
return '<input type="text" name="'.$fieldname.
'" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
"('".$formname."','".$fieldname."'".
",'')\">".&mt('Select').'</a>'.
&relatedfield(0,$relatedsearchflag,$relatedsep);
}
# Customdistribution file
if ($type eq 'customdistributionfile') {
return '<input type="text" name="'.$fieldname.
'" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
"('".$formname."','".$fieldname."'".
",'rights')\">".&mt('Select').'</a>'.
&relatedfield(0,$relatedsearchflag,$relatedsep);
}
# Source Customdistribution file
if ($type eq 'sourcerights') {
return '<input type="text" name="'.$fieldname.
'" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
"('".$formname."','".$fieldname."'".
",'rights')\">".&mt('Select').'</a>'.
&relatedfield(0,$relatedsearchflag,$relatedsep);
}
if ($type eq 'courserestricted') {
return ('<input type="hidden" name="new_courserestricted" value="'.$course_key.'" />');
}
# 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/\"/\"\;/gs;
return
'<input type="text" name="'.$fieldname.'" size="'.$size.'" '.
'value="'.$value.'" />'.
&relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,
$relatedvalue);
}
# Main Handler
sub handler {
my $r=shift;
#
my $uri=$r->uri;
#
# Set document type
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK if $r->header_only;
#
my ($resdomain,$resuser)=
(&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
my $html=&Apache::lonxml::xmlbegin();
$r->print($html.'<head><title>'.
'Catalog Information'.
'</title></head>');
if ($uri=~m:/adm/bombs/(.*)$:) {
$r->print(&Apache::loncommon::bodytag('Error Messages'));
# Looking for all bombs?
&report_bombs($r,$uri);
} elsif ($uri=~/\/portfolio\//) {
($resdomain,$resuser)=
(&Apache::lonnet::declutter($uri)=~m|^(\w+)/(\w+)/portfolio|);
$r->print(&Apache::loncommon::bodytag
('Edit Portfolio File Information','','','',$resdomain));
&present_editable_metadata($r,$uri,'portfolio');
&select_course($r);
} elsif ($uri=~/^\/\~/) {
# Construction space
$r->print(&Apache::loncommon::bodytag
('Edit Catalog Information','','','',$resdomain));
&present_editable_metadata($r,$uri);
} else {
$r->print(&Apache::loncommon::bodytag
('Catalog Information','','','',$resdomain));
&present_uneditable_metadata($r,$uri);
}
$r->print('</body></html>');
return OK;
}
#####################################################
#####################################################
### ###
### Report Bombs ###
### ###
#####################################################
#####################################################
sub report_bombs {
my ($r,$uri) = @_;
# Set document type
$uri =~ s:/adm/bombs/::;
$uri = &Apache::lonnet::declutter($uri);
$r->print('<h1>'.&Apache::lonnet::clutter($uri).'</h1>');
my ($domain,$author)=($uri=~/^(\w+)\/(\w+)\//);
if (&Apache::loncacc::constructaccess('/~'.$author.'/',$domain)) {
if ($env{'form.clearbombs'}) {
&Apache::lonmsg::clear_author_res_msg($uri);
}
my $clear=&mt('Clear all Messages in Subdirectory');
$r->print(<<ENDCLEAR);
<form method="post">
<input type="submit" name="clearbombs" value="$clear" />
</form>
ENDCLEAR
my %brokenurls =
&Apache::lonmsg::all_url_author_res_msg($author,$domain);
foreach (sort(keys(%brokenurls))) {
if ($_=~/^\Q$uri\E/) {
$r->print
('<a href="'.&Apache::lonnet::clutter($_).'">'.$_.'</a>'.
&Apache::lonmsg::retrieve_author_res_msg($_).
'<hr />');
}
}
} else {
$r->print(&mt('Not authorized'));
}
return;
}
#####################################################
#####################################################
### ###
### Uneditable Metadata Display ###
### ###
#####################################################
#####################################################
sub present_uneditable_metadata {
my ($r,$uri) = @_;
#
my %content=();
# Read file
foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
$content{$_}=&Apache::lonnet::metadata($uri,$_);
}
# 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 uri target prefix form size
$disuri=&Apache::lonhtmlcommon::crumbs($disuri,undef, undef, undef,'+1');
$disuri =~ s:<br />::g;
# obsolete
my $obsolete=$content{'obsolete'};
my $obsoletewarning='';
if (($obsolete) && ($env{'user.adv'})) {
$obsoletewarning='<p><font color="red">'.
&mt('This resource has been marked obsolete by the author(s)').
'</font></p>';
}
#
my %lt=&fieldnames();
my $table='';
my $title = $content{'title'};
if (! defined($title)) {
$title = 'Untitled Resource';
}
foreach ('title',
'author',
'subject',
'keywords',
'notes',
'abstract',
'lowestgradelevel',
'highestgradelevel',
'standards',
'mime',
'language',
'creationdate',
'lastrevisiondate',
'owner',
'copyright',
'customdistributionfile',
'sourceavail',
'sourcerights',
'obsolete',
'obsoletereplacement') {
$table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.
'</td><td bgcolor="#CCCCCC">'.
&prettyprint($_,$content{$_}).'</td></tr>';
delete $content{$_};
}
#
$r->print(<<ENDHEAD);
<h2>$title</h2>
<p>
$disuri<br />
$obsoletewarning
$versiondisplay
</p>
<table cellspacing="2" border="0">
$table
</table>
ENDHEAD
if ($env{'user.adv'}) {
&print_dynamic_metadata($r,$uri,\%content);
}
return;
}
sub print_dynamic_metadata {
my ($r,$uri,$content) = @_;
#
my %content = %$content;
my %lt=&fieldnames();
#
my $description = 'Dynamic Metadata (updated periodically)';
$r->print('<h3>'.&mt($description).'</h3>'.
&mt('Processing'));
$r->rflush();
my %items=&fieldnames();
my %dynmeta=&dynamicmeta($uri);
#
# General Access and Usage Statistics
if (exists($dynmeta{'count'}) ||
exists($dynmeta{'sequsage'}) ||
exists($dynmeta{'comefrom'}) ||
exists($dynmeta{'goto'}) ||
exists($dynmeta{'course'})) {
$r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.
'<table cellspacing="2" border="0">');
foreach ('count',
'sequsage','sequsage_list',
'comefrom','comefrom_list',
'goto','goto_list',
'course','course_list') {
$r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
'<td bgcolor="#CCCCCC">'.
&prettyprint($_,$dynmeta{$_})."</td></tr>\n");
}
$r->print('</table>');
} else {
$r->print('<h4>'.&mt('No Access or Usages Statistics are available for this resource.').'</h4>');
}
#
# Assessment statistics
if ($uri=~/\.(problem|exam|quiz|assess|survey|form)$/) {
if (exists($dynmeta{'stdno'}) ||
exists($dynmeta{'avetries'}) ||
exists($dynmeta{'difficulty'}) ||
exists($dynmeta{'disc'})) {
# This is an assessment, print assessment data
$r->print('<h4>'.
&mt('Overall Assessment Statistical Data').
'</h4>'.
'<table cellspacing="2" border="0">');
$r->print('<tr><td bgcolor="#AAAAAA">'.$lt{'stdno'}.'</td>'.
'<td bgcolor="#CCCCCC">'.
&prettyprint('stdno',$dynmeta{'stdno'}).
'</td>'."</tr>\n");
foreach ('avetries','difficulty','disc') {
$r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
'<td bgcolor="#CCCCCC">'.
&prettyprint($_,sprintf('%5.2f',$dynmeta{$_})).
'</td>'."</tr>\n");
}
$r->print('</table>');
}
if (exists($dynmeta{'stats'})) {
#
# New assessment statistics
$r->print('<h4>'.
&mt('Detailed Assessment Statistical Data').
'</h4>');
my $table = '<table cellspacing="2" border="0">'.
'<tr>'.
'<th>Course</th>'.
'<th>Section(s)</th>'.
'<th>Num Students</th>'.
'<th>Mean Tries</th>'.
'<th>Degree of Difficulty</th>'.
'<th>Degree of Discrimination</th>'.
'<th>Time of computation</th>'.
'</tr>'.$/;
foreach my $identifier (sort(keys(%{$dynmeta{'stats'}}))) {
my $data = $dynmeta{'stats'}->{$identifier};
my $course = $data->{'course'};
my %courseinfo = &Apache::lonnet::coursedescription($course);
if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
&Apache::lonnet::logthis('lookup for '.$course.' failed');
next;
}
$table .= '<tr>';
$table .=
'<td><nobr>'.$courseinfo{'description'}.'</nobr></td>';
$table .=
'<td align="right">'.$data->{'sections'}.'</td>';
$table .=
'<td align="right">'.$data->{'stdno'}.'</td>';
foreach ('avetries','difficulty','disc') {
$table .= '<td align="right">';
if (exists($data->{$_})) {
$table .= sprintf('%.2f',$data->{$_}).' ';
} else {
$table .= '';
}
$table .= '</td>';
}
$table .=
'<td><nobr>'.
&Apache::lonlocal::locallocaltime($data->{'timestamp'}).
'</nobr></td>';
$table .=
'</tr>'.$/;
}
$table .= '</table>'.$/;
$r->print($table);
} else {
$r->print('No new dynamic data found.');
}
} else {
$r->print('<h4>'.
&mt('No Assessment Statistical Data is available for this resource').
'</h4>');
}
#
#
if (exists($dynmeta{'clear'}) ||
exists($dynmeta{'depth'}) ||
exists($dynmeta{'helpful'}) ||
exists($dynmeta{'correct'}) ||
exists($dynmeta{'technical'})){
$r->print('<h4>'.&mt('Evaluation Data').'</h4>'.
'<table cellspacing="2" border="0">');
foreach ('clear','depth','helpful','correct','technical') {
$r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
'<td bgcolor="#CCCCCC">'.
&prettyprint($_,$dynmeta{$_})."</td></tr>\n");
}
$r->print('</table>');
} else {
$r->print('<h4>'.&mt('No Evaluation Data is available for this resource.').'</h4>');
}
$uri=~/^\/res\/(\w+)\/(\w+)\//;
if ((($env{'user.domain'} eq $1) && ($env{'user.name'} eq $2))
|| ($env{'user.role.ca./'.$1.'/'.$2})) {
if (exists($dynmeta{'comments'})) {
$r->print('<h4>'.&mt('Evaluation Comments').' ('.
&mt('visible to author and co-authors only').
')</h4>'.
'<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
} else {
$r->print('<h4>'.&mt('There are no Evaluation Comments on this resource.').'</h4>');
}
my $bombs = &Apache::lonmsg::retrieve_author_res_msg($uri);
if (defined($bombs) && $bombs ne '') {
$r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.
&mt('visible to author and co-authors only').')'.
'</h4>'.$bombs);
} else {
$r->print('<h4>'.&mt('There are currently no Error Messages for this resource.').'</h4>');
}
}
#
# All other stuff
$r->print('<h3>'.
&mt('Additional Metadata (non-standard, parameters, exports)').
'</h3><table border="0" cellspacing="1">');
foreach (sort(keys(%content))) {
my $name=$_;
if ($name!~/\.display$/) {
my $display=&Apache::lonnet::metadata($uri,
$name.'.display');
if (! $display) {
$display=$name;
};
my $otherinfo='';
foreach ('name','part','type','default') {
if (defined(&Apache::lonnet::metadata($uri,
$name.'.'.$_))) {
$otherinfo.=' '.$_.'='.
&Apache::lonnet::metadata($uri,
$name.'.'.$_).'; ';
}
}
$r->print('<tr><td bgcolor="#bbccbb"><font size="-1" color="#556655">'.$display.'</font></td><td bgcolor="#ccddcc"><font size="-1" color="#556655">'.$content{$name});
if ($otherinfo) {
$r->print(' ('.$otherinfo.')');
}
$r->print("</font></td></tr>\n");
}
}
$r->print("</table>");
return;
}
#####################################################
#####################################################
### ###
### Editable metadata display ###
### ###
#####################################################
#####################################################
sub present_editable_metadata {
my ($r,$uri, $file_type) = @_;
# Construction Space Call
# Header
my $disuri=$uri;
my $fn=&Apache::lonnet::filelocation('',$uri);
$disuri=~s/^\/\~/\/priv\//;
$disuri=~s/\.meta$//;
$disuri=~s|^/editupload||;
my $target=$uri;
$target=~s/^\/\~/\/res\/$env{'request.role.domain'}\//;
$target=~s/\.meta$//;
my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);
if ($bombs) {
my $showdel=1;
if ($env{'form.delmsg'}) {
if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {
$bombs=&mt('Messages deleted.');
$showdel=0;
} else {
$bombs=&mt('Error deleting messages');
}
}
if ($env{'form.clearmsg'}) {
my $cleardir=$target;
$cleardir=~s/\/[^\/]+$/\//;
if (&Apache::lonmsg::clear_author_res_msg($cleardir) eq 'ok') {
$bombs=&mt('Messages cleared.');
$showdel=0;
} else {
$bombs=&mt('Error clearing messages');
}
}
my $del=&mt('Delete Messages for this Resource');
my $clear=&mt('Clear all Messages in Subdirectory');
my $goback=&mt('Back to Source File');
$r->print(<<ENDBOMBS);
<h1>$disuri</h1>
<form method="post" name="defaultmeta">
ENDBOMBS
if ($showdel) {
$r->print(<<ENDDEL);
<input type="submit" name="delmsg" value="$del" />
<input type="submit" name="clearmsg" value="$clear" />
ENDDEL
} else {
$r->print('<a href="'.$disuri.'" />'.$goback.'</a>');
}
$r->print('<br />'.$bombs);
} else {
my $displayfile='Catalog Information for '.$disuri;
if ($disuri=~/\/default$/) {
my $dir=$disuri;
$dir=~s/default$//;
$displayfile=
&mt('Default Cataloging Information for Directory').' '.
$dir;
}
%Apache::lonpublisher::metadatafields=();
%Apache::lonpublisher::metadatakeys=();
my $result=&Apache::lonnet::getfile($fn);
if ($result == -1){
$r->print('Creating new '.$disuri);
} else {
&Apache::lonpublisher::metaeval($result);
}
$r->print(<<ENDEDIT);
<h1>$displayfile</h1>
<form method="post" name="defaultmeta">
ENDEDIT
$r->print('<script language="JavaScript">'.
&Apache::loncommon::browser_and_searcher_javascript().
'</script>');
my %lt=&fieldnames($file_type);
my $output;
my @fields;
if ($file_type eq 'portfolio') {
@fields = ('author','title','subject','keywords','abstract','notes','lowestgradelevel',
'highestgradelevel','standards','courserestricted');
} else {
@fields = ('author','title','subject','keywords','abstract','notes',
'copyright','customdistributionfile','language',
'standards',
'lowestgradelevel','highestgradelevel','sourceavail','sourcerights',
'obsolete','obsoletereplacement');
}
my $metacourse;
if ($env{'form.metacourse'} ) {
$Apache::lonpublisher::metadatafields{'courserestricted'} = $env{'form.metacourse'};
$metacourse = $env{'form.metacourse'};
} else {
if (! $Apache::lonpublisher::metadatafields{'courserestricted'}) {
$Apache::lonpublisher::metadatafields{'courserestricted'}=
'none';
$metacourse = 'none';
} else {
$metacourse = $Apache::lonpublisher::metadatafields{'courserestricted'};
}
}
if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
$Apache::lonpublisher::metadatafields{'copyright'}=
'default';
}
if ($metacourse ne 'none') {
$r->print('Using: <strong> '.$env{$metacourse.".description"}."</strong> metadata framework<br />");
}
foreach my $field_name(@fields) {
if (defined($env{'form.new_'.$field_name})) {
$Apache::lonpublisher::metadatafields{$field_name}=
join(',',&Apache::loncommon::get_env_multiple('form.new_'.$field_name));
}
if ($metacourse ne 'none') {
# handle restrictions here
if ($env{$metacourse.'.metadata.'.$field_name.'.options'} =~ m/active/){
$output.=('<p>'.$lt{$field_name}.': '.
&prettyinput($field_name,
$Apache::lonpublisher::metadatafields{$field_name},
'new_'.$field_name,'defaultmeta',undef,undef,undef,undef,$metacourse).'</p>');
} elsif ($field_name eq 'courserestricted') {
$output.=(
&prettyinput($field_name,
$Apache::lonpublisher::metadatafields{$field_name},
'new_'.$field_name,'defaultmeta',undef,undef,undef,undef,$metacourse));
}
} else {
if ($field_name ne 'courserestricted') {
$output.=('<p>'.$lt{$field_name}.': '.
&prettyinput($field_name,
$Apache::lonpublisher::metadatafields{$field_name},
'new_'.$field_name,'defaultmeta').'</p>');
} else {
$output.=&prettyinput($field_name,
$Apache::lonpublisher::metadatafields{$field_name},
'new_'.$field_name,'defaultmeta');
}
}
}
if ($env{'form.store'}) {
my $mfh;
my $formname='store';
my $file_content;
foreach my $meta_field (keys %env) {
if (&Apache::loncommon::get_env_multiple('form.new_keywords')) {
$Apache::lonpublisher::metadatafields{'keywords'} =
join (',', &Apache::loncommon::get_env_multiple('form.new_keywords'));
}
}
foreach (sort keys %Apache::lonpublisher::metadatafields) {
next if ($_ =~ /\./);
my $unikey=$_;
$unikey=~/^([A-Za-z]+)/;
my $tag=$1;
$tag=~tr/A-Z/a-z/;
$file_content.= "\n\<$tag";
foreach (split(/\,/,
$Apache::lonpublisher::metadatakeys{$unikey})
) {
my $value=
$Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
$value=~s/\"/\'\'/g;
$file_content.=' '.$_.'="'.$value.'"' ;
# print $mfh ' '.$_.'="'.$value.'"';
}
$file_content.= '>'.
&HTML::Entities::encode
($Apache::lonpublisher::metadatafields{$unikey},
'<>&"').
'</'.$tag.'>';
}
if ($fn =~ /\/portfolio\//) {
$fn =~ /\/portfolio\/(.*)$/;
my $new_fn = '/'.$1;
$env{'form.'.$formname}=$file_content."\n";
$env{'form.'.$formname.'.filename'}=$new_fn;
&Apache::lonnet::userfileupload('uploaddoc','',
'portfolio'.$env{'form.currentpath'});
if (&Apache::lonnet::userfileupload($formname,'','portfolio') eq 'error: no uploaded file') {
$r->print('<p><font color="red">'.
&mt('Could not write metadata').', '.
&mt('FAIL').'</font></p>');
} else {
$r->print('<p><font color="blue">'.&mt('Wrote Metadata').
' '.&Apache::lonlocal::locallocaltime(time).
'</font></p>');
}
} else {
if (! ($mfh=Apache::File->new('>'.$fn))) {
$r->print('<p><font color="red">'.
&mt('Could not write metadata').', '.
&mt('FAIL').'</font></p>');
} else {
print $mfh $file_content;
$r->print('<p><font color="blue">'.&mt('Wrote Metadata').
' '.&Apache::lonlocal::locallocaltime(time).
'</font></p>');
}
}
}
my $button_label;
if ($fn =~ /\/portfolio\//) {
$button_label = 'Store Metadata';
} else {
$button_label = 'Store Catalog Information';
}
$r->print($output.'<br /><input type="submit" name="store" value="'.
&mt($button_label).'">');
}
$r->print('</form>');
return;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmeta.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface