File:  [LON-CAPA] / loncom / interface / lonmeta.pm
Revision 1.257: download - view: text, annotated - select for diffs
Tue Nov 7 21:31:11 2023 UTC (13 months, 2 weeks ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD
- Support domain default or user override in new metadata file for:
  Default Copyright/Distribution and Default Source Available.

# The LearningOnline Network with CAPA
# Metadata display handler
#
# $Id: lonmeta.pm,v 1.257 2023/11/07 21:31:11 raeburn 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;
use LONCAPA qw(:DEFAULT :match);


sub get_dynamic_metadata_from_sql {
    my ($url) = shift();
    my ($authordom,$author)=($url=~m{^/res/($match_domain)/($match_username)/});
    if (! defined($authordom)) {
        $authordom = shift();
    }
    if  (! defined($author)) { 
        $author = shift();
    }
    if (! defined($authordom) || ! defined($author)) {
        return ();
    }
    my $query = 'SELECT * 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 %hash=&LONCAPA::lonmetadata::metadata_col_to_hash('metadata',
								 map { &unescape($_) } split(/\,/,$result));
            foreach my $key (keys(%hash)) {
                $ReturnHash{$hash{'url'}}->{$key}=$hash{$key};
            }
        }
        $finished = 1;
    }
    #
    return %ReturnHash;
}


# Fetch and evaluate dynamic metadata
sub dynamicmeta {
    my $url=&Apache::lonnet::declutter(shift);
    $url=~s/\.meta$//;
    my ($adomain,$aauthor)=($url=~/^($match_domain)\/($match_username)\//);
    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;' x2).'</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;' x2).'</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');
    
    if ( !defined($file_type) || ($file_type ne 'portfolio' && $file_type ne 'groups') ) {
        %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'      => 'Statistics calculated for number of students',
         '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,$group,$port_path) = @_;

    my $start = 'portfolio';
    if ($group) {
	$start = "groups/$group/".$start;
    }
    my %anchor_fields = (
        'selectfile'  => $start,
        'currentpath' => '/'
    );
    my $result = &Apache::portfolio::make_anchor($port_path,\%anchor_fields,$start);
    my $fullpath = '/';
    my (undef,@tree) = split('/',$path);
    my $filename = pop(@tree);
    foreach my $dir (@tree) {
	$fullpath .= $dir.'/';
	$result .= '/';
	my %anchor_fields = (
            'selectfile'  => $dir,
            'currentpath' => $fullpath
        );
	$result .= &Apache::portfolio::make_anchor($port_path,\%anchor_fields,$dir);
    }
    $result .= "/$filename";
    return $result;
}

sub get_port_path_and_group {
    my ($uri)=@_;

    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};

    my ($port_path,$group);
    if ($uri =~ m{^/editupload/\Q$cdom\E/\Q$cnum\E/groups/}) {
	$group = (split('/',$uri))[5];
	$port_path = '/adm/coursegrp_portfolio';
    } else {
	$port_path = '/adm/portfolio';
    }
    if ($env{'form.group'} ne $group) {
	$env{'form.group'} = $group;
    }
    return ($port_path,$group);
}

sub portfolio_display_uri {
    my ($uri,$as_links)=@_;

    my ($port_path,$group) = &get_port_path_and_group($uri);

    $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,$group,$port_path);
	$meta_uri = &portfolio_linked_path($meta_uri,$group,$port_path);
    }
    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('<input type="hidden" name="currentpath" value="'.$env{'form.currentpath'}.'" />');
    $r->print('<input type="hidden" name="associate" value="true" />');
    $r->print('</form>');
    
    my ($port_path,$group) = &get_port_path_and_group($uri);
    my $group_input;
    if ($group) {
        $group_input = '<input type="hidden" name="group" value="'.$group.'" />';
    } 
    $r->print(' <form method="post" action="'.$port_path.'">'.
              '<input type="hidden" name="currentpath" value="'.$path.'" />'.
	      $group_input.
	      '<input type="submit" name="cancel" value="'.&mt('Cancel').'" />'.
	      '</form>');

    return;
}
sub select_course {
    my $output=$/;
    my $current_restriction=
	$Apache::lonpublisher::metadatafields{'courserestricted'};
    my $selected = ($current_restriction eq 'none' ? 'selected="selected"' 
		                                   : '');
    if ($current_restriction =~ /^course\.($match_domain\_$match_courseid)$/) {
        my $assoc_crs = $1;
        my $added_metadata_fields = &Apache::lonparmset::get_added_meta_fieldnames($assoc_crs);
        if (ref($added_metadata_fields) eq 'HASH') {
            if (keys(%{$added_metadata_fields}) > 0) {
                my $transfernotes;
                foreach my $field_name (keys(%{$added_metadata_fields})) {
                    my $value = $Apache::lonpublisher::metadatafields{$field_name};
                    if ($value) {
                        $transfernotes .= 
                            &Apache::loncommon::start_data_table_row(). 
                            '<td><input type="checkbox" name="transfer_'.
                            $field_name.'" value="1" /></td><td>'.
                            $field_name.'</td><td>'.$value.'</td>'.
                            &Apache::loncommon::end_data_table_row();
                    }
                }
                if ($transfernotes ne '') {
                    my %courseinfo = &Apache::lonnet::coursedescription($assoc_crs,{'one_time' => 1});
                    my $assoc_crs_description = $courseinfo{'description'};
                    $output .= &mt('This resource is currently associated with a course ([_1]) which includes added metadata fields specific to the course.',$assoc_crs_description).'<br />'."\n".
                    &mt('You can choose to transfer data from the added fields to the "Notes" field if you are planning to change the course association.').'<br /><br />'.
                    &Apache::loncommon::start_data_table().
                    &Apache::loncommon::start_data_table_header_row().
                    '<th>'.&mt('Copy to notes?').'</th>'."\n".
                    '<th>'.&mt('Field Name').'</th>'."\n".
                    '<th>'.&mt('Values').'</th>'."\n".
                    &Apache::loncommon::end_data_table_header_row().
                    $transfernotes.
                    &Apache::loncommon::end_data_table().'<br />';
                }
            }
        }
    }
    $output .= '<select name="new_courserestricted" >';
    $output .= '<option value="none" '.$selected.'>'.
	&mt('None').'</option>'.$/;
    my %courses;
    foreach my $key (keys(%env)) {
        if ($key !~ m/^course\.(.+)\.description$/) { next; }
	my $cid = $1;
        if ($env{$key} !~ /\S/) { next; }
	$courses{$key} = $cid;
    }
    foreach my $key (sort { lc($env{$a}) cmp lc($env{$b}) } (keys(%courses))) {
	my $cid = 'course.'.$courses{$key};
	my $selected = ($current_restriction eq $cid ? 'selected="selected"' 
		                                     : '');
        if ($env{$key} !~ /\S/) { next; }
	$output .= '<option value="'.$cid.'" '.$selected.'>';
	$output .= $env{$key};
	$output .= '</option>'.$/;
	$selected = '';
    }
    $output .= '</select><br />';
    return ($output);
}
# Pretty printing of metadata field

sub prettyprint {
    my ($type,$value,$target,$prefix,$form)=@_;
# $target,$prefix,$form are optional and for filecrumbs only
    if (! defined($value)) { 
        return '&nbsp;'; 
    }
    # Title
    if ($type eq 'title') {
	return $value;
    }
    # Dates
    if (($type eq 'creationdate') ||
	($type eq 'lastrevisiondate')) {
	return ($value?&Apache::lonlocal::locallocaltime(
			  &Apache::lonmysql::unsqltime($value)):
		&mt('not available'));
    }
    # Language
    if ($type eq 'language') {
	return &Apache::loncommon::languagedescription($value);
    }
    # Copyright
    if ($type eq 'copyright') {
	return &Apache::loncommon::copyrightdescription($value);
    }
    # Copyright
    if ($type eq 'sourceavail') {
	return &Apache::loncommon::source_copyrightdescription($value);
    }
    # MIME
    if ($type eq 'mime') {
        return '<img src="'.&Apache::loncommon::icon($value).'" alt="" />&nbsp;'.
            &Apache::loncommon::filedescription($value);
    }
    # Person
    if (($type eq 'author') || 
	($type eq 'owner') ||
	($type eq 'modifyinguser') ||
	($type eq 'authorspace')) {
	$value=~s/($match_username)(\:|\@)($match_domain)/&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 class="LC_fontsize_medium">'.join("\n",map {
            my $url = &Apache::lonnet::clutter_with_no_wrapper($_);
            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).
                 '</li>'
	    } split(/\s*\,\s*/,$value)).'</ul>';
    }
    # 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='<ul class="LC_fontsize_medium">';
	my %descriptions;
        foreach my $course (@Courses) {
            my %courseinfo =
		&Apache::lonnet::coursedescription($course,
						   {'one_time' => 1});
            if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
                next;
            }
	    $descriptions{join('\0',@courseinfo{'domain','description'})} .= 
		'<li><a href="/public/'.$courseinfo{'domain'}.'/'.
                $courseinfo{'num'}.'/syllabus" target="preview">'.
                $courseinfo{'description'}.' ('.$courseinfo{'domain'}.
		')</a></li>';
        }
	foreach my $course (sort {lc($a) cmp lc($b)} (keys(%descriptions))) {
	    $Str .= $descriptions{$course};
	}

	return $Str.'</ul>';
    }
    # No pretty print found
    return $value;
}

# Pretty input of metadata field
sub direct {
    return shift;
}

sub selectbox {
    my ($name,$value,$readonly,$functionref,@idlist)=@_;
    if (! defined($functionref)) {
        $functionref=\&direct;
    }
    my $disabled;
    if ($readonly) {
        $disabled = ' disabled="disabled"';
    }
    my $selout='<select name="'.$name.'">';
    foreach my $id (@idlist) {
        $selout.='<option value="'.$id.'"'.$disabled;
        if ($id eq $value) {
	    $selout.=' selected="selected">'.&{$functionref}($id).'</option>';
        } else {
            $selout.='>'.&{$functionref}($id).'</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="checked"':'').' />';
}

sub prettyinput {
    my ($type,$value,$readonly,$fieldname,$formname,
	$relatedsearchflag,$relatedsep,$relatedvalue,$size,$course_key)=@_;
    if (! defined($size)) {
        $size = 80;
    }
    my $output;
    if (defined($course_key) 
	&& exists($env{$course_key.'.metadata.'.$type.'.options'})) {
        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 {
                    if ($item ne '') {
                        $cur_values_stu .= $item.',';
                    }
                }
            }
             $cur_values_stu =~ s/,$//;
            my @key_order = sort(keys(%meta_options));
            unshift(@key_order,'');
            $meta_options{''} = 'Not specified';
            $meta_options{'select_form_order'} = \@key_order;
        } 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')
             || (exists($env{$course_key.'.metadata.'.$type.'.added'}))) {
            
            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,$readonly,
			  \&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="checked"':'').' />'.
            &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') {
        my $disabled;
        if ($readonly) {
            $disabled = ' disabled="disabled"';
        }
        my $output;
	$output = '<input type="text" name="'.$fieldname.
	    '" size="60" value="'.$value.'"'.$disabled.' />';
        unless ($readonly) {
            $output .= '<a href="javascript:openbrowser'.
	               "('".$formname."','".$fieldname."'".
	               ",'rights')\">".&mt('Select').'</a>';
        }
        $output .= &relatedfield(0,$relatedsearchflag,$relatedsep);
        return $output;
    }
    # 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); 
}

# Create pageheader
sub pageheader {
    my $output = '';
    # No CSTR? Include breadcrumbs
    if ($env{'request.state'} ne 'construct') {
        # loncommon::bodytag already includes breadcrumbs for CSTR
        # by calling lonmenu::innerregister
        $output = &Apache::lonhtmlcommon::breadcrumbs();
    }
    # CSTR? Include CSTR header
    if ($env{'request.state'} eq 'construct') {
          $output .= &Apache::loncommon::head_subbox(
                         &Apache::loncommon::CSTR_pageheader());
    }
    return $output;
}

# Main Handler
sub handler {
    my $r=shift;
    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
         ['currentpath','changecourse','modal']);
    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)=~/^($match_domain)\/($match_username)\//);

    # Breadcrumbs
    &Apache::lonhtmlcommon::clear_breadcrumbs();

    if ($env{'request.state'} eq 'construct') {
        my $text = 'Authoring Space';
        my $href = &Apache::loncommon::authorspace($uri);
        if ($env{'request.course.id'}) {
            my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
            my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
            if ($href eq "/priv/$cdom/$cnum/") {
                $text = 'Course Authoring Space';
            }
        }
        &Apache::lonhtmlcommon::add_breadcrumb({
            'text'  => $text,
            'href'  => $href,
        });
    }

    if ($uri=~m:/adm/bombs/(.*)$:) {
        &Apache::lonhtmlcommon::add_breadcrumb({
            'text'  => 'Error Messages',
            'href'  => '',
        });
        $r->print(&Apache::loncommon::start_page('Error Messages'));
        $r->print(&pageheader());
        # Looking for all bombs?
        &report_bombs($r,$uri);
    } elsif ($uri=~m|^/editupload/[^/]+/[^/]+/portfolio/|) {
        &Apache::lonhtmlcommon::add_breadcrumb({
            'text'  => 'Edit Portfolio File Metadata',
            'href'  => '',
        });
	    ($resdomain,$resuser)=
		(&Apache::lonnet::declutter($uri)=~m|^($match_domain)/($match_name)/portfolio|);
        $r->print(&Apache::loncommon::start_page('Edit Portfolio File Metadata',
						 undef,
						 {'domain' => $resdomain,}));
        $r->print(&pageheader());
        if ($env{'form.store'}) {
            &present_editable_metadata($r,$uri,'portfolio');
        } else {
            my $fn=&Apache::lonnet::filelocation('',$uri);
            %Apache::lonpublisher::metadatafields=();
            %Apache::lonpublisher::metadatakeys=();
            my $result=&Apache::lonnet::getfile($fn);
            &Apache::lonpublisher::metaeval($result);
            if ((!$Apache::lonpublisher::metadatafields{'courserestricted'}) ||
                ($env{'form.changecourse'} eq 'true')) {
                &pre_select_course($r,$uri);
            } else {
                &present_editable_metadata($r,$uri,'portfolio');
            }
        }
    } elsif ($uri=~m|^/editupload/[^/]+/[^/]+/groups/|) {
        &Apache::lonhtmlcommon::add_breadcrumb({
            'text'  => 'Edit Group Portfolio File Metadata',
            'href'  => '',
        });
        $r->print(&Apache::loncommon::start_page('Edit Group Portfolio File Metadata',
						 undef,
						 {'domain' => $resdomain,}));
        $r->print(&pageheader());
        &present_editable_metadata($r,$uri,'groups');    
    } elsif ($uri=~m|^/priv|) { 
        # Authoring space
        &Apache::lonhtmlcommon::add_breadcrumb({
            'text'  => 'Edit Metadata',
            'href'  => '',
        });
        $r->print(&Apache::loncommon::start_page('Edit Metadata',
						"\n".'<script type="text/javascript">'."\n".
                                                &Apache::loncommon::browser_and_searcher_javascript().
                                                "\n".'</script>',
						 {'domain' => $resdomain,}));
        $r->print(&pageheader());
        &present_editable_metadata($r,$uri);
    } else {
        &Apache::lonhtmlcommon::add_breadcrumb({
            'text'  => 'Metadata',
            'href'  => '',
        });
        $r->print(
            &Apache::loncommon::start_page(
                'Metadata',
                undef,
                {'domain' => $resdomain,
                'only_body' => 1,})
           .'<h1>'.&mt('Metadata').'</h1>'
        );
        if ($env{'form.modal'}) {
            my $width = 500;
            my $height = 400;
            my $machine = &Apache::lonnet::absolute_url();
            $r->print(&Apache::loncommon::nicescroll_javascript('metadatawrapper',
                                                                {cursorcolor => '#00F',
                                                                 railalign => 'right',
                                                                 railoffset => '{top:5,left:40}'},
                                                                 undef,1,$machine.$uri));
            $r->print('<div id="metadatawrapper" style="height:'.$height.'px; width:'.$width.'px; overflow: auto;">');
        }
        &present_uneditable_metadata($r,$uri);
        if ($env{'form.modal'}) {
            $r->print('</div>');
        }
    }
    $r->print(&Apache::loncommon::end_page());
    return OK;
}

#####################################################
#####################################################
###                                               ###
###                Report Bombs                   ###
###                                               ###
#####################################################
#####################################################
sub report_bombs {
    my ($r,$uri) = @_;
    # Set document type
    $uri =~ s:/adm/bombs/::;
    $uri = &Apache::lonnet::declutter($uri);
    $r->print(
        '<p>'.&mt('Folder: [_1]',
                  '<span class="LC_filename">'.&Apache::lonnet::clutter($uri).'</span>')
       .'</p>'
    );
    my ($domain,$author)=($uri=~/^($match_domain)\/($match_username)\//);
    if (!&Apache::lonnet::constructaccess('/priv/'.$domain.'/'.$author.'/')) {
        $r->print('<p class="LC_error">'.&mt('Not authorized').'</p>');
        return;
    }

    my $showbuttons=1;
    my $message='';
    if ($env{'form.clearbombs'}) {
        my $rc=&Apache::lonmsg::clear_author_res_msg($uri);
        if ($rc eq 'ok') {
                $message=&Apache::lonhtmlcommon::confirm_success(
                    &mt('Messages cleared.'));
                $showbuttons=0;
        } else {
                $message=&Apache::lonhtmlcommon::confirm_success(
                             &mt('Error clearing messages'),1)
                        .'<br />'.&mt('Error: [_1]',$rc);
        }
    }

    if ($message) {    
        $message=&Apache::loncommon::confirmwrapper($message);
        $r->print($message);
    }

    my $cancelurl=$uri;
    $cancelurl=~s/^\Q$domain\E/\/priv\/$domain/;

    if ($showbuttons) {
        $r->print(
            '<form method="post" action="">'.
            '<input type="submit" name="clearbombs" value="'.
                &mt('Clear all Messages in Subdirectory').'" />'.
            ' <a href="'.$cancelurl.'">'.
                &mt('Back to Source Directory').'</a>'.
            '</form><hr />'
        );
        # Display all bombs of subdirectory
        my %brokenurls = 
            &Apache::lonmsg::all_url_author_res_msg($author,$domain);
        foreach my $key (sort(keys(%brokenurls))) {
            if ($key=~/^\Q$uri\E/) {
                $r->print
                    ('<a href="'.&Apache::lonnet::clutter($key).'">'.$key.'</a>'.
                     &Apache::lonmsg::retrieve_author_res_msg($key).
                     '<hr />');
            }
        }
    } else {
            my $functions=&Apache::lonhtmlcommon::start_funclist('Actions');
            $functions.=&Apache::lonhtmlcommon::add_item_funclist(
                            '<a href="'.$cancelurl.'">'.
                            &mt('Back to Source Directory').'</a>');
            $functions .= &Apache::lonhtmlcommon::end_funclist();
            $r->print('<p>'.$functions.'</p>');
    }
    return;
}

#####################################################
#####################################################
###                                               ###
###        Uneditable Metadata Display            ###
###                                               ###
#####################################################
#####################################################
sub present_uneditable_metadata {
    my ($r,$uri) = @_;
    #
    my $uploaded = ($uri =~ m|/uploaded/|);
    my %content=();
    # Read file
    foreach my $key (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
        $content{$key}=&Apache::lonnet::metadata($uri,$key);
    }
    # Render Output
    # displayed url
    my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
    $uri=~s/\.meta$//;
    my $disuri=&Apache::lonnet::clutter_with_no_wrapper($uri);
    # version
    my $versiondisplay='';
    if (!$uploaded) {
	my $currentversion=&Apache::lonnet::getversion($disuri);
	if ($thisversion) {
	    $versiondisplay=&mt('Version').': '.$thisversion.
		' ('.&mt('most recent version').': '.
		($currentversion>0 ? 
		 $currentversion   :
		 &mt('information not available')).')';
	} else {
	    $versiondisplay=&mt('Version: [_1]',$currentversion);
	}
    }
    # crumbify displayed URL               uri     target prefix form 
    $disuri=&Apache::lonhtmlcommon::crumbs($disuri,undef, undef, undef);
    # obsolete
    my $obsolete=$content{'obsolete'};
    my $obsoletewarning='';
    if (($obsolete) && ($env{'user.adv'})) {
        $obsoletewarning='<p><span class="LC_warning">'.
            &mt('This resource has been marked obsolete by the author(s)').
            '</span></p>';
    }
    #
    my %lt=&fieldnames();
    my $table='';
    my $title = $content{'title'};
    if (! defined($title)) {
        $title = &mt('Untitled Resource');
    }
    my @fields;
    if ($uploaded) {
	@fields = ('title','author','subject','keywords','notes','abstract',
		   'lowestgradelevel','highestgradelevel','standards','mime',
		   'owner');
    } else {
	@fields = ('title', 
		   'author', 
		   'subject', 
		   'keywords', 
		   'notes', 
		   'abstract',
		   'lowestgradelevel',
		   'highestgradelevel',
		   'standards', 
		   'mime', 
		   'language', 
		   'creationdate', 
		   'lastrevisiondate', 
		   'owner', 
		   'copyright', 
		   'customdistributionfile',
		   'sourceavail',
		   'sourcerights', 
		   'obsolete', 
		   'obsoletereplacement');
    }
    my $rownum = 0;
    foreach my $field (@fields) {
        my $lastrow = '';
        $rownum ++;
        $lastrow = 1 if ($rownum == @fields); 
        $table.=&Apache::lonhtmlcommon::row_title($lt{$field})
               .&prettyprint($field,$content{$field})
               .&Apache::lonhtmlcommon::row_closure($lastrow);
        delete($content{$field});
    }
    #
    $r->print("<h2>$title</h2>"
             .'<p>'
             .$disuri.'<br />'
             .$obsoletewarning
             .$versiondisplay
             .'</p>'
             .&Apache::lonhtmlcommon::start_pick_box()
             .$table
             .&Apache::lonhtmlcommon::end_pick_box()
    );
    if (!$uploaded && $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
    $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>');
    if (exists($dynmeta{'count'}) ||
        exists($dynmeta{'sequsage'}) ||
        exists($dynmeta{'comefrom'}) ||
        exists($dynmeta{'goto'}) ||
        exists($dynmeta{'course'})) {
        $r->print(&Apache::lonhtmlcommon::start_pick_box());
        my @counts = ('count','sequsage','sequsage_list',
                      'comefrom','comefrom_list','goto',
                      'goto_list','course','course_list');
        my $rownum = 0;
        foreach my $item (@counts) {
            my $lastrow = '';
            $rownum ++;
            $lastrow = 1 if ($rownum == @counts);
            $r->print(&Apache::lonhtmlcommon::row_title($lt{$item})
                     .&prettyprint($item,$dynmeta{$item})
                     .&Apache::lonhtmlcommon::row_closure($lastrow)
            );
        }
        $r->print(&Apache::lonhtmlcommon::end_pick_box());
    } else {
        $r->print('<p>'
                 .&mt('No Access or Usages Statistics are available for this resource.')
                 .'</p>'
        );
    }
    #
    # Assessment statistics
    if ($uri=~/$LONCAPA::assess_re/) {
        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>'.
                      &Apache::lonhtmlcommon::start_pick_box());
            $r->print(&Apache::lonhtmlcommon::row_title($lt{'stdno'})
                     .&prettyprint('stdno',$dynmeta{'stdno'})
                     .&Apache::lonhtmlcommon::row_closure()
            );
            my @stats = ('avetries','difficulty','disc');
            my $rownum = 0;
            foreach my $item (@stats) {
                my $lastrow = '';
                $rownum ++;
                $lastrow = 1 if ($rownum == @stats);
                $r->print(&Apache::lonhtmlcommon::row_title($lt{$item})
                         .&prettyprint($item,sprintf('%5.2f',$dynmeta{$item}))
                         .&Apache::lonhtmlcommon::row_closure($lastrow)
                );
            }
            $r->print(&Apache::lonhtmlcommon::end_pick_box());
        }
        #
        # New assessment statistics
        $r->print('<h4>'
                 .&mt('Recent Detailed Assessment Statistical Data')
                 .'</h4>'
        );
        if (exists($dynmeta{'stats'})) {
            my $table=&Apache::loncommon::start_data_table()
                     .&Apache::loncommon::start_data_table_header_row()
		     .'<th>'.&mt('Domain').'</th>'
                     .'<th>'.&mt('Course').'</th>'
                     .'<th>'.&mt('Section(s)').'</th>'
                     .'<th>'.&mt('Num Students').'</th>'
                     .'<th>'.&mt('Part').'</th>'
                     .'<th>'.&mt('Mean Tries').'</th>'
                     .'<th>'.&mt('Degree of Difficulty').'</th>'
                     .'<th>'.&mt('Degree of Discrimination').'</th>'
                     .'<th>'.&mt('Time of computation').'</th>'
                     .&Apache::loncommon::end_data_table_header_row().$/;
            foreach my $identifier (sort(keys(%{$dynmeta{'stats'}}))) {
                my $data = $dynmeta{'stats'}->{$identifier};
                my $course = $data->{'course'};
                my %courseinfo = 
		    &Apache::lonnet::coursedescription($course,
						       {'one_time' => 1});
                if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
                    &Apache::lonnet::logthis('lookup for '.$course.' failed');
                    next;
                }
                $table .= &Apache::loncommon::start_data_table_row();
		$table .=
		    '<td><span class="LC_nobreak">'.$courseinfo{'domain'}.'</span></td>';
                $table .= 
                    '<td><span class="LC_nobreak">'.$courseinfo{'description'}.'</span></td>';
                $table .= 
                    '<td align="right">'.$data->{'sections'}.'</td>';
                $table .=
                    '<td align="right">'.$data->{'stdno'}.'</td>';
                $table .=
                    '<td align="right">'.$data->{'part'}.'</td>';
                foreach my $item ('avetries','difficulty','disc') {
                    $table .= '<td align="right">';
                    if (exists($data->{$item})) {
                        $table .= sprintf('%.2f',$data->{$item}).'&nbsp;';
                    } else {
                        $table .= '';
                    }
                    $table .= '</td>';
                }
                $table .=
                    '<td><span class="LC_nobreak">'.
                    &Apache::lonlocal::locallocaltime($data->{'timestamp'}).
                    '</span></td>';
                $table .= &Apache::loncommon::end_data_table_row().$/;
            }
            $table .= &Apache::loncommon::end_data_table().$/;
            $r->print($table);
        } else {
            $r->print('<p>'
                     .&mt('No new dynamic data found.')
                     .'</p>'
            );
        }
    } else {
        $r->print('<h4>'.
          &mt('No Assessment Statistical Data is available for this resource').
                  '</h4>');
    }
    #
    # Evaluation Data
    $r->print('<h4>'.&mt('Evaluation Data').'</h4>');
    if (exists($dynmeta{'clear'})   || 
        exists($dynmeta{'depth'})   || 
        exists($dynmeta{'helpful'}) || 
        exists($dynmeta{'correct'}) || 
        exists($dynmeta{'technical'})){ 
        $r->print(&Apache::lonhtmlcommon::start_pick_box());
        my @criteria = ('clear','depth','helpful','correct','technical');
        my $rownum = 0;
        foreach my $item (@criteria) {
            my $lastrow = '';
            $rownum ++;
            $lastrow = 1 if ($rownum == @criteria);
            $r->print(&Apache::lonhtmlcommon::row_title($lt{$item})
                     .&prettyprint($item,$dynmeta{$item})
                     .&Apache::lonhtmlcommon::row_closure($lastrow)
            );
        }
        $r->print(&Apache::lonhtmlcommon::end_pick_box());
    } else {
        $r->print('<p>'
                 .&mt('No Evaluation Data is available for this resource.')
                 .'</p>'
        );
    }
    # Evaluation Comments
    $uri=~/^\/res\/($match_domain)\/($match_username)\//; 
    if ((($env{'user.domain'} eq $1) && ($env{'user.name'} eq $2))
        || ($env{'user.role.ca./'.$1.'/'.$2})) {
        $r->print('<h4>'.&mt('Evaluation Comments').'</h4>'
                 .'<div>('
                 .&mt('visible to author and co-authors only')
                 .')</div>'
        );
        if (exists($dynmeta{'comments'})) {
            $r->print('<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
        } else {
            $r->print('<p>'
                     .&mt('There are no Evaluation Comments on this resource.')
                     .'</p>'
            );
        }
        my $bombs = &Apache::lonmsg::retrieve_author_res_msg($uri);
        if (defined($bombs) && $bombs ne '') {
            $r->print('<a name="bombs" />'
                     .'<h4 class="LC_warning">'.&mt('Error Messages').'</h4>'
                     .'<div>('
                     .&mt('visible to author and co-authors only')
                     .')</div>'
                     .$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>');
    $r->print(&Apache::lonhtmlcommon::start_pick_box());
    my @names;
    foreach my $key (sort(keys(%content))) {
        if ($key!~/\.display$/) {
            push(@names,$key);
        }
    }
    if (@names > 0) {
        my $rownum = 0;
        foreach my $name (@names) {
            my $lastrow = '';
            $rownum ++;
            $lastrow = 1 if ($rownum == @names);

            my $display=&Apache::lonnet::metadata($uri,
                                                  $name.'.display');
            if (! $display) { 
                $display=$name;
            };
            my $otherinfo='';
            foreach my $item ('name','part','type','default') {
                if (defined(&Apache::lonnet::metadata($uri,
                                                      $name.'.'.$item))) {
                    $otherinfo.=' '.$item.'='.
                        &Apache::lonnet::metadata($uri,
                                                  $name.'.'.$item).'; ';
                }
            }
            $r->print(&Apache::lonhtmlcommon::row_title($display)
                     .$content{$name}
            );
            if ($otherinfo) {
                $r->print(' ('.$otherinfo.')');
            }
            $r->print(&Apache::lonhtmlcommon::row_closure($lastrow));
        }
    }
    $r->print(&Apache::lonhtmlcommon::end_pick_box());
    return;
}



#####################################################
#####################################################
###                                               ###
###          Editable metadata display            ###
###                                               ###
#####################################################
#####################################################
sub present_editable_metadata {
    my ($r,$uri,$file_type) = @_;
    # Authoring Space Call
    # Header
    my $disuri=$uri;
    my ($courseauthor,$crsaurights,$readonly);
    if ($env{'request.course.id'}) {
        my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
        my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
        if ($uri =~ m{^\Q/priv/$cdom/$cnum/\E}) {
            $courseauthor = $cnum.':'.$cdom;
            $crsaurights = "/res/$cdom/$cnum/default.rights";
            $readonly = 1;
        }
    }
    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) {
        # Display Bombs, not Metadata
        $r->print(
            '<h2>'.&mt('Error Messages').'</h2>'
           .'<p>'.&mt('Folder: [_1]',
                      '<span class="LC_filename">'.$disuri.'</span>')
           .'</p>'
        );
        my $showbuttons=1;
        my $message='';
        my $rc='';
        if ($env{'form.delmsg'}) {
            $rc=&Apache::lonmsg::del_url_author_res_msg($target);
            if ($rc eq 'ok') {
                $message=&Apache::lonhtmlcommon::confirm_success(
                             &mt('Messages deleted.'));
		$showbuttons=0;
            } else {
                $message=&Apache::lonhtmlcommon::confirm_success(
                             &mt('Error deleting messages'), 1)
                        .'<br />'.&mt('Error: [_1]',$rc);
            }
        }
        if ($env{'form.clearmsg'}) {
	    my $cleardir=$target;
	    $cleardir=~s/\/[^\/]+$/\//; # Extract dir: keep path, remove filename
            $rc=&Apache::lonmsg::clear_author_res_msg($cleardir);
            if ($rc eq 'ok') {
                $message=&Apache::lonhtmlcommon::confirm_success(
                    &mt('Messages cleared.'));
		$showbuttons=0;
            } else {
                $message=&Apache::lonhtmlcommon::confirm_success(
                             &mt('Error clearing messages'),1)
                        .'<br />'.&mt('Error: [_1]',$rc);
            }
        }
        if ($message) {
            $message=&Apache::loncommon::confirmwrapper($message);
            $r->print($message);
        }

        $r->print('<form method="post" action="" name="defaultmeta">');
        if ($showbuttons) {
            $r->print(
                '<input type="submit" name="delmsg" value="'.
                &mt('Delete Messages for this Resource').'" />'.
                '<input type="submit" name="clearmsg" value="'.
                &mt('Clear all Messages in Subdirectory').'" />'
               .'<br />'.$bombs
            );
        } else {
            my $functions=&Apache::lonhtmlcommon::start_funclist('Actions');
            $functions.=&Apache::lonhtmlcommon::add_item_funclist(
                            '<a href="'.$disuri.'">'.
                            &mt('Back to Source File').'</a>');
            my ($diruri) = ($disuri =~ m{(.*/)[^/]*});
            $functions.=&Apache::lonhtmlcommon::add_item_funclist(
                            '<a href="'.$diruri.'">'.
                            &mt('Back to Source Directory').'</a>');
            $functions .= &Apache::lonhtmlcommon::end_funclist();
            $r->print('<p>'.$functions.'</p>');
        }
    } else {

        # Display Metadata, not Bombs
        my $displayfile =
            &mt('Metadata for [_1]'
               ,'<span class="LC_filename">'.$disuri.'</span>');
        if ($disuri=~/\/default$/) {
            my $dir=$disuri;
            $dir=~s/default$//;
            $displayfile=&mt('Default Metadata for Directory [_1]'
                            ,'<span class="LC_filename">'.$dir.'</span>');
        }
        %Apache::lonpublisher::metadatafields=();
        %Apache::lonpublisher::metadatakeys=();
        my $result=&Apache::lonnet::getfile($fn);
        if ($result == -1){
            my $message = &Apache::lonhtmlcommon::confirm_success(
                &mt('Creating new file [_1]'
                   ,'<span class="LC_filename"'.$meta_uri.'</span>'));
            $message = &Apache::loncommon::confirmwrapper($message);
            $r->print($message);
        } else {
            &Apache::lonpublisher::metaeval($result);
        }
        if ($env{'form.new_courserestricted'}) {
            my $new_assoc_course = $env{'form.new_courserestricted'};
            my $prev_courserestricted = $Apache::lonpublisher::metadatafields{'courserestricted'};
            if (($prev_courserestricted) && 
                ($prev_courserestricted ne $new_assoc_course)) {
                my $transfers = [];
                foreach my $key (keys(%env)) {
                    if ($key =~ /^form\.transfer_(.+)$/) {
                        push(@{$transfers},$1);
                    }
                }
                if (@{$transfers} > 0) {
                    &store_transferred_addedfields($fn,$uri,$transfers);
                }
            }
        }
        $r->print(<<ENDEDIT);
<h2>$displayfile</h2>
<form method="post" action="" name="defaultmeta">
ENDEDIT
        my %lt=&fieldnames($file_type);
	my $output;
	my @fields;
	my $added_metadata_fields;
	my @added_order;
        if ($file_type eq 'groups') {
            $Apache::lonpublisher::metadatafields{'courserestricted'}=
                'course.'.$env{'request.course.id'};
        }
        if ((! $Apache::lonpublisher::metadatafields{'courserestricted'}) &&
                (! $env{'form.new_courserestricted'}) && (! $file_type eq 'groups')) {
            $Apache::lonpublisher::metadatafields{'courserestricted'}=
                'none';
        } elsif ($env{'form.new_courserestricted'}) {
            $Apache::lonpublisher::metadatafields{'courserestricted'}=
                $env{'form.new_courserestricted'};
        }
	if ($file_type eq 'portfolio' || $file_type eq 'groups') {
	    if(exists ($env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.fieldlist'})) {
	        # retrieve fieldnames (in order) from the course restricted list
	        @fields = (split(/,/,$env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.fieldlist'}));
	    } else {
	        # no saved field list, use default list
	        @fields =  ('title','author','subject','keywords','abstract',
			    'notes','lowestgradelevel',
	                    'highestgradelevel','standards');
                if ($Apache::lonpublisher::metadatafields{'courserestricted'} =~ /^course\.($match_domain\_$match_courseid)$/) {
                    my $assoc_crs = $1;
	            $added_metadata_fields = &Apache::lonparmset::get_added_meta_fieldnames($assoc_crs);
	            if ($env{'course.'.$assoc_crs.'.metadata.addedorder'}) {
	                @added_order = split(/,/,$env{'course.'.$assoc_crs.'.metadata.addedorder'});
	            }
	            $env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.fieldlist'} = join(",",@fields);
                }
	    }
	} else {
	    @fields = ('title','author','subject','keywords','abstract','notes',
		       'copyright','customdistributionfile','language',
		       'standards',
		       'lowestgradelevel','highestgradelevel','sourceavail','sourcerights',
		       'obsolete','obsoletereplacement');
        }
        if ($courseauthor) {
            $Apache::lonpublisher::metadatafields{'copyright'}='custom';
            $Apache::lonpublisher::metadatafields{'customdistributionfile'}=$crsaurights;
        }
        my (%domdefs,$got_domdefs);
        if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
            my $copyright = 'default';
            if ($env{'environment.copyright'} ne '') {
                $copyright = $env{'environment.copyright'};
            } else {
                my $defdom = $env{'request.role.domain'};
                if ($disuri =~ m{^/priv/($match_domain)/}) {
                    $defdom = $1;
                }
                if ($defdom ne '') {
                    %domdefs = &Apache::lonnet::get_domain_defaults($defdom);
                    $got_domdefs = 1;
                    if ($domdefs{'copyright'} ne '') {
                        $copyright = $domdefs{'copyright'};
                    }
                }
            }
            $Apache::lonpublisher::metadatafields{'copyright'}=
		$copyright;
        }
        if (! $Apache::lonpublisher::metadatafields{'sourceavail'}) {
            my $sourceavail = 'closed';
            if ($env{'environment.sourceavail'} ne '') {
                $sourceavail = $env{'environment.sourceavail'};
            } else {
                my $defdom = $env{'request.role.domain'};
                if ($disuri =~ m{^/priv/($match_domain)/}) {
                    $defdom = $1;
                }
                if ($defdom ne '') {
                    unless ($got_domdefs) {
                        %domdefs = &Apache::lonnet::get_domain_defaults($defdom);
                        $got_domdefs = 1;
                    }
                    if ($domdefs{'sourceavail'} ne '') {
                        $sourceavail = $domdefs{'sourceavail'};
                    }
                }
            }
            $Apache::lonpublisher::metadatafields{'sourceavail'}=
                $sourceavail;
        }
	if (($file_type eq 'portfolio') || ($file_type eq 'groups'))  {
	    if (! $Apache::lonpublisher::metadatafields{'mime'}) {
                ($Apache::lonpublisher::metadatafields{'mime'}) =
		    ( $target=~/\.(\w+)$/ );
	    }
	    if (! $Apache::lonpublisher::metadatafields{'owner'}) {
		$Apache::lonpublisher::metadatafields{'owner'} =
		    $env{'user.name'}.':'.$env{'user.domain'};
	    }
	    if (! $Apache::lonpublisher::metadatafields{'author'}) {
		$Apache::lonpublisher::metadatafields{'author'} =
		    &Apache::loncommon::plainname($env{'user.name'},
						  $env{'user.domain'});
	    }
	    if ($Apache::lonpublisher::metadatafields{'courserestricted'} ne 'none') {

                if ($file_type eq 'portfolio') {
                    $r->print(
                        &mt('Associated with course [_1]'
                           ,'<strong>'
                           .$env{$Apache::lonpublisher::metadatafields{'courserestricted'}
                           .".description"}.'</strong>')
                       .' <a href="'.$uri.'?changecourse=true">'
                       .&mt('Change')
                       .'</a>'.'<br />'
                    );

                } else {
                    $r->print(&mt('Associated with course [_1]',
                        '<strong>'.
  $env{$Apache::lonpublisher::metadatafields{'courserestricted'}.
                        ".description"}.'</strong>').'<br />');
                }
            } else {
                $r->print(
                    &mt('This resource is not associated with a course.')
                  .' <a href="'.$uri.'?changecourse=true">'.&mt('Change').'</a><br />'
                );
            }
        }
	if (@added_order) {
	    foreach my $field_name (@added_order) {
                push(@fields,$field_name);
                $lt{$field_name} = $$added_metadata_fields{$field_name};
	    }
	} else {
            foreach my $field_name (keys(%$added_metadata_fields)) {
                push(@fields,$field_name);
                $lt{$field_name} = $$added_metadata_fields{$field_name};
            }
        }
        $output .= &Apache::lonhtmlcommon::start_pick_box();
        my $last = $#fields + 1;
        my $rowcount = 0;
        foreach my $field_name (@fields) {
            $rowcount++;
            if (defined($env{'form.new_'.$field_name})) {
                my @values = &Apache::loncommon::get_env_multiple('form.new_'.$field_name);
                my $newvalue = '';
                foreach my $item (@values) {
                    if ($item ne '') {
                        $newvalue .= $item.',';
                    }
                }
                $newvalue =~ s/,$//; 
                $Apache::lonpublisher::metadatafields{$field_name}=$newvalue;
            }
            if ($Apache::lonpublisher::metadatafields{'courserestricted'} ne 'none'
		&& exists($env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.'.$field_name.'.options'})) {
                # handle restrictions here
                if ((($env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.'.$field_name.'.options'} =~ m/active/) ||
                    ($field_name eq 'courserestricted'))&&
                    (!($env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/))){
                    
                    $output .= &Apache::lonhtmlcommon::row_title($lt{$field_name})
                              .&prettyinput($field_name,
				   $Apache::lonpublisher::metadatafields{$field_name},
				                    $readonly,'new_'.$field_name,'defaultmeta',
				                    undef,undef,undef,undef,
                                                    $Apache::lonpublisher::metadatafields{'courserestricted'});
                    $output .= &Apache::lonhtmlcommon::row_closure($rowcount == $last?1:0);
                 }
            } else {
                    $output .= &Apache::lonhtmlcommon::row_title($lt{$field_name})
                              .&prettyinput($field_name,
					   $Apache::lonpublisher::metadatafields{$field_name},
                                           $readonly,'new_'.$field_name,'defaultmeta')
                              .&Apache::lonhtmlcommon::row_closure($rowcount == $last?1:0);
               
            }
        }
        $output .= &Apache::lonhtmlcommon::end_pick_box();
	if ($env{'form.store'}) {
            my ($outcome,$result) = &store_metadata($fn,$uri,'store');
            $r->print($result);
	}
        my $savebutton = '<p><input type="submit" name="store"'
                        .' value="'.&mt('Save').'" title="'.&mt('Save Metadata').'" /></p>';
        $r->print($savebutton.$output.$savebutton);

	if ($file_type eq 'portfolio' || $file_type eq 'groups') {
	    my ($port_path,$group) = &get_port_path_and_group($uri);
            if ($group ne '') {
                $r->print('<input type="hidden" name="group" value="'.$group.'" />');
            }
            $r->print('<input type="hidden" name="currentpath" value="'.$env{'form.currentpath'}.'" />');
	    $r->print('</form><br /><br /><form method="post" action="'.$port_path.'">');
	    if ($group ne '') {
	        $r->print('<input type="hidden" name="group" value="'.$group.'" />');
            }
	    $r->print('<input type="hidden" name="currentpath" value="'.$path.'" />'.
		      '<input type="submit" name="cancel" value="'.&mt('Discard Edits and Return to Portfolio').'" />');
	}
    }
    
    $r->print('</form>');

    return;
}

sub store_metadata {
    my ($fn,$uri,$caller) = @_;
    my $mfh;
    my $formname='store';
    my ($file_content,$output,$outcome);
    if (&Apache::loncommon::get_env_multiple('form.new_keywords')) {
        $Apache::lonpublisher::metadatafields{'keywords'} =
            join (',', &Apache::loncommon::get_env_multiple('form.new_keywords'));
            }
    if (($caller eq 'store') && ($env{'request.course.id'})) {
        my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
        my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
        if ($uri =~ m{^\Q/priv/$cdom/$cnum/\E}) {
            unless ($uri eq "/priv/$cdom/$cnum/default.rights.meta") {
                $Apache::lonpublisher::metadatafields{'copyright'} = 'custom';
                $Apache::lonpublisher::metadatafields{'customdistributionfile'} =
                    "/res/$cdom/$cnum/default.rights";
            }
        }
    }
    foreach my $field (sort(keys(%Apache::lonpublisher::metadatafields))) {
        next if ($field =~ /\./);
        my $unikey=$field;
        $unikey=~/^([A-Za-z_]+)/;
        my $tag=$1;
        $tag=~tr/A-Z/a-z/;
        $file_content.= "\n\<$tag";
        foreach my $key (split(/\,/,$Apache::lonpublisher::metadatakeys{$unikey})) {
            my $value = $Apache::lonpublisher::metadatafields{$unikey.'.'.$key};
            $value=~s/\"/\'\'/g;
            $file_content.=' '.$key.'="'.$value.'"' ;
        }
        $file_content.= '>'.
            &HTML::Entities::encode
                ($Apache::lonpublisher::metadatafields{$unikey},'<>&"').
                '</'.$tag.'>';
    }
    if ($fn =~ m|^$Apache::lonnet::perlvar{'lonDocRoot'}/userfiles|) {
        my ($path, $new_fn);
        if ($fn =~ m|$match_name/groups/\w+/portfolio/|) {
            ($path, $new_fn) = ($fn =~ m|/(groups/\w+/portfolio.*)/([^/]*)$|);
        } else {
            ($path, $new_fn) = ($fn =~ m|/(portfolio.*)/([^/]*)$|);
        }
        ($outcome,my $result) = 
            &store_portfolio_metadata($formname,$file_content,
                                      $path,$new_fn,$uri,$caller);
        $output .= $result;
    } else {
        if (! ($mfh=Apache::File->new('>'.$fn))) {
            $output .= '<p class="LC_error">';
            if ($caller eq 'transfer') {
                $output .= &mt('Could not transfer data in added fields to notes');
            } else { 
                $output .= &mt('Could not write metadata');
            }
            $output .= ', '.&mt('FAIL').'</p>';
            $outcome = 'fail';
        } else {
            print $mfh ($file_content);
            close($mfh);
            &update_metadata_table($uri);
            my $confirmtext;
            if ($caller eq 'transfer') {
                $confirmtext = &mt('Transferred data in added fields to notes');
            } else {
                $confirmtext = &mt('Wrote Metadata');
            }
            $output .= &Apache::loncommon::confirmwrapper(
                           &Apache::lonhtmlcommon::confirm_success(
                               $confirmtext.' '.&Apache::lonlocal::locallocaltime(time)));
            $outcome = 'ok';
        }
    }
    return ($outcome,$output);
}

sub store_transferred_addedfields {
    my ($fn,$uri,$transfers) = @_;
    foreach my $item (@{$transfers}) {
        $Apache::lonpublisher::metadatafields{'notes'} .= 
           ' '.$item.' = '.$Apache::lonpublisher::metadatafields{$item};
    }
    my ($outcome,$output) = &store_metadata($fn,$uri,'transfer');
    if ($outcome eq 'ok') {
        foreach my $item (@{$transfers}) {
            delete($Apache::lonpublisher::metadatafields{$item});
        }
    }
}

sub store_portfolio_metadata {
    my ($formname,$content,$path,$new_fn,$uri,$caller) = @_;
    my ($outcome,$output);
    $env{'form.'.$formname}=$content."\n";
    $env{'form.'.$formname.'.filename'}=$new_fn;
    my $result =&Apache::lonnet::userfileupload($formname,'',$path);
    if ($result =~ /(error|notfound)/) {
        $output = '<p class="LC_error">';
        if ($caller eq 'transfer') {
            $output .= 
                &mt('Could not transfer data in added fields to notes'); 
        } else {
            $output .= &mt('Could not write metadata');
        }
        $output .= ', '.&mt('FAIL').'</p>';
        $outcome = 'fail';
    } else {
        &update_metadata_table($uri);
        $output = '<p class="LC_success">';
        if ($caller eq 'transfer') {
            $output .= &mt('Transferred data in added fields to notes');
        } else {
            $output .= &mt('Wrote Metadata');
        }
        $output .= ' '.&Apache::lonlocal::locallocaltime(time).
                   '</p>';
        $outcome = 'ok';
    }
    return ($outcome,$output);
}

sub update_metadata_table {
    my ($uri) = @_;
    my ($type,$udom,$uname,$file_name,$group) =
	&Apache::lonnet::parse_portfolio_url($uri);
    $file_name =~ s/\.meta$//;
    my $current_permissions =
        &Apache::lonnet::get_portfile_permissions($udom,$uname);
    my %access_controls =
        &Apache::lonnet::get_access_controls($current_permissions,$group,
                                             $file_name);
    my $access_hash = $access_controls{$file_name};
    my $available = 0;
    if (ref($access_hash) eq 'HASH') {
        foreach my $key (keys(%{$access_hash})) {
            my ($num,$scope,$end,$start) =
                ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
            if ($scope eq 'public' || $scope eq 'guest') {
                $available = 1;
                last;
            }
        }
    }
    if ($available) {
        my $result =
            &Apache::lonnet::update_portfolio_table($uname,$udom,
            $file_name,'portfolio_metadata',$group,'update');
    }
}


1;
__END__


=head1 NAME

Apache::lonmeta - display meta data

=head1 SYNOPSIS

Handler to display meta data

This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.

=head1 SUBROUTINES

=over

=item &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}

=item dynamicmeta()

Fetch and evaluate dynamic metadata

=item access_count()

=item alttag()

Try to make an alt tag if there is none

=item authordisplay()

Author display

=item evalgraph()

Pretty display

=item diffgraph()

=item fieldnames()

=item portfolio_linked_path()

=item get_port_path_and_group()

=item portfolio_display_uri()

=item pre_select_course()

=item select_course()

=item prettyprint()

Pretty printing of metadata field

=item direct()

Pretty input of metadata field

=item selectbox()

=item relatedfield()

=item prettyinput()

=item report_bombs()

=item present_uneditable_metadata()

=item present_editable_metadata()

=item store_metadata()

=item store_transferred_addedfields()

=item store_portfolio_metadata()

=item update_metadata_table()

=back

=cut

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