# The LearningOnline Network with CAPA
# Metadata display handler
#
# $Id: lonmeta.pm,v 1.148 2005/12/19 23:19:18 albertel 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 {
    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 portfolio_linked_path {
    my ($path) = @_;
    my $result = &Apache::portfolio::make_anchor('portfolio','/');
    my $fullpath = '/';
    my (undef,@tree) = split('/',$path);
    my $filename = pop(@tree);
    foreach my $dir (@tree) {
	$fullpath .= $dir.'/';
	$result .= '/';
	$result .= &Apache::portfolio::make_anchor($dir,$fullpath);
    }
    $result .= "/$filename";
    return $result;
}

sub portfolio_display_uri {
    my ($uri,$as_links)=@_;
    $uri =~ s|.*/(portfolio/.*)$|$1|;
    my ($res_uri,$meta_uri) = ($uri,$uri);

    if ($uri =~ /\.meta$/) {
	$res_uri =~ s/\.meta//;
    } else {
	$meta_uri .= '.meta';
    }

    my ($path) = ($res_uri =~ m|^portfolio(.*/)[^/]*$|);

    if ($as_links) {
	$res_uri = &portfolio_linked_path($res_uri);
	$meta_uri = &portfolio_linked_path($meta_uri);
    }
    return ($res_uri,$meta_uri,$path);
}

sub pre_select_course {
    my ($r,$uri) = @_;
    my $output;
    my $fn=&Apache::lonnet::filelocation('',$uri);
    my ($res_uri,$meta_uri,$path) = &portfolio_display_uri($uri);
    %Apache::lonpublisher::metadatafields=();
    %Apache::lonpublisher::metadatakeys=();
    my $result=&Apache::lonnet::getfile($fn);
    if ($result == -1){
        $r->print(&mt('Creating new file [_1]'),$meta_uri);
    } else {
        &Apache::lonpublisher::metaeval($result);
    }
    $r->print('<hr /><form method="post" action="" >');
    $r->print('<p>'.&mt('If you would like to associate this resource ([_1]) with a current or previous course, please select one from the list below, otherwise select, \'None\'','<tt>'.$res_uri.'</tt>').'</p>');
    $output = &select_course();
    $r->print($output.'<br /><input type="submit" name="store" value="'.
                  &mt('Associate Resource With Selected Course').'">');
    $r->print('</form>');
    
    $r->print('<br /><br /><form method="POST" action="/adm/portfolio">'.
              '<input type="hidden" name="currentpath" value="'.$path.'" />'.
	      '<input type="submit" name="cancel" value="'.&mt('Cancel').'">'.
	      '</form>');

    return;
}
sub select_course {
    my %courses;
    my $output;
    my $selected;
    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;
        }
    }
    my $meta_not_found = 1;
    if ($Apache::lonpublisher::metadatafields{'courserestricted'} eq 'none') {
        $selected = ' SELECTED ';
    } else {
        $selected = '';
    }
    $output .= '<select name="new_courserestricted" >';
    $output .= '<option value="none" '.$selected.'>None</option>';
    foreach my $key (keys (%courses)) {    
        $key =~ m/(^.+)\.description$/;
        if ($Apache::lonpublisher::metadatafields{'courserestricted'} eq $1) {
            $selected = ' SELECTED ';
        } else {
            $selected = '';
        }
        $output .= '<option value="'.$1.'"'.$selected.'>';
        $output .= $courses{$key};
        $output .= '</option>';
    }
    $output .= '</select><br />';
    return ($output);
}
# 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,$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 (&select_course());
            # 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 (&select_course());
        #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/\"/\&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+)\//);
    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));
        if ($env{'form.store'}) {
            &present_editable_metadata($r,$uri,'portfolio');
        } else {
            &pre_select_course($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)) {
	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->{$_}).'&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, $file_type) = @_;
    # Construction Space Call
    # Header
    my $disuri=$uri;
    my $fn=&Apache::lonnet::filelocation('',$uri);
    $disuri=~s/^\/\~/\/priv\//;
    $disuri=~s/\.meta$//;
    my $meta_uri = $disuri;
    my $path;
    if ($disuri =~ m|/portfolio/|) {
	($disuri, $meta_uri, $path) =  &portfolio_display_uri($disuri,1);
    }
    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(&mt('Creating new file [_1]'),$meta_uri);
        } 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');
	} else {
	    @fields = ('author','title','subject','keywords','abstract','notes',
                 'copyright','customdistributionfile','language',
                 'standards',
                 'lowestgradelevel','highestgradelevel','sourceavail','sourcerights',
                 'obsolete','obsoletereplacement');
        }
        if ((! $Apache::lonpublisher::metadatafields{'courserestricted'}) &&
                (! $env{'form.new_courserestricted'})) {
            $Apache::lonpublisher::metadatafields{'courserestricted'}=
                'none';
        } elsif ($env{'form.new_courserestricted'}) {
            $Apache::lonpublisher::metadatafields{'courserestricted'}=
                $env{'form.new_courserestricted'}; 
        }           
        if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
                $Apache::lonpublisher::metadatafields{'copyright'}=
                'default';
        }
        if ($Apache::lonpublisher::metadatafields{'courserestricted'} ne 'none') {
            $r->print(&mt('Associated with course [_1]','<strong>'.$env{$Apache::lonpublisher::metadatafields{'courserestricted'}.".description"}.
                        '</strong>').'<br />');
        } else {
            $r->print("This resource is not associated with a course.<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 ($Apache::lonpublisher::metadatafields{'courserestricted'} ne 'none') {
                # handle restrictions here
                if (($env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.'.$field_name.'.options'} =~ m/active/) ||
                    ($field_name eq 'courserestricted')){
                    $output.=("\n".'<p>'.$lt{$field_name}.': '.
                              &prettyinput($field_name,
				   $Apache::lonpublisher::metadatafields{$field_name},
				                    'new_'.$field_name,'defaultmeta',
				                    undef,undef,undef,undef,
				                    $Apache::lonpublisher::metadatafields{'courserestricted'}).'</p>'."\n");
                 }
            } else {

                    $output.=('<p>'.$lt{$field_name}.': '.
                            &prettyinput($field_name,
				   $Apache::lonpublisher::metadatafields{$field_name},
				   'new_'.$field_name,'defaultmeta').'</p>');
               
            }
        }
	if ($env{'form.store'}) {
	    my $mfh;
	    my $formname='store'; 
	    my $file_content;
	    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 =~ m|/portfolio/|) {
		my ($path, $new_fn) = ($fn =~ m|/(portfolio.*)/([^/]*)$|);
		$env{'form.'.$formname}=$file_content."\n";
		$env{'form.'.$formname.'.filename'}=$new_fn;
		my $result =&Apache::lonnet::userfileupload($formname,'',
							    $path);
		
		if ($result =~ /(error|notfound)/) {
		    $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>');
		}
	    }
	}
	
	$r->print($output.'<br /><input type="submit" name="store" value="'.
                  &mt('Store Catalog Information').'">');

         $r->print('</form>
               <br /><br /><form method="POST" action="/adm/portfolio">'.
              '<input type="hidden" name="currentpath" value="'.$path.'" />'.
	      '<input type="submit" name="cancel" value="'.&mt('Discard Edits and Return to Portfolio').'">');

    }
    $r->print('</form>');

    return;
}

1;
__END__

     
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 2.0//EN">
<html><head>
<title>500 Internal Server Error</title>
</head><body>
<h1>Internal Server Error</h1>
<p>The server encountered an internal error or
misconfiguration and was unable to complete
your request.</p>
<p>Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.</p>
<p>More information about this error may be available
in the server error log.</p>
</body></html>