File:  [LON-CAPA] / loncom / interface / lonmeta.pm
Revision 1.84: download - view: text, annotated - select for diffs
Fri Jul 9 21:35:05 2004 UTC (19 years, 9 months ago) by banghart
Branches: MAIN
CVS tags: version_1_1_99_3, version_1_1_99_2, HEAD
	typo correction

# The LearningOnline Network with CAPA
# Metadata display handler
#
# $Id: lonmeta.pm,v 1.84 2004/07/09 21:35:05 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">&nbsp&nbsp;</td>';
    } else {
        $output.='<td width="'.($val).'" bgcolor="#555555">&nbsp;</td>'.
                 '<td width="'.(20-$val).'" bgcolor="#FF3333">&nbsp;</td>';
    }
    $output.='<td bgcolor="#FFFF33">&nbsp;</td>';
    if ($val>20) {
	$output.='<td width="'.($val-20).'" bgcolor="#33FF33">&nbsp;</td>'.
                 '<td width="'.(40-$val).'" bgcolor="#555555">&nbsp;</td>';
    } else {
        $output.='<td width="20" bgcolor="#555555">&nbsp&nbsp;</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].'">&nbsp;</td>';
        } else {
	    $output.='<td width="5" bgcolor="#555555">&nbsp;</td>';
	}
    }
    $output.='<td> ('.sprintf("%3.2f",$value).') </td></tr></table>';
    return $output;
}


# 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',
         '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',
         );
}

# 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 '&nbsp;'; 
    }
    # 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).'" />&nbsp;'.
            &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.'&nbsp;';
    }
    return $relatedsep.'<input type="checkbox" name="'.$fieldname.'_related"'.
	($relatedvalue?' checked="1"':'').' />';
}

sub prettyinput {
    my ($type,$value,$fieldname,$formname,
	$relatedsearchflag,$relatedsep,$relatedvalue,$size)=@_;
    if (! defined($size)) {
        $size = 80;
    }
    # 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); 
    }
    # 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/\"/\&quot\;/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+)\//);
    $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=~/^\/\~/) { 
        # 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)) {
        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->{$_}).'&nbsp;';
                    } 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) = @_;
    # Construction Space Call
    # Header
    my $disuri=$uri;
    my $fn=&Apache::lonnet::filelocation('',$uri);
    $disuri=~s/^\/\~/\/priv\//;
    $disuri=~s/\.meta$//;
    my $target=$uri;
    $target=~s/^\/\~/\/res\/$ENV{'request.role.domain'}\//;
    $target=~s/\.meta$//;
    my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);
    if ($bombs) {
        if ($ENV{'form.delmsg'}) {
            if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {
                $bombs=&mt('Messages deleted.');
            } else {
                $bombs=&mt('Error deleting messages');
            }
        }
        my $del=&mt('Delete Messages');
        $r->print(<<ENDBOMBS);
<h1>$disuri</h1>
<form method="post" name="defaultmeta">
<input type="submit" name="delmsg" value="$del" />
<br />$bombs
ENDBOMBS
    } else {
        my $displayfile='Catalog Information for '.$disuri;
        if ($disuri=~/\/default$/) {
            my $dir=$disuri;
            $dir=~s/default$//;
            $displayfile=
                &mt('Default Cataloging Information for Directory').' '.
                $dir;
        }
        my $bodytag=
            &Apache::loncommon::bodytag('Edit Catalog Information');
        %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" name="defaultmeta">
ENDEDIT
        $r->print('<script language="JavaScript">'.
                  &Apache::loncommon::browser_and_searcher_javascript.
                  '</script>');
        my %lt=&fieldnames();
        foreach ('author','title','subject','keywords','abstract','notes',
                 'copyright','customdistributionfile','language',
                 'standards',
                 'lowestgradelevel','highestgradelevel','sourceavail','sourcerights',
                 'obsolete','obsoletereplacement') {
            if (defined($ENV{'form.new_'.$_})) {
                $Apache::lonpublisher::metadatafields{$_}=
                    $ENV{'form.new_'.$_};
            }
            if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
                $Apache::lonpublisher::metadatafields{'copyright'}=
                    'default';
            }
            $r->print('<p>'.$lt{$_}.': '.
                      &prettyinput
                      ($_,$Apache::lonpublisher::metadatafields{$_},
                       'new_'.$_,'defaultmeta').'</p>');
        }
        if ($ENV{'form.store'}) {
            my $mfh;
            if (!  ($mfh=Apache::File->new('>'.$fn))) {
                $r->print('<p><font color=red>'.
                          &mt('Could not write metadata').', '.
                          &mt('FAIL').'</font>');
            } else {
                foreach (sort keys %Apache::lonpublisher::metadatafields) {
                    next if ($_ =~ /\./);
                    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>'.&mt('Wrote Metadata'));
            }
        }
        $r->print('<br /><input type="submit" name="store" value="'.
                  &mt('Store Catalog Information').'">');
    }
    $r->print('</form>');
    return;
}

1;
__END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>