Annotation of loncom/interface/lonmeta.pm, revision 1.213

1.1       www         1: # The LearningOnline Network with CAPA
1.8       albertel    2: # Metadata display handler
                      3: #
1.213   ! jms         4: # $Id: lonmeta.pm,v 1.212 2008/03/06 20:20:18 www Exp $
1.8       albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
1.1       www        14: #
1.8       albertel   15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
1.100     banghart   20: # You should have received a copy of the GNU General Public License 
1.8       albertel   21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
1.44      www        27: 
1.1       www        28: 
1.213   ! jms        29: =head1 NAME
        !            30: 
        !            31: Apache::lonmeta - display meta data
        !            32: 
        !            33: =head1 SYNOPSIS
        !            34: 
        !            35: Handler to display meta data
        !            36: 
        !            37: This is part of the LearningOnline Network with CAPA project
        !            38: described at http://www.lon-capa.org.
        !            39: 
        !            40: =head1 HANDLER SUBROUTINE
        !            41: 
        !            42: handler()
        !            43: 
        !            44: =head1 OTHER SUBROUTINES
        !            45: 
        !            46: =over
        !            47: 
        !            48: =item *
        !            49: 
        !            50: &get_dynamic_metadata_from_sql($url) :
        !            51: 
        !            52: Queries sql database for dynamic metdata
        !            53: Returns a hash of hashes, with keys of urls which match $url
        !            54: Returned fields are given below.
        !            55: 
        !            56: Examples:
        !            57: 
        !            58:     %DynamicMetadata = &Apache::lonmeta::get_dynmaic_metadata_from_sql
        !            59:     ('/res/msu/korte/');
        !            60: 
        !            61:     $DynamicMetadata{'/res/msu/korte/example.problem'}->{$field}
        !            62: 
        !            63: =item *
        !            64: 
        !            65: dynamicmeta() : Fetch and evaluate dynamic metadata
        !            66: 
        !            67: =item *
        !            68: 
        !            69: access_count()
        !            70: 
        !            71: =item *
        !            72: 
        !            73: alttag() : Try to make an alt tag if there is none
        !            74: 
        !            75: =item *
        !            76: 
        !            77: authordisplay() : Author display
        !            78: 
        !            79: =item *
        !            80: 
        !            81: evalgraph() : Pretty display
        !            82: 
        !            83: =item *
        !            84: 
        !            85: diffgraph()
        !            86: 
        !            87: =item *
        !            88: 
        !            89: fieldnames()
        !            90: 
        !            91: =item *
        !            92: 
        !            93: portfolio_linked_path()
        !            94: 
        !            95: =item *
        !            96: 
        !            97: get_port_path_and_group()
        !            98: 
        !            99: =item *
        !           100: 
        !           101: portfolio_display_uri()
        !           102: 
        !           103: =item *
        !           104: 
        !           105: pre_select_course()
        !           106: 
        !           107: =item *
        !           108: 
        !           109: select_course()
        !           110: 
        !           111: =item *
        !           112: 
        !           113: prettyprint() : Pretty printing of metadata field
        !           114: 
        !           115: =item *
        !           116: 
        !           117: direct() : Pretty input of metadata field
        !           118: 
        !           119: =item *
        !           120: 
        !           121: selectbox()
        !           122: 
        !           123: =item *
        !           124: 
        !           125: relatedfield()
        !           126: 
        !           127: =item *
        !           128: 
        !           129: prettyinput()
        !           130: 
        !           131: =item *
        !           132: 
        !           133: report_bombs()
        !           134: 
        !           135: =item *
        !           136: 
        !           137: present_uneditable_metadata()
        !           138: 
        !           139: =item *
        !           140: 
        !           141: present_editable_metadata()
        !           142: 
        !           143: =item *
        !           144: 
        !           145: store_metadata()
        !           146: 
        !           147: =item *
        !           148: 
        !           149: store_transferred_addedfields()
        !           150: 
        !           151: =item *
        !           152: 
        !           153: store_portfolio_metadata()
        !           154: 
        !           155: =item *
        !           156: 
        !           157: update_metadata_table()
        !           158: 
        !           159: =back
        !           160: 
        !           161: =cut
        !           162: 
        !           163: 
1.1       www       164: package Apache::lonmeta;
                    165: 
                    166: use strict;
1.63      matthew   167: use LONCAPA::lonmetadata();
1.1       www       168: use Apache::Constants qw(:common);
1.96      albertel  169: use Apache::lonnet;
1.10      www       170: use Apache::loncommon();
1.100     banghart  171: use Apache::lonhtmlcommon(); 
1.23      www       172: use Apache::lonmsg;
                    173: use Apache::lonpublisher;
1.35      www       174: use Apache::lonlocal;
1.43      www       175: use Apache::lonmysql;
1.49      www       176: use Apache::lonmsg;
1.190     albertel  177: use LONCAPA qw(:DEFAULT :match);
1.1       www       178: 
1.44      www       179: 
1.80      matthew   180: sub get_dynamic_metadata_from_sql {
                    181:     my ($url) = shift();
1.190     albertel  182:     my ($authordom,$author)=($url=~m{^/res/($match_domain)/($match_username)/});
1.80      matthew   183:     if (! defined($authordom)) {
                    184:         $authordom = shift();
                    185:     }
                    186:     if  (! defined($author)) { 
                    187:         $author = shift();
                    188:     }
                    189:     if (! defined($authordom) || ! defined($author)) {
                    190:         return ();
                    191:     }
1.158     www       192:     my $query = 'SELECT * FROM metadata WHERE url LIKE "'.$url.'%"';
1.80      matthew   193:     my $server = &Apache::lonnet::homeserver($author,$authordom);
                    194:     my $reply = &Apache::lonnet::metadata_query($query,undef,undef,
                    195:                                                 ,[$server]);
                    196:     return () if (! defined($reply) || ref($reply) ne 'HASH');
                    197:     my $filename = $reply->{$server};
                    198:     if (! defined($filename) || $filename =~ /^error/) {
                    199:         return ();
                    200:     }
                    201:     my $max_time = time + 10; # wait 10 seconds for results at most
                    202:     my %ReturnHash;
                    203:     #
                    204:     # Look for results
                    205:     my $finished = 0;
                    206:     while (! $finished && time < $max_time) {
                    207:         my $datafile=$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename;
                    208:         if (! -e "$datafile.end") { next; }
                    209:         my $fh;
                    210:         if (!($fh=Apache::File->new($datafile))) { next; }
                    211:         while (my $result = <$fh>) {
                    212:             chomp($result);
                    213:             next if (! $result);
1.180     albertel  214:             my %hash=&LONCAPA::lonmetadata::metadata_col_to_hash('metadata',
                    215: 								 map { &unescape($_) } split(/\,/,$result));
1.158     www       216:             foreach my $key (keys(%hash)) {
                    217:                 $ReturnHash{$hash{'url'}}->{$key}=$hash{$key};
1.80      matthew   218:             }
                    219:         }
                    220:         $finished = 1;
                    221:     }
                    222:     #
                    223:     return %ReturnHash;
                    224: }
                    225: 
                    226: 
1.64      matthew   227: # Fetch and evaluate dynamic metadata
1.9       www       228: sub dynamicmeta {
                    229:     my $url=&Apache::lonnet::declutter(shift);
                    230:     $url=~s/\.meta$//;
1.190     albertel  231:     my ($adomain,$aauthor)=($url=~/^($match_domain)\/($match_username)\//);
1.19      www       232:     my $regexp=$url;
1.9       www       233:     $regexp=~s/(\W)/\\$1/g;
1.10      www       234:     $regexp='___'.$regexp.'___';
1.16      albertel  235:     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
                    236: 				       $aauthor,$regexp);
1.63      matthew   237:     my %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
                    238:     my %Data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,
                    239:                                                                \%DynamicData);
1.40      matthew   240:     #
1.46      www       241:     # Deal with 'count' separately
1.63      matthew   242:     $Data{'count'} = &access_count($url,$aauthor,$adomain);
1.67      matthew   243:     #
                    244:     # Debugging code I will probably need later
                    245:     if (0) {
                    246:         &Apache::lonnet::logthis('Dynamic Metadata');
                    247:         while(my($k,$v)=each(%Data)){
                    248:             &Apache::lonnet::logthis('    "'.$k.'"=>"'.$v.'"');
                    249:         }
                    250:         &Apache::lonnet::logthis('-------------------');
                    251:     }
1.63      matthew   252:     return %Data;
1.40      matthew   253: }
                    254: 
                    255: sub access_count {
                    256:     my ($src,$author,$adomain) = @_;
                    257:     my %countdata=&Apache::lonnet::dump('nohist_accesscount',$adomain,
                    258:                                         $author,$src);
                    259:     if (! exists($countdata{$src})) {
1.47      www       260:         return &mt('Not Available');
1.40      matthew   261:     } else {
                    262:         return $countdata{$src};
                    263:     }
1.25      www       264: }
                    265: 
1.64      matthew   266: # Try to make an alt tag if there is none
1.25      www       267: sub alttag {
1.26      www       268:     my ($base,$src)=@_;
                    269:     my $fullpath=&Apache::lonnet::hreflocation($base,$src);
                    270:     my $alttag=&Apache::lonnet::metadata($fullpath,'title').' '.
1.64      matthew   271:         &Apache::lonnet::metadata($fullpath,'subject').' '.
                    272:         &Apache::lonnet::metadata($fullpath,'abstract');
1.26      www       273:     $alttag=~s/\s+/ /gs;
                    274:     $alttag=~s/\"//gs;
                    275:     $alttag=~s/\'//gs;
                    276:     $alttag=~s/\s+$//gs;
                    277:     $alttag=~s/^\s+//gs;
1.64      matthew   278:     if ($alttag) { 
                    279:         return $alttag; 
                    280:     } else { 
                    281:         return &mt('No information available'); 
                    282:     }
1.9       www       283: }
1.1       www       284: 
1.64      matthew   285: # Author display
1.29      www       286: sub authordisplay {
                    287:     my ($aname,$adom)=@_;
1.64      matthew   288:     return &Apache::loncommon::aboutmewrapper
                    289:         (&Apache::loncommon::plainname($aname,$adom),
1.164     albertel  290:          $aname,$adom,'preview').' <tt>['.$aname.':'.$adom.']</tt>';
1.29      www       291: }
                    292: 
1.64      matthew   293: # Pretty display
1.12      www       294: sub evalgraph {
                    295:     my $value=shift;
1.65      matthew   296:     if (! $value) { 
                    297:         return '';
                    298:     }
1.12      www       299:     my $val=int($value*10.+0.5)-10;
1.71      matthew   300:     my $output='<table border="0" cellpadding="0" cellspacing="0"><tr>';
1.12      www       301:     if ($val>=20) {
1.71      matthew   302: 	$output.='<td width="20" bgcolor="#555555">&nbsp&nbsp;</td>';
1.12      www       303:     } else {
1.71      matthew   304:         $output.='<td width="'.($val).'" bgcolor="#555555">&nbsp;</td>'.
                    305:                  '<td width="'.(20-$val).'" bgcolor="#FF3333">&nbsp;</td>';
1.12      www       306:     }
                    307:     $output.='<td bgcolor="#FFFF33">&nbsp;</td>';
                    308:     if ($val>20) {
1.71      matthew   309: 	$output.='<td width="'.($val-20).'" bgcolor="#33FF33">&nbsp;</td>'.
                    310:                  '<td width="'.(40-$val).'" bgcolor="#555555">&nbsp;</td>';
1.12      www       311:     } else {
1.71      matthew   312:         $output.='<td width="20" bgcolor="#555555">&nbsp&nbsp;</td>';
1.12      www       313:     }
1.71      matthew   314:     $output.='<td> ('.sprintf("%5.2f",$value).') </td></tr></table>';
1.12      www       315:     return $output;
                    316: }
                    317: 
                    318: sub diffgraph {
                    319:     my $value=shift;
1.65      matthew   320:     if (! $value) { 
                    321:         return '';
                    322:     }
1.12      www       323:     my $val=int(40.0*$value+0.5);
1.13      www       324:     my @colors=('#FF9933','#EEAA33','#DDBB33','#CCCC33',
                    325:                 '#BBDD33','#CCCC33','#DDBB33','#EEAA33');
1.71      matthew   326:     my $output='<table border="0" cellpadding="0" cellspacing="0"><tr>';
1.12      www       327:     for (my $i=0;$i<8;$i++) {
                    328: 	if ($val>$i*5) {
1.71      matthew   329:             $output.='<td width="5" bgcolor="'.$colors[$i].'">&nbsp;</td>';
1.12      www       330:         } else {
1.71      matthew   331: 	    $output.='<td width="5" bgcolor="#555555">&nbsp;</td>';
1.12      www       332: 	}
                    333:     }
1.71      matthew   334:     $output.='<td> ('.sprintf("%3.2f",$value).') </td></tr></table>';
1.12      www       335:     return $output;
                    336: }
                    337: 
1.44      www       338: 
1.64      matthew   339: # The field names
1.45      www       340: sub fieldnames {
1.90      banghart  341:     my $file_type=shift;
1.115     banghart  342:     my %fields = 
                    343:         ('title' => 'Title',
1.113     banghart  344:          'author' =>'Author(s)',
1.131     albertel  345:          'authorspace' => 'Author Space',
                    346:          'modifyinguser' => 'Last Modifying User',
1.113     banghart  347:          'subject' => 'Subject',
1.133     banghart  348:          'standards' => 'Standards',
1.113     banghart  349:          'keywords' => 'Keyword(s)',
                    350:          'notes' => 'Notes',
                    351:          'abstract' => 'Abstract',
                    352:          'lowestgradelevel' => 'Lowest Grade Level',
1.149     albertel  353:          'highestgradelevel' => 'Highest Grade Level');
                    354:     
1.191     raeburn   355:     if ( !defined($file_type) || ($file_type ne 'portfolio' && $file_type ne 'groups') ) {
1.149     albertel  356:         %fields = 
1.93      matthew   357:         (%fields,
                    358:          'domain' => 'Domain',
1.64      matthew   359:          'mime' => 'MIME Type',
                    360:          'language' => 'Language',
                    361:          'creationdate' => 'Creation Date',
                    362:          'lastrevisiondate' => 'Last Revision Date',
                    363:          'owner' => 'Publisher/Owner',
                    364:          'copyright' => 'Copyright/Distribution',
                    365:          'customdistributionfile' => 'Custom Distribution File',
1.84      banghart  366:          'sourceavail' => 'Source Available',
1.78      taceyjo1  367:          'sourcerights' => 'Source Custom Distribution File',
1.64      matthew   368:          'obsolete' => 'Obsolete',
                    369:          'obsoletereplacement' => 'Suggested Replacement for Obsolete File',
                    370:          'count'      => 'Network-wide number of accesses (hits)',
                    371:          'course'     => 'Network-wide number of courses using resource',
                    372:          'course_list' => 'Network-wide courses using resource',
                    373:          'sequsage'      => 'Number of resources using or importing resource',
                    374:          'sequsage_list' => 'Resources using or importing resource',
                    375:          'goto'       => 'Number of resources that follow this resource in maps',
                    376:          'goto_list'  => 'Resources that follow this resource in maps',
                    377:          'comefrom'   => 'Number of resources that lead up to this resource in maps',
                    378:          'comefrom_list' => 'Resources that lead up to this resource in maps',
                    379:          'clear'      => 'Material presented in clear way',
                    380:          'depth'      => 'Material covered with sufficient depth',
                    381:          'helpful'    => 'Material is helpful',
                    382:          'correct'    => 'Material appears to be correct',
                    383:          'technical'  => 'Resource is technically correct', 
                    384:          'avetries'   => 'Average number of tries till solved',
1.205     www       385:          'stdno'      => 'Statistics calculated for number of students',
1.73      matthew   386:          'difficulty' => 'Degree of difficulty',
                    387:          'disc'       => 'Degree of discrimination',
1.133     banghart  388: 	     'dependencies' => 'Resources used by this resource',
1.64      matthew   389:          );
1.93      matthew   390:     }
                    391:     return &Apache::lonlocal::texthash(%fields);
1.45      www       392: }
1.141     albertel  393: 
1.146     albertel  394: sub portfolio_linked_path {
1.155     albertel  395:     my ($path,$group,$port_path) = @_;
                    396: 
                    397:     my $start = 'portfolio';
                    398:     if ($group) {
                    399: 	$start = "groups/$group/".$start;
                    400:     }
1.166     banghart  401:     my %anchor_fields = (
1.165     banghart  402:         'selectfile'  => $start,
                    403:         'currentpath' => '/'
                    404:     );
                    405:     my $result = &Apache::portfolio::make_anchor($port_path,\%anchor_fields,$start);
1.146     albertel  406:     my $fullpath = '/';
                    407:     my (undef,@tree) = split('/',$path);
1.147     albertel  408:     my $filename = pop(@tree);
1.146     albertel  409:     foreach my $dir (@tree) {
                    410: 	$fullpath .= $dir.'/';
                    411: 	$result .= '/';
1.166     banghart  412: 	my %anchor_fields = (
1.165     banghart  413:             'selectfile'  => $dir,
                    414:             'currentpath' => $fullpath
                    415:         );
                    416: 	$result .= &Apache::portfolio::make_anchor($port_path,\%anchor_fields,$dir);
1.146     albertel  417:     }
1.147     albertel  418:     $result .= "/$filename";
1.146     albertel  419:     return $result;
                    420: }
                    421: 
1.156     albertel  422: sub get_port_path_and_group {
                    423:     my ($uri)=@_;
                    424: 
1.155     albertel  425:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    426:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.156     albertel  427: 
1.155     albertel  428:     my ($port_path,$group);
                    429:     if ($uri =~ m{^/editupload/\Q$cdom\E/\Q$cnum\E/groups/}) {
                    430: 	$group = (split('/',$uri))[5];
                    431: 	$port_path = '/adm/coursegrp_portfolio';
                    432:     } else {
                    433: 	$port_path = '/adm/portfolio';
                    434:     }
1.160     albertel  435:     if ($env{'form.group'} ne $group) {
1.161     albertel  436: 	$env{'form.group'} = $group;
1.160     albertel  437:     }
1.156     albertel  438:     return ($port_path,$group);
                    439: }
                    440: 
                    441: sub portfolio_display_uri {
                    442:     my ($uri,$as_links)=@_;
                    443: 
                    444:     my ($port_path,$group) = &get_port_path_and_group($uri);
                    445: 
1.144     albertel  446:     $uri =~ s|.*/(portfolio/.*)$|$1|;
1.141     albertel  447:     my ($res_uri,$meta_uri) = ($uri,$uri);
                    448:     if ($uri =~ /\.meta$/) {
                    449: 	$res_uri =~ s/\.meta//;
                    450:     } else {
                    451: 	$meta_uri .= '.meta';
                    452:     }
1.146     albertel  453: 
1.148     albertel  454:     my ($path) = ($res_uri =~ m|^portfolio(.*/)[^/]*$|);
1.146     albertel  455:     if ($as_links) {
1.155     albertel  456: 	$res_uri = &portfolio_linked_path($res_uri,$group,$port_path);
                    457: 	$meta_uri = &portfolio_linked_path($meta_uri,$group,$port_path);
1.146     albertel  458:     }
1.145     albertel  459:     return ($res_uri,$meta_uri,$path);
1.141     albertel  460: }
                    461: 
1.140     banghart  462: sub pre_select_course {
                    463:     my ($r,$uri) = @_;
                    464:     my $output;
                    465:     my $fn=&Apache::lonnet::filelocation('',$uri);
1.145     albertel  466:     my ($res_uri,$meta_uri,$path) = &portfolio_display_uri($uri);
1.140     banghart  467:     %Apache::lonpublisher::metadatafields=();
                    468:     %Apache::lonpublisher::metadatakeys=();
                    469:     my $result=&Apache::lonnet::getfile($fn);
                    470:     if ($result == -1){
1.141     albertel  471:         $r->print(&mt('Creating new file [_1]'),$meta_uri);
1.140     banghart  472:     } else {
                    473:         &Apache::lonpublisher::metaeval($result);
                    474:     }
1.141     albertel  475:     $r->print('<hr /><form method="post" action="" >');
                    476:     $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>');
1.140     banghart  477:     $output = &select_course();
                    478:     $r->print($output.'<br /><input type="submit" name="store" value="'.
1.167     banghart  479:                   &mt('Associate Resource With Selected Course').'" />');
1.169     banghart  480:     $r->print('<input type="hidden" name="currentpath" value="'.$env{'form.currentpath'}.'" />');
                    481:     $r->print('<input type="hidden" name="associate" value="true" />');
1.140     banghart  482:     $r->print('</form>');
1.145     albertel  483:     
1.156     albertel  484:     my ($port_path,$group) = &get_port_path_and_group($uri);
1.167     banghart  485:     my $group_input;
                    486:     if ($group) {
1.168     banghart  487:         $group_input = '<input type="hidden" name="group" value="'.$group.'" />';
                    488:     } 
1.167     banghart  489:     $r->print('<br /><br /><form method="post" action="'.$port_path.'">'.
1.145     albertel  490:               '<input type="hidden" name="currentpath" value="'.$path.'" />'.
1.167     banghart  491: 	      $group_input.
                    492: 	      '<input type="submit" name="cancel" value="'.&mt('Cancel').'" />'.
1.145     albertel  493: 	      '</form>');
                    494: 
1.140     banghart  495:     return;
                    496: }
1.100     banghart  497: sub select_course {
1.150     albertel  498:     my $output=$/;
                    499:     my $current_restriction=
                    500: 	$Apache::lonpublisher::metadatafields{'courserestricted'};
                    501:     my $selected = ($current_restriction eq 'none' ? 'selected="selected"' 
                    502: 		                                   : '');
1.200     raeburn   503:     if ($current_restriction =~ /^course\.($match_domain\_$match_courseid)$/) {
                    504:         my $assoc_crs = $1;
                    505:         my $added_metadata_fields = &Apache::lonparmset::get_added_meta_fieldnames($assoc_crs);
                    506:         if (ref($added_metadata_fields) eq 'HASH') {
                    507:             if (keys(%{$added_metadata_fields}) > 0) {
                    508:                 my $transfernotes;
                    509:                 foreach my $field_name (keys(%{$added_metadata_fields})) {
                    510:                     my $value = $Apache::lonpublisher::metadatafields{$field_name};
                    511:                     if ($value) {
                    512:                         $transfernotes .= 
                    513:                             &Apache::loncommon::start_data_table_row(). 
                    514:                             '<td><input type="checkbox" name="transfer_'.
                    515:                             $field_name.'" value="1" /></td><td>'.
                    516:                             $field_name.'</td><td>'.$value.'</td>'.
                    517:                             &Apache::loncommon::end_data_table_row();
                    518:                     }
                    519:                 }
                    520:                 if ($transfernotes ne '') {
                    521:                     my %courseinfo = &Apache::lonnet::coursedescription($assoc_crs,{'one_time' => 1});
                    522:                     my $assoc_crs_description = $courseinfo{'description'};
                    523:                     $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".
                    524:                     &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 />'.
                    525:                     &Apache::loncommon::start_data_table().
                    526:                     &Apache::loncommon::start_data_table_header_row().
                    527:                     '<th>Copy to notes?</th>'."\n".
                    528:                     '<th>Field name</th>'."\n".
                    529:                     '<th>Values</th>'."\n".
                    530:                     &Apache::loncommon::end_data_table_header_row().
                    531:                     $transfernotes.
                    532:                     &Apache::loncommon::end_data_table().'<br />';
                    533:                 }
                    534:             }
                    535:         }
                    536:     }
1.150     albertel  537:     $output .= '<select name="new_courserestricted" >';
                    538:     $output .= '<option value="none" '.$selected.'>'.
                    539: 	&mt('None').'</option>'.$/;
1.113     banghart  540:     my %courses;
1.150     albertel  541:     foreach my $key (keys(%env)) {
                    542:         if ($key !~ m/^course\.(.+)\.description$/) { next; }
                    543: 	my $cid = $1;
                    544:         if ($env{$key} !~ /\S/) { next; }
                    545: 	$courses{$key} = $cid;
                    546:     }
                    547:     foreach my $key (sort { lc($env{$a}) cmp lc($env{$b}) } (keys(%courses))) {
                    548: 	my $cid = 'course.'.$courses{$key};
                    549: 	my $selected = ($current_restriction eq $cid ? 'selected="selected"' 
                    550: 		                                     : '');
                    551:         if ($env{$key} !~ /\S/) { next; }
                    552: 	$output .= '<option value="'.$cid.'" '.$selected.'>';
                    553: 	$output .= $env{$key};
                    554: 	$output .= '</option>'.$/;
                    555: 	$selected = '';
1.100     banghart  556:     }
1.138     banghart  557:     $output .= '</select><br />';
1.137     banghart  558:     return ($output);
1.100     banghart  559: }
1.64      matthew   560: # Pretty printing of metadata field
1.46      www       561: 
                    562: sub prettyprint {
1.82      www       563:     my ($type,$value,$target,$prefix,$form,$noformat)=@_;
                    564: # $target,$prefix,$form are optional and for filecrumbs only
1.65      matthew   565:     if (! defined($value)) { 
                    566:         return '&nbsp;'; 
                    567:     }
1.64      matthew   568:     # Title
1.46      www       569:     if ($type eq 'title') {
                    570: 	return '<font size="+1" face="arial">'.$value.'</font>';
                    571:     }
1.64      matthew   572:     # Dates
1.46      www       573:     if (($type eq 'creationdate') ||
                    574: 	($type eq 'lastrevisiondate')) {
1.55      www       575: 	return ($value?&Apache::lonlocal::locallocaltime(
                    576: 			  &Apache::lonmysql::unsqltime($value)):
                    577: 		&mt('not available'));
1.46      www       578:     }
1.64      matthew   579:     # Language
1.46      www       580:     if ($type eq 'language') {
                    581: 	return &Apache::loncommon::languagedescription($value);
                    582:     }
1.64      matthew   583:     # Copyright
1.46      www       584:     if ($type eq 'copyright') {
                    585: 	return &Apache::loncommon::copyrightdescription($value);
                    586:     }
1.78      taceyjo1  587:     # Copyright
                    588:     if ($type eq 'sourceavail') {
                    589: 	return &Apache::loncommon::source_copyrightdescription($value);
                    590:     }
1.64      matthew   591:     # MIME
1.46      www       592:     if ($type eq 'mime') {
1.64      matthew   593:         return '<img src="'.&Apache::loncommon::icon($value).'" />&nbsp;'.
                    594:             &Apache::loncommon::filedescription($value);
                    595:     }
                    596:     # Person
1.46      www       597:     if (($type eq 'author') || 
                    598: 	($type eq 'owner') ||
                    599: 	($type eq 'modifyinguser') ||
                    600: 	($type eq 'authorspace')) {
1.190     albertel  601: 	$value=~s/($match_username)(\:|\@)($match_domain)/&authordisplay($1,$3)/gse;
1.46      www       602: 	return $value;
                    603:     }
1.64      matthew   604:     # Gradelevel
1.48      www       605:     if (($type eq 'lowestgradelevel') ||
                    606: 	($type eq 'highestgradelevel')) {
                    607: 	return &Apache::loncommon::gradeleveldescription($value);
                    608:     }
1.64      matthew   609:     # Only for advance users below
1.96      albertel  610:     if (! $env{'user.adv'}) { 
1.65      matthew   611:         return '<i>- '.&mt('not displayed').' -</i>';
                    612:     }
1.64      matthew   613:     # File
1.46      www       614:     if (($type eq 'customdistributionfile') ||
                    615: 	($type eq 'obsoletereplacement') ||
                    616: 	($type eq 'goto_list') ||
                    617: 	($type eq 'comefrom_list') ||
1.82      www       618: 	($type eq 'sequsage_list') ||
1.83      www       619: 	($type eq 'dependencies')) {
1.151     www       620: 	return '<font size="-1"><ul>'.join("\n",map {
1.183     albertel  621:             my $url = &Apache::lonnet::clutter_with_no_wrapper($_);
1.72      matthew   622:             my $title = &Apache::lonnet::gettitle($url);
                    623:             if ($title eq '') {
                    624:                 $title = 'Untitled';
                    625:                 if ($url =~ /\.sequence$/) {
                    626:                     $title .= ' Sequence';
                    627:                 } elsif ($url =~ /\.page$/) {
                    628:                     $title .= ' Page';
                    629:                 } elsif ($url =~ /\.problem$/) {
                    630:                     $title .= ' Problem';
                    631:                 } elsif ($url =~ /\.html$/) {
                    632:                     $title .= ' HTML document';
                    633:                 } elsif ($url =~ m:/syllabus$:) {
                    634:                     $title .= ' Syllabus';
                    635:                 } 
                    636:             }
1.82      www       637:             $_ = '<li>'.$title.' '.
                    638: 		&Apache::lonhtmlcommon::crumbs($url,$target,$prefix,$form,'-1',$noformat).
                    639:                 '</li>'
                    640: 	    } split(/\s*\,\s*/,$value)).'</ul></font>';
1.46      www       641:     }
1.64      matthew   642:     # Evaluations
1.46      www       643:     if (($type eq 'clear') ||
                    644: 	($type eq 'depth') ||
                    645: 	($type eq 'helpful') ||
                    646: 	($type eq 'correct') ||
                    647: 	($type eq 'technical')) {
                    648: 	return &evalgraph($value);
                    649:     }
1.64      matthew   650:     # Difficulty
1.73      matthew   651:     if ($type eq 'difficulty' || $type eq 'disc') {
1.46      www       652: 	return &diffgraph($value);
                    653:     }
1.64      matthew   654:     # List of courses
1.46      www       655:     if ($type=~/\_list/) {
1.72      matthew   656:         my @Courses = split(/\s*\,\s*/,$value);
1.151     www       657:         my $Str='<font size="-1"><ul>';
1.180     albertel  658: 	my %descriptions;
1.72      matthew   659:         foreach my $course (@Courses) {
1.154     albertel  660:             my %courseinfo =
                    661: 		&Apache::lonnet::coursedescription($course,
                    662: 						   {'one_time' => 1});
1.72      matthew   663:             if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
                    664:                 next;
                    665:             }
1.180     albertel  666: 	    $descriptions{join('\0',@courseinfo{'domain','description'})} .= 
                    667: 		'<li><a href="/public/'.$courseinfo{'domain'}.'/'.
1.72      matthew   668:                 $courseinfo{'num'}.'/syllabus" target="preview">'.
1.180     albertel  669:                 $courseinfo{'description'}.' ('.$courseinfo{'domain'}.
                    670: 		')</a></li>';
1.72      matthew   671:         }
1.180     albertel  672: 	foreach my $course (sort {lc($a) cmp lc($b)} (keys(%descriptions))) {
                    673: 	    $Str .= $descriptions{$course};
                    674: 	}
                    675: 
1.151     www       676: 	return $Str.'</ul></font>';
1.46      www       677:     }
1.64      matthew   678:     # No pretty print found
1.46      www       679:     return $value;
                    680: }
                    681: 
1.64      matthew   682: # Pretty input of metadata field
1.54      www       683: sub direct {
                    684:     return shift;
                    685: }
                    686: 
1.48      www       687: sub selectbox {
                    688:     my ($name,$value,$functionref,@idlist)=@_;
1.65      matthew   689:     if (! defined($functionref)) {
                    690:         $functionref=\&direct;
                    691:     }
1.48      www       692:     my $selout='<select name="'.$name.'">';
                    693:     foreach (@idlist) {
                    694:         $selout.='<option value=\''.$_.'\'';
                    695:         if ($_ eq $value) {
                    696: 	    $selout.=' selected>'.&{$functionref}($_).'</option>';
                    697: 	}
                    698:         else {$selout.='>'.&{$functionref}($_).'</option>';}
                    699:     }
                    700:     return $selout.'</select>';
                    701: }
                    702: 
1.54      www       703: sub relatedfield {
                    704:     my ($show,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue)=@_;
1.65      matthew   705:     if (! $relatedsearchflag) { 
                    706:         return '';
                    707:     }
                    708:     if (! defined($relatedsep)) {
                    709:         $relatedsep=' ';
                    710:     }
                    711:     if (! $show) {
                    712:         return $relatedsep.'&nbsp;';
                    713:     }
1.54      www       714:     return $relatedsep.'<input type="checkbox" name="'.$fieldname.'_related"'.
                    715: 	($relatedvalue?' checked="1"':'').' />';
                    716: }
1.48      www       717: 
1.46      www       718: sub prettyinput {
1.54      www       719:     my ($type,$value,$fieldname,$formname,
1.116     banghart  720: 	$relatedsearchflag,$relatedsep,$relatedvalue,$size,$course_key)=@_;
1.75      matthew   721:     if (! defined($size)) {
                    722:         $size = 80;
                    723:     }
1.128     banghart  724:     my $output;
1.150     albertel  725:     if (defined($course_key) 
                    726: 	&& exists($env{$course_key.'.metadata.'.$type.'.options'})) {
1.116     banghart  727:         my $stu_add;
                    728:         my $only_one;
1.128     banghart  729:         my %meta_options;
                    730:         my @cur_values_inst;
                    731:         my $cur_values_stu;
1.132     banghart  732:         my $values = $env{$course_key.'.metadata.'.$type.'.values'};
                    733:         if ($env{$course_key.'.metadata.'.$type.'.options'} =~ m/stuadd/) {
1.116     banghart  734:             $stu_add = 'true';
                    735:         }
1.132     banghart  736:         if ($env{$course_key.'.metadata.'.$type.'.options'} =~ m/onlyone/) {
1.116     banghart  737:             $only_one = 'true';
                    738:         }
1.128     banghart  739:         # need to take instructor values out of list where instructor and student
                    740:         # values may be mixed.
1.133     banghart  741:         if ($values) {
1.132     banghart  742:             foreach my $item (split(/,/,$values)) {
                    743:                 $item =~ s/^\s+//;
1.133     banghart  744:                 $meta_options{$item} = $item;
1.128     banghart  745:             }
1.132     banghart  746:             foreach my $item (split(/,/,$value)) {
                    747:                 $item =~ s/^\s+//;
                    748:                 if ($meta_options{$item}) {
                    749:                     push(@cur_values_inst,$item);
1.128     banghart  750:                 } else {
1.201     raeburn   751:                     if ($item ne '') {
1.198     banghart  752:                         $cur_values_stu .= $item.',';
                    753:                     }
1.128     banghart  754:                 }
                    755:             }
1.202     raeburn   756:              $cur_values_stu =~ s/,$//;
1.197     banghart  757:             my @key_order = sort(keys(%meta_options));
1.203     albertel  758:             unshift(@key_order,'');
1.201     raeburn   759:             $meta_options{''} = 'Not specified';
1.197     banghart  760:             $meta_options{'select_form_order'} = \@key_order;
1.129     banghart  761:         } else {
                    762:             $cur_values_stu = $value;
1.128     banghart  763:         }
1.121     banghart  764:         if ($type eq 'courserestricted') {
1.138     banghart  765:             return (&select_course());
                    766:             # return ('<input type="hidden" name="new_courserestricted" value="'.$course_key.'" />');
1.121     banghart  767:         }
1.130     banghart  768:         if (($type eq 'keywords') || ($type eq 'subject')
                    769:              || ($type eq 'author')||($type eq  'notes')
1.174     banghart  770:              || ($type eq  'abstract')|| ($type eq  'title')|| ($type eq  'standards')
1.199     raeburn   771:              || (exists($env{$course_key.'.metadata.'.$type.'.added'}))) {
1.197     banghart  772:             
1.129     banghart  773:             if ($values) {
                    774:                 if ($only_one) {
1.134     banghart  775:                     $output .= (&Apache::loncommon::select_form($cur_values_inst[0],'new_'.$type,%meta_options));
1.129     banghart  776:                 } else {
1.130     banghart  777:                     $output .= (&Apache::loncommon::multiple_select_form('new_'.$type,\@cur_values_inst,undef,\%meta_options));
1.129     banghart  778:                 }
1.128     banghart  779:             }
                    780:             if ($stu_add) {
                    781:                 $output .= '<input type="text" name="'.$fieldname.'" size="'.$size.'" '.
                    782:                 'value="'.$cur_values_stu.'" />'.
                    783:                 &relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,
                    784:                       $relatedvalue); 
1.119     banghart  785:             }
1.128     banghart  786:             return ($output);
1.176     banghart  787:         } 
1.116     banghart  788:         if (($type eq 'lowestgradelevel') ||
                    789: 	    ($type eq 'highestgradelevel')) {
                    790: 	    return &Apache::loncommon::select_level_form($value,$fieldname).
                    791:             &relatedfield(0,$relatedsearchflag,$relatedsep); 
                    792:         }
                    793:         return(); 
                    794:     }
1.64      matthew   795:     # Language
1.48      www       796:     if ($type eq 'language') {
                    797: 	return &selectbox($fieldname,
                    798: 			  $value,
                    799: 			  \&Apache::loncommon::languagedescription,
1.54      www       800: 			  (&Apache::loncommon::languageids)).
1.64      matthew   801:                               &relatedfield(0,$relatedsearchflag,$relatedsep);
1.48      www       802:     }
1.64      matthew   803:     # Copyright
1.48      www       804:     if ($type eq 'copyright') {
                    805: 	return &selectbox($fieldname,
                    806: 			  $value,
                    807: 			  \&Apache::loncommon::copyrightdescription,
1.54      www       808: 			  (&Apache::loncommon::copyrightids)).
1.64      matthew   809:                               &relatedfield(0,$relatedsearchflag,$relatedsep);
1.48      www       810:     }
1.78      taceyjo1  811:     # Source Copyright
                    812:     if ($type eq 'sourceavail') {
                    813: 	return &selectbox($fieldname,
                    814: 			  $value,
                    815: 			  \&Apache::loncommon::source_copyrightdescription,
                    816: 			  (&Apache::loncommon::source_copyrightids)).
                    817:                               &relatedfield(0,$relatedsearchflag,$relatedsep);
                    818:     }
1.64      matthew   819:     # Gradelevels
1.48      www       820:     if (($type eq 'lowestgradelevel') ||
                    821: 	($type eq 'highestgradelevel')) {
1.54      www       822: 	return &Apache::loncommon::select_level_form($value,$fieldname).
1.64      matthew   823:             &relatedfield(0,$relatedsearchflag,$relatedsep);
1.48      www       824:     }
1.64      matthew   825:     # Obsolete
1.48      www       826:     if ($type eq 'obsolete') {
                    827: 	return '<input type="checkbox" name="'.$fieldname.'"'.
1.54      www       828: 	    ($value?' checked="1"':'').' />'.
1.64      matthew   829:             &relatedfield(0,$relatedsearchflag,$relatedsep); 
1.48      www       830:     }
1.64      matthew   831:     # Obsolete replacement file
1.48      www       832:     if ($type eq 'obsoletereplacement') {
                    833: 	return '<input type="text" name="'.$fieldname.
                    834: 	    '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
                    835: 	    "('".$formname."','".$fieldname."'".
1.54      www       836: 	    ",'')\">".&mt('Select').'</a>'.
1.64      matthew   837:             &relatedfield(0,$relatedsearchflag,$relatedsep); 
                    838:     }
                    839:     # Customdistribution file
1.48      www       840:     if ($type eq 'customdistributionfile') {
                    841: 	return '<input type="text" name="'.$fieldname.
                    842: 	    '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
                    843: 	    "('".$formname."','".$fieldname."'".
1.54      www       844: 	    ",'rights')\">".&mt('Select').'</a>'.
1.64      matthew   845:             &relatedfield(0,$relatedsearchflag,$relatedsep); 
1.48      www       846:     }
1.78      taceyjo1  847:     # Source Customdistribution file
                    848:     if ($type eq 'sourcerights') {
                    849: 	return '<input type="text" name="'.$fieldname.
                    850: 	    '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
                    851: 	    "('".$formname."','".$fieldname."'".
                    852: 	    ",'rights')\">".&mt('Select').'</a>'.
                    853:             &relatedfield(0,$relatedsearchflag,$relatedsep); 
                    854:     }
1.135     banghart  855:     if ($type eq 'courserestricted') {
1.138     banghart  856:         return (&select_course());
                    857:         #return ('<input type="hidden" name="new_courserestricted" value="'.$course_key.'" />');
1.135     banghart  858:     }
                    859: 
1.64      matthew   860:     # Dates
1.48      www       861:     if (($type eq 'creationdate') ||
                    862: 	($type eq 'lastrevisiondate')) {
1.64      matthew   863: 	return 
                    864:             &Apache::lonhtmlcommon::date_setter($formname,$fieldname,$value).
                    865:             &relatedfield(0,$relatedsearchflag,$relatedsep);
1.48      www       866:     }
1.64      matthew   867:     # No pretty input found
1.48      www       868:     $value=~s/^\s+//gs;
                    869:     $value=~s/\s+$//gs;
                    870:     $value=~s/\s+/ /gs;
1.77      matthew   871:     $value=~s/\"/\&quot\;/gs;
1.54      www       872:     return 
1.74      matthew   873:         '<input type="text" name="'.$fieldname.'" size="'.$size.'" '.
1.64      matthew   874:         'value="'.$value.'" />'.
                    875:         &relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,
                    876:                       $relatedvalue); 
1.46      www       877: }
                    878: 
1.64      matthew   879: # Main Handler
1.1       www       880: sub handler {
1.64      matthew   881:     my $r=shift;
1.169     banghart  882:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.188     banghart  883:          ['currentpath','changecourse']);
1.67      matthew   884:     my $uri=$r->uri;
                    885:     #
                    886:     # Set document type
                    887:     &Apache::loncommon::content_type($r,'text/html');
                    888:     $r->send_http_header;
                    889:     return OK if $r->header_only;
1.76      matthew   890:     my ($resdomain,$resuser)=
1.190     albertel  891:         (&Apache::lonnet::declutter($uri)=~/^($match_domain)\/($match_username)\//);
1.66      matthew   892:     if ($uri=~m:/adm/bombs/(.*)$:) {
1.153     albertel  893:         $r->print(&Apache::loncommon::start_page('Error Messages'));
1.66      matthew   894:         # Looking for all bombs?
                    895:         &report_bombs($r,$uri);
1.162     albertel  896:     } elsif ($uri=~m|^/editupload/[^/]+/[^/]+/portfolio/|) {
1.140     banghart  897: 	    ($resdomain,$resuser)=
1.190     albertel  898: 		(&Apache::lonnet::declutter($uri)=~m|^($match_domain)/($match_name)/portfolio|);
1.153     albertel  899:         $r->print(&Apache::loncommon::start_page('Edit Portfolio File Catalog Information',
                    900: 						 undef,
                    901: 						 {'domain' => $resdomain,}));
1.140     banghart  902:         if ($env{'form.store'}) {
                    903:             &present_editable_metadata($r,$uri,'portfolio');
                    904:         } else {
1.186     banghart  905:             my $fn=&Apache::lonnet::filelocation('',$uri);
                    906:             %Apache::lonpublisher::metadatafields=();
                    907:             %Apache::lonpublisher::metadatakeys=();
                    908:             my $result=&Apache::lonnet::getfile($fn);
                    909:             &Apache::lonpublisher::metaeval($result);
1.188     banghart  910:             if ((!$Apache::lonpublisher::metadatafields{'courserestricted'}) ||
                    911:                 ($env{'form.changecourse'} eq 'true')) {
1.186     banghart  912:                 &pre_select_course($r,$uri);
                    913:             } else {
                    914:                 &present_editable_metadata($r,$uri,'portfolio');
                    915:             }
1.140     banghart  916:         }
1.171     banghart  917:     } elsif ($uri=~m|^/editupload/[^/]+/[^/]+/groups/|) {
1.172     banghart  918:         $r->print(&Apache::loncommon::start_page('Edit Group Portfolio File Catalog Information',
1.171     banghart  919: 						 undef,
                    920: 						 {'domain' => $resdomain,}));
1.172     banghart  921:         &present_editable_metadata($r,$uri,'groups');    
1.162     albertel  922:     } elsif ($uri=~m|^/~|) { 
1.66      matthew   923:         # Construction space
1.204     banghart  924:         $r->print(&Apache::loncommon::start_page('Edit Catalog Information',
                    925: 						"\n".'<script type="text/javascript">'."\n".
                    926:                                                 &Apache::loncommon::browser_and_searcher_javascript().
                    927:                                                 "\n".'</script>',
1.153     albertel  928: 						 {'domain' => $resdomain,}));
1.66      matthew   929:         &present_editable_metadata($r,$uri);
                    930:     } else {
1.153     albertel  931:         $r->print(&Apache::loncommon::start_page('Catalog Information',
                    932: 						 undef,
                    933: 						 {'domain' => $resdomain,}));
1.66      matthew   934:         &present_uneditable_metadata($r,$uri);
                    935:     }
1.153     albertel  936:     $r->print(&Apache::loncommon::end_page());
1.66      matthew   937:     return OK;
                    938: }
                    939: 
1.67      matthew   940: #####################################################
                    941: #####################################################
                    942: ###                                               ###
                    943: ###                Report Bombs                   ###
                    944: ###                                               ###
                    945: #####################################################
                    946: #####################################################
1.66      matthew   947: sub report_bombs {
                    948:     my ($r,$uri) = @_;
                    949:     # Set document type
1.67      matthew   950:     $uri =~ s:/adm/bombs/::;
                    951:     $uri = &Apache::lonnet::declutter($uri);
1.66      matthew   952:     $r->print('<h1>'.&Apache::lonnet::clutter($uri).'</h1>');
1.190     albertel  953:     my ($domain,$author)=($uri=~/^($match_domain)\/($match_username)\//);
1.66      matthew   954:     if (&Apache::loncacc::constructaccess('/~'.$author.'/',$domain)) {
1.98      www       955: 	if ($env{'form.clearbombs'}) {
                    956: 	    &Apache::lonmsg::clear_author_res_msg($uri);
                    957: 	}
                    958:         my $clear=&mt('Clear all Messages in Subdirectory');
1.212     www       959:         my $cancel=&mt('Back to Directory');
                    960:         my $cancelurl=$uri;
                    961:         $cancelurl=~s/^\Q$domain\E/\/priv/;
                    962:         $r->print(<<ENDCLEAR);
1.98      www       963: <form method="post">
                    964: <input type="submit" name="clearbombs" value="$clear" />
1.212     www       965: <a href="$cancelurl">$cancel</a>
                    966: </form><hr />
1.98      www       967: ENDCLEAR
1.67      matthew   968:         my %brokenurls = 
                    969:             &Apache::lonmsg::all_url_author_res_msg($author,$domain);
                    970:         foreach (sort(keys(%brokenurls))) {
1.66      matthew   971:             if ($_=~/^\Q$uri\E/) {
1.70      matthew   972:                 $r->print
                    973:                     ('<a href="'.&Apache::lonnet::clutter($_).'">'.$_.'</a>'.
                    974:                      &Apache::lonmsg::retrieve_author_res_msg($_).
                    975:                      '<hr />');
1.64      matthew   976:             }
                    977:         }
1.66      matthew   978:     } else {
                    979:         $r->print(&mt('Not authorized'));
                    980:     }
                    981:     return;
                    982: }
                    983: 
1.67      matthew   984: #####################################################
                    985: #####################################################
                    986: ###                                               ###
                    987: ###        Uneditable Metadata Display            ###
                    988: ###                                               ###
                    989: #####################################################
                    990: #####################################################
1.66      matthew   991: sub present_uneditable_metadata {
                    992:     my ($r,$uri) = @_;
                    993:     #
1.162     albertel  994:     my $uploaded = ($uri =~ m|/uploaded/|);
1.66      matthew   995:     my %content=();
                    996:     # Read file
                    997:     foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
                    998:         $content{$_}=&Apache::lonnet::metadata($uri,$_);
                    999:     }
                   1000:     # Render Output
                   1001:     # displayed url
                   1002:     my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
                   1003:     $uri=~s/\.meta$//;
1.183     albertel 1004:     my $disuri=&Apache::lonnet::clutter_with_no_wrapper($uri);
1.66      matthew  1005:     # version
                   1006:     my $versiondisplay='';
1.162     albertel 1007:     if (!$uploaded) {
                   1008: 	my $currentversion=&Apache::lonnet::getversion($disuri);
                   1009: 	if ($thisversion) {
                   1010: 	    $versiondisplay=&mt('Version').': '.$thisversion.
                   1011: 		' ('.&mt('most recent version').': '.
                   1012: 		($currentversion>0 ? 
                   1013: 		 $currentversion   :
                   1014: 		 &mt('information not available')).')';
                   1015: 	} else {
                   1016: 	    $versiondisplay='Version: '.$currentversion;
                   1017: 	}
1.66      matthew  1018:     }
1.72      matthew  1019:     # crumbify displayed URL               uri     target prefix form  size
                   1020:     $disuri=&Apache::lonhtmlcommon::crumbs($disuri,undef, undef, undef,'+1');
                   1021:     $disuri =~ s:<br />::g;
1.66      matthew  1022:     # obsolete
                   1023:     my $obsolete=$content{'obsolete'};
                   1024:     my $obsoletewarning='';
1.96      albertel 1025:     if (($obsolete) && ($env{'user.adv'})) {
1.66      matthew  1026:         $obsoletewarning='<p><font color="red">'.
                   1027:             &mt('This resource has been marked obsolete by the author(s)').
                   1028:             '</font></p>';
                   1029:     }
                   1030:     #
                   1031:     my %lt=&fieldnames();
                   1032:     my $table='';
1.72      matthew  1033:     my $title = $content{'title'};
                   1034:     if (! defined($title)) {
                   1035:         $title = 'Untitled Resource';
                   1036:     }
1.163     albertel 1037:     my @fields;
                   1038:     if ($uploaded) {
                   1039: 	@fields = ('title','author','subject','keywords','notes','abstract',
                   1040: 		   'lowestgradelevel','highestgradelevel','standards','mime',
                   1041: 		   'owner');
                   1042:     } else {
                   1043: 	@fields = ('title', 
                   1044: 		   'author', 
                   1045: 		   'subject', 
                   1046: 		   'keywords', 
                   1047: 		   'notes', 
                   1048: 		   'abstract',
                   1049: 		   'lowestgradelevel',
                   1050: 		   'highestgradelevel',
                   1051: 		   'standards', 
                   1052: 		   'mime', 
                   1053: 		   'language', 
                   1054: 		   'creationdate', 
                   1055: 		   'lastrevisiondate', 
                   1056: 		   'owner', 
                   1057: 		   'copyright', 
                   1058: 		   'customdistributionfile',
                   1059: 		   'sourceavail',
                   1060: 		   'sourcerights', 
                   1061: 		   'obsolete', 
                   1062: 		   'obsoletereplacement');
                   1063:     }
                   1064:     foreach my $field (@fields) {
                   1065:         $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$field}.
1.66      matthew  1066:             '</td><td bgcolor="#CCCCCC">'.
1.163     albertel 1067:             &prettyprint($field,$content{$field}).'</td></tr>';
                   1068:         delete($content{$field});
1.66      matthew  1069:     }
                   1070:     #
                   1071:     $r->print(<<ENDHEAD);
1.72      matthew  1072: <h2>$title</h2>
                   1073: <p>
                   1074: $disuri<br />
1.36      www      1075: $obsoletewarning
1.72      matthew  1076: $versiondisplay
                   1077: </p>
1.88      banghart 1078: <table cellspacing="2" border="0">
1.45      www      1079: $table
1.11      www      1080: </table>
1.1       www      1081: ENDHEAD
1.162     albertel 1082:     if (!$uploaded && $env{'user.adv'}) {
1.68      matthew  1083:         &print_dynamic_metadata($r,$uri,\%content);
1.67      matthew  1084:     }
                   1085:     return;
                   1086: }
                   1087: 
                   1088: sub print_dynamic_metadata {
1.68      matthew  1089:     my ($r,$uri,$content) = @_;
                   1090:     #
1.69      matthew  1091:     my %content = %$content;
1.68      matthew  1092:     my %lt=&fieldnames();
1.67      matthew  1093:     #
                   1094:     my $description = 'Dynamic Metadata (updated periodically)';
                   1095:     $r->print('<h3>'.&mt($description).'</h3>'.
1.70      matthew  1096:               &mt('Processing'));
1.67      matthew  1097:     $r->rflush();
                   1098:     my %items=&fieldnames();
                   1099:     my %dynmeta=&dynamicmeta($uri);
                   1100:     #
                   1101:     # General Access and Usage Statistics
1.70      matthew  1102:     if (exists($dynmeta{'count'}) ||
                   1103:         exists($dynmeta{'sequsage'}) ||
                   1104:         exists($dynmeta{'comefrom'}) ||
                   1105:         exists($dynmeta{'goto'}) ||
                   1106:         exists($dynmeta{'course'})) {
                   1107:         $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.
1.88      banghart 1108:                   '<table cellspacing="2" border="0">');
1.70      matthew  1109:         foreach ('count',
                   1110:                  'sequsage','sequsage_list',
                   1111:                  'comefrom','comefrom_list',
                   1112:                  'goto','goto_list',
                   1113:                  'course','course_list') {
                   1114:             $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                   1115:                       '<td bgcolor="#CCCCCC">'.
                   1116:                       &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
                   1117:         }
                   1118:         $r->print('</table>');
                   1119:     } else {
                   1120:         $r->print('<h4>'.&mt('No Access or Usages Statistics are available for this resource.').'</h4>');
1.67      matthew  1121:     }
1.69      matthew  1122:     #
                   1123:     # Assessment statistics
1.73      matthew  1124:     if ($uri=~/\.(problem|exam|quiz|assess|survey|form)$/) {
                   1125:         if (exists($dynmeta{'stdno'}) ||
                   1126:             exists($dynmeta{'avetries'}) ||
                   1127:             exists($dynmeta{'difficulty'}) ||
                   1128:             exists($dynmeta{'disc'})) {
                   1129:             # This is an assessment, print assessment data
                   1130:             $r->print('<h4>'.
                   1131:                       &mt('Overall Assessment Statistical Data').
                   1132:                       '</h4>'.
1.88      banghart 1133:                       '<table cellspacing="2" border="0">');
1.73      matthew  1134:             $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{'stdno'}.'</td>'.
1.66      matthew  1135:                       '<td bgcolor="#CCCCCC">'.
1.73      matthew  1136:                       &prettyprint('stdno',$dynmeta{'stdno'}).
                   1137:                       '</td>'."</tr>\n");
                   1138:             foreach ('avetries','difficulty','disc') {
                   1139:                 $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                   1140:                           '<td bgcolor="#CCCCCC">'.
                   1141:                           &prettyprint($_,sprintf('%5.2f',$dynmeta{$_})).
                   1142:                           '</td>'."</tr>\n");
                   1143:             }
                   1144:             $r->print('</table>');    
                   1145:         }
                   1146:         if (exists($dynmeta{'stats'})) {
                   1147:             #
                   1148:             # New assessment statistics
                   1149:             $r->print('<h4>'.
1.207     albertel 1150:                       &mt('Recent Detailed Assessment Statistical Data').
1.73      matthew  1151:                       '</h4>');
1.88      banghart 1152:             my $table = '<table cellspacing="2" border="0">'.
1.73      matthew  1153:                 '<tr>'.
1.207     albertel 1154:                 '<th>'.&mt('Course').'</th>'.
                   1155:                 '<th>'.&mt('Section(s)').'</th>'.
                   1156:                 '<th>'.&mt('Num Student').'s</th>'.
                   1157:                 '<th>'.&mt('Mean Tries').'</th>'.
                   1158:                 '<th>'.&mt('Degree of Difficulty').'</th>'.
                   1159:                 '<th>'.&mt('Degree of Discrimination').'</th>'.
                   1160:                 '<th>'.&mt('Time of computation').'</th>'.
1.73      matthew  1161:                 '</tr>'.$/;
                   1162:             foreach my $identifier (sort(keys(%{$dynmeta{'stats'}}))) {
                   1163:                 my $data = $dynmeta{'stats'}->{$identifier};
                   1164:                 my $course = $data->{'course'};
1.154     albertel 1165:                 my %courseinfo = 
                   1166: 		    &Apache::lonnet::coursedescription($course,
                   1167: 						       {'one_time' => 1});
1.73      matthew  1168:                 if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
                   1169:                     &Apache::lonnet::logthis('lookup for '.$course.' failed');
                   1170:                     next;
                   1171:                 }
                   1172:                 $table .= '<tr>';
                   1173:                 $table .= 
                   1174:                     '<td><nobr>'.$courseinfo{'description'}.'</nobr></td>';
                   1175:                 $table .= 
                   1176:                     '<td align="right">'.$data->{'sections'}.'</td>';
                   1177:                 $table .=
                   1178:                     '<td align="right">'.$data->{'stdno'}.'</td>';
                   1179:                 foreach ('avetries','difficulty','disc') {
                   1180:                     $table .= '<td align="right">';
                   1181:                     if (exists($data->{$_})) {
                   1182:                         $table .= sprintf('%.2f',$data->{$_}).'&nbsp;';
                   1183:                     } else {
                   1184:                         $table .= '';
                   1185:                     }
                   1186:                     $table .= '</td>';
                   1187:                 }
                   1188:                 $table .=
                   1189:                     '<td><nobr>'.
                   1190:                     &Apache::lonlocal::locallocaltime($data->{'timestamp'}).
                   1191:                     '</nobr></td>';
                   1192:                 $table .=
                   1193:                     '</tr>'.$/;
                   1194:             }
                   1195:             $table .= '</table>'.$/;
                   1196:             $r->print($table);
                   1197:         } else {
1.210     bisitz   1198:             $r->print(&mt('No new dynamic data found.'));
1.66      matthew  1199:         }
1.70      matthew  1200:     } else {
1.73      matthew  1201:         $r->print('<h4>'.
                   1202:           &mt('No Assessment Statistical Data is available for this resource').
                   1203:                   '</h4>');
1.67      matthew  1204:     }
1.73      matthew  1205: 
                   1206:     #
                   1207:     #
1.70      matthew  1208:     if (exists($dynmeta{'clear'})   || 
                   1209:         exists($dynmeta{'depth'})   || 
                   1210:         exists($dynmeta{'helpful'}) || 
                   1211:         exists($dynmeta{'correct'}) || 
                   1212:         exists($dynmeta{'technical'})){ 
                   1213:         $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.
1.88      banghart 1214:                   '<table cellspacing="2" border="0">');
1.70      matthew  1215:         foreach ('clear','depth','helpful','correct','technical') {
                   1216:             $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                   1217:                       '<td bgcolor="#CCCCCC">'.
                   1218:                       &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
                   1219:         }
                   1220:         $r->print('</table>');
                   1221:     } else {
                   1222:         $r->print('<h4>'.&mt('No Evaluation Data is available for this resource.').'</h4>');
1.67      matthew  1223:     }
1.190     albertel 1224:     $uri=~/^\/res\/($match_domain)\/($match_username)\//; 
1.96      albertel 1225:     if ((($env{'user.domain'} eq $1) && ($env{'user.name'} eq $2))
                   1226:         || ($env{'user.role.ca./'.$1.'/'.$2})) {
1.70      matthew  1227:         if (exists($dynmeta{'comments'})) {
                   1228:             $r->print('<h4>'.&mt('Evaluation Comments').' ('.
                   1229:                       &mt('visible to author and co-authors only').
                   1230:                       ')</h4>'.
                   1231:                       '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
                   1232:         } else {
                   1233:             $r->print('<h4>'.&mt('There are no Evaluation Comments on this resource.').'</h4>');
                   1234:         }
                   1235:         my $bombs = &Apache::lonmsg::retrieve_author_res_msg($uri);
                   1236:         if (defined($bombs) && $bombs ne '') {
                   1237:             $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.
                   1238:                       &mt('visible to author and co-authors only').')'.
                   1239:                       '</h4>'.$bombs);
                   1240:         } else {
                   1241:             $r->print('<h4>'.&mt('There are currently no Error Messages for this resource.').'</h4>');
                   1242:         }
1.67      matthew  1243:     }
1.69      matthew  1244:     #
1.67      matthew  1245:     # All other stuff
                   1246:     $r->print('<h3>'.
                   1247:               &mt('Additional Metadata (non-standard, parameters, exports)').
1.81      www      1248:               '</h3><table border="0" cellspacing="1">');
1.67      matthew  1249:     foreach (sort(keys(%content))) {
                   1250:         my $name=$_;
                   1251:         if ($name!~/\.display$/) {
                   1252:             my $display=&Apache::lonnet::metadata($uri,
                   1253:                                                   $name.'.display');
                   1254:             if (! $display) { 
                   1255:                 $display=$name;
                   1256:             };
                   1257:             my $otherinfo='';
                   1258:             foreach ('name','part','type','default') {
                   1259:                 if (defined(&Apache::lonnet::metadata($uri,
                   1260:                                                       $name.'.'.$_))) {
                   1261:                     $otherinfo.=' '.$_.'='.
                   1262:                         &Apache::lonnet::metadata($uri,
                   1263:                                                   $name.'.'.$_).'; ';
                   1264:                 }
1.64      matthew  1265:             }
1.81      www      1266:             $r->print('<tr><td bgcolor="#bbccbb"><font size="-1" color="#556655">'.$display.'</font></td><td bgcolor="#ccddcc"><font size="-1" color="#556655">'.$content{$name});
1.67      matthew  1267:             if ($otherinfo) {
                   1268:                 $r->print(' ('.$otherinfo.')');
1.64      matthew  1269:             }
1.81      www      1270:             $r->print("</font></td></tr>\n");
1.64      matthew  1271:         }
1.66      matthew  1272:     }
1.81      www      1273:     $r->print("</table>");
1.67      matthew  1274:     return;
1.66      matthew  1275: }
1.105     banghart 1276: 
1.102     banghart 1277: 
                   1278: 
1.67      matthew  1279: #####################################################
                   1280: #####################################################
                   1281: ###                                               ###
                   1282: ###          Editable metadata display            ###
                   1283: ###                                               ###
                   1284: #####################################################
                   1285: #####################################################
1.66      matthew  1286: sub present_editable_metadata {
1.172     banghart 1287:     my ($r,$uri,$file_type) = @_;
1.66      matthew  1288:     # Construction Space Call
                   1289:     # Header
                   1290:     my $disuri=$uri;
                   1291:     my $fn=&Apache::lonnet::filelocation('',$uri);
1.155     albertel 1292:     $disuri=~s{^/\~}{/priv/};
1.66      matthew  1293:     $disuri=~s/\.meta$//;
1.141     albertel 1294:     my $meta_uri = $disuri;
1.147     albertel 1295:     my $path;
1.141     albertel 1296:     if ($disuri =~ m|/portfolio/|) {
1.147     albertel 1297: 	($disuri, $meta_uri, $path) =  &portfolio_display_uri($disuri,1);
1.141     albertel 1298:     }
1.66      matthew  1299:     my $target=$uri;
1.155     albertel 1300:     $target=~s{^/\~}{/res/$env{'request.role.domain'}/};
1.66      matthew  1301:     $target=~s/\.meta$//;
                   1302:     my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);
                   1303:     if ($bombs) {
1.99      www      1304:         my $showdel=1;
1.96      albertel 1305:         if ($env{'form.delmsg'}) {
1.66      matthew  1306:             if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {
                   1307:                 $bombs=&mt('Messages deleted.');
1.99      www      1308: 		$showdel=0;
1.66      matthew  1309:             } else {
                   1310:                 $bombs=&mt('Error deleting messages');
1.64      matthew  1311:             }
1.66      matthew  1312:         }
1.98      www      1313:         if ($env{'form.clearmsg'}) {
                   1314: 	    my $cleardir=$target;
                   1315: 	    $cleardir=~s/\/[^\/]+$/\//;
                   1316:             if (&Apache::lonmsg::clear_author_res_msg($cleardir) eq 'ok') {
                   1317:                 $bombs=&mt('Messages cleared.');
1.99      www      1318: 		$showdel=0;
1.98      www      1319:             } else {
                   1320:                 $bombs=&mt('Error clearing messages');
                   1321:             }
                   1322:         }
                   1323:         my $del=&mt('Delete Messages for this Resource');
                   1324: 	my $clear=&mt('Clear all Messages in Subdirectory');
1.99      www      1325: 	my $goback=&mt('Back to Source File');
1.66      matthew  1326:         $r->print(<<ENDBOMBS);
1.52      www      1327: <h1>$disuri</h1>
1.169     banghart 1328: <form method="post" action="" name="defaultmeta">
1.99      www      1329: ENDBOMBS
                   1330:         if ($showdel) {
                   1331: 	    $r->print(<<ENDDEL);
1.59      www      1332: <input type="submit" name="delmsg" value="$del" />
1.98      www      1333: <input type="submit" name="clearmsg" value="$clear" />
1.99      www      1334: ENDDEL
                   1335:         } else {
1.208     albertel 1336:             $r->print('<p><a href="'.$disuri.'">'.$goback.'</a></p>');
1.203     albertel 1337: 	    if ($env{'form.clearmsg'}) {
                   1338: 		my ($diruri) = ($disuri =~ m{(.*/)[^/]*});
1.208     albertel 1339: 		$r->print('<p><a href="'.$diruri.'">'.
1.203     albertel 1340: 			  &mt('Back To Directory').'</a></p>');
                   1341: 	    }
1.99      www      1342: 	}
                   1343: 	$r->print('<br />'.$bombs);
1.66      matthew  1344:     } else {
1.211     bisitz   1345:         my $displayfile=&mt('Catalog Information for [_1]',$disuri);
1.66      matthew  1346:         if ($disuri=~/\/default$/) {
                   1347:             my $dir=$disuri;
                   1348:             $dir=~s/default$//;
1.211     bisitz   1349:             $displayfile=&mt('Default Cataloging Information for Directory [_1]',$dir);
1.66      matthew  1350:         }
                   1351:         %Apache::lonpublisher::metadatafields=();
                   1352:         %Apache::lonpublisher::metadatakeys=();
1.94      banghart 1353:         my $result=&Apache::lonnet::getfile($fn);
                   1354:         if ($result == -1){
1.141     albertel 1355: 	    $r->print(&mt('Creating new file [_1]'),$meta_uri);
1.94      banghart 1356:         } else {
                   1357:             &Apache::lonpublisher::metaeval($result);
                   1358:         }
1.200     raeburn  1359:         if ($env{'form.new_courserestricted'}) {
                   1360:             my $new_assoc_course = $env{'form.new_courserestricted'};
                   1361:             my $prev_courserestricted = $Apache::lonpublisher::metadatafields{'courserestricted'};
                   1362:             if (($prev_courserestricted) && 
                   1363:                 ($prev_courserestricted ne $new_assoc_course)) {
                   1364:                 my $transfers = [];
                   1365:                 foreach my $key (keys(%env)) {
                   1366:                     if ($key =~ /^form\.transfer_(.+)$/) {
                   1367:                         push(@{$transfers},$1);
                   1368:                     }
                   1369:                 }
                   1370:                 if (@{$transfers} > 0) {
                   1371:                     &store_transferred_addedfields($fn,$uri,$transfers);
                   1372:                 }
                   1373:             }
                   1374:         }
1.66      matthew  1375:         $r->print(<<ENDEDIT);
1.23      www      1376: <h1>$displayfile</h1>
1.169     banghart 1377: <form method="post" action="" name="defaultmeta">
1.23      www      1378: ENDEDIT
1.90      banghart 1379:         my %lt=&fieldnames($file_type);
1.87      albertel 1380: 	my $output;
1.90      banghart 1381: 	my @fields;
1.174     banghart 1382: 	my $added_metadata_fields;
1.184     banghart 1383: 	my @added_order;
1.195     raeburn  1384:         if ($file_type eq 'groups') {
                   1385:             $Apache::lonpublisher::metadatafields{'courserestricted'}=
                   1386:                 'course.'.$env{'request.course.id'};
                   1387:         }
                   1388:         if ((! $Apache::lonpublisher::metadatafields{'courserestricted'}) &&
                   1389:                 (! $env{'form.new_courserestricted'}) && (! $file_type eq 'groups')) {
                   1390:             $Apache::lonpublisher::metadatafields{'courserestricted'}=
                   1391:                 'none';
                   1392:         } elsif ($env{'form.new_courserestricted'}) {
                   1393:             $Apache::lonpublisher::metadatafields{'courserestricted'}=
                   1394:                 $env{'form.new_courserestricted'};
                   1395:         }
1.178     raeburn  1396: 	if ($file_type eq 'portfolio' || $file_type eq 'groups') {
1.174     banghart 1397: 	    if(exists ($env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.fieldlist'})) {
                   1398: 	        # retrieve fieldnames (in order) from the course restricted list
1.185     albertel 1399: 	        @fields = (split(/,/,$env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.fieldlist'}));
1.174     banghart 1400: 	    } else {
                   1401: 	        # no saved field list, use default list
                   1402: 	        @fields =  ('author','title','subject','keywords','abstract',
                   1403: 			    'notes','lowestgradelevel',
                   1404: 	                    'highestgradelevel','standards');
1.195     raeburn  1405:                 if ($Apache::lonpublisher::metadatafields{'courserestricted'} =~ /^course\.($match_domain\_$match_courseid)$/) {
                   1406:                     my $assoc_crs = $1;
                   1407: 	            $added_metadata_fields = &Apache::lonparmset::get_added_meta_fieldnames($assoc_crs);
                   1408: 	            if ($env{'course.'.$assoc_crs.'.metadata.addedorder'}) {
                   1409: 	                @added_order = split(/,/,$env{'course.'.$assoc_crs.'.metadata.addedorder'});
                   1410: 	            }
                   1411: 	            $env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.fieldlist'} = join(",",@fields);
                   1412:                 }
1.174     banghart 1413: 	    }
1.90      banghart 1414: 	} else {
                   1415: 	    @fields = ('author','title','subject','keywords','abstract','notes',
1.185     albertel 1416: 		       'copyright','customdistributionfile','language',
                   1417: 		       'standards',
                   1418: 		       'lowestgradelevel','highestgradelevel','sourceavail','sourcerights',
                   1419: 		       'obsolete','obsoletereplacement');
1.90      banghart 1420:         }
1.120     banghart 1421:         if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
                   1422:                 $Apache::lonpublisher::metadatafields{'copyright'}=
1.163     albertel 1423: 		    'default';
1.120     banghart 1424:         }
1.172     banghart 1425: 	if (($file_type eq 'portfolio') || ($file_type eq 'groups'))  {
1.163     albertel 1426: 	    if (! $Apache::lonpublisher::metadatafields{'mime'}) {
                   1427:                 ($Apache::lonpublisher::metadatafields{'mime'}) =
                   1428: 		    ( $target=~/\.(\w+)$/ );
                   1429: 	    }
                   1430: 	    if (! $Apache::lonpublisher::metadatafields{'owner'}) {
                   1431: 		$Apache::lonpublisher::metadatafields{'owner'} =
                   1432: 		    $env{'user.name'}.':'.$env{'user.domain'};
                   1433: 	    }
1.209     albertel 1434: 	    if (! $Apache::lonpublisher::metadatafields{'author'}) {
                   1435: 		$Apache::lonpublisher::metadatafields{'author'} =
                   1436: 		    &Apache::loncommon::plainname($env{'user.name'},
                   1437: 						  $env{'user.domain'});
                   1438: 	    }
1.197     banghart 1439: 	    if ($Apache::lonpublisher::metadatafields{'courserestricted'} ne 'none') {
1.163     albertel 1440: 
1.191     raeburn  1441:                 if ($file_type eq 'portfolio') {
                   1442: 		    $r->print(&mt('Associated with course [_1]',
1.188     banghart 1443: 		        '<strong><a href="'.$uri.'?changecourse=true">'.
                   1444: 		        $env{$Apache::lonpublisher::metadatafields{'courserestricted'}.
                   1445: 		        ".description"}.
                   1446: 			      '</a></strong>').'<br />');
1.191     raeburn  1447:                 } else {
                   1448:                     $r->print(&mt('Associated with course [_1]',
                   1449:                         '<strong>'.
                   1450:   $env{$Apache::lonpublisher::metadatafields{'courserestricted'}.
                   1451:                         ".description"}.'</strong>').'<br />');
                   1452:                 }
1.149     albertel 1453: 	    } else {
1.210     bisitz   1454: 		$r->print('<a href="'.$uri.'?changecourse=true">'.&mt('This resource is not associated with a course.').'</a><br />');
1.149     albertel 1455: 	    }
                   1456: 	}
1.184     banghart 1457: 	if (@added_order) {
1.185     albertel 1458: 	    foreach my $field_name (@added_order) {
                   1459:                 push(@fields,$field_name);
1.184     banghart 1460:                 $lt{$field_name} = $$added_metadata_fields{$field_name};
                   1461: 	    }
                   1462: 	} else {
1.185     albertel 1463:             foreach my $field_name (keys(%$added_metadata_fields)) {
                   1464:                 push(@fields,$field_name);
1.184     banghart 1465:                 $lt{$field_name} = $$added_metadata_fields{$field_name};
                   1466:             }
1.176     banghart 1467:         }
1.189     banghart 1468:         $output .= &Apache::loncommon::start_data_table();
1.187     banghart 1469:         my $row_alt = 1;
1.143     albertel 1470:         foreach my $field_name (@fields) {
1.132     banghart 1471:             if (defined($env{'form.new_'.$field_name})) {
1.201     raeburn  1472:                 my @values = &Apache::loncommon::get_env_multiple('form.new_'.$field_name);
                   1473:                 my $newvalue = '';
                   1474:                 foreach my $item (@values) {
                   1475:                     if ($item ne '') {
                   1476:                         $newvalue .= $item.',';
                   1477:                     }
                   1478:                 }
                   1479:                 $newvalue =~ s/,$//; 
                   1480:                 $Apache::lonpublisher::metadatafields{$field_name}=$newvalue;
1.66      matthew  1481:             }
1.150     albertel 1482:             if ($Apache::lonpublisher::metadatafields{'courserestricted'} ne 'none'
                   1483: 		&& exists($env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.'.$field_name.'.options'})) {
1.115     banghart 1484:                 # handle restrictions here
1.181     banghart 1485:                 if ((($env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.'.$field_name.'.options'} =~ m/active/) ||
                   1486:                     ($field_name eq 'courserestricted'))&&
                   1487:                     (!($env{$Apache::lonpublisher::metadatafields{'courserestricted'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/))){
1.187     banghart 1488:                     
1.189     banghart 1489:                     $output .= "\n".&Apache::loncommon::start_data_table_row();
                   1490:                     $output .= ('<td><span class="LC_metadata">'.$lt{$field_name}.':</span></td><td> '.
1.132     banghart 1491:                               &prettyinput($field_name,
                   1492: 				   $Apache::lonpublisher::metadatafields{$field_name},
1.138     banghart 1493: 				                    'new_'.$field_name,'defaultmeta',
                   1494: 				                    undef,undef,undef,undef,
1.189     banghart 1495: 				                    $Apache::lonpublisher::metadatafields{'courserestricted'}).'</td>');
                   1496:                     $output .= &Apache::loncommon::end_data_table_row();
1.127     banghart 1497:                  }
1.115     banghart 1498:             } else {
1.138     banghart 1499: 
1.189     banghart 1500:                     $output.=(&Apache::loncommon::start_data_table_row().'<td><span class="LC_metadata">'.$lt{$field_name}.':</span></td><td> '.
1.185     albertel 1501: 			      &prettyinput($field_name,
                   1502: 					   $Apache::lonpublisher::metadatafields{$field_name},
1.189     banghart 1503: 					   'new_'.$field_name,'defaultmeta').'</td>'.&Apache::loncommon::end_data_table_row());
1.138     banghart 1504:                
1.115     banghart 1505:             }
1.66      matthew  1506:         }
1.189     banghart 1507:         $output .= &Apache::loncommon::end_data_table();
1.143     albertel 1508: 	if ($env{'form.store'}) {
1.200     raeburn  1509:             my ($outcome,$result) = &store_metadata($fn,$uri,'store');
                   1510:             $r->print($result);
1.142     albertel 1511: 	}
1.143     albertel 1512: 	$r->print($output.'<br /><input type="submit" name="store" value="'.
1.206     albertel 1513:                   &mt('Save Catalog Information').'" />');
1.147     albertel 1514: 
1.191     raeburn  1515: 	if ($file_type eq 'portfolio' || $file_type eq 'groups') {
1.156     albertel 1516: 	    my ($port_path,$group) = &get_port_path_and_group($uri);
1.191     raeburn  1517:             if ($group ne '') {
1.159     raeburn  1518:                 $r->print('<input type="hidden" name="group" value="'.$group.'" />');
                   1519:             }
1.169     banghart 1520:             $r->print('<input type="hidden" name="currentpath" value="'.$env{'form.currentpath'}.'" />');
1.175     banghart 1521: 	    $r->print('</form><br /><br /><form method="post" action="'.$port_path.'">');
1.191     raeburn  1522: 	    if ($group ne '') {
1.175     banghart 1523: 	        $r->print('<input type="hidden" name="group" value="'.$group.'" />');
1.191     raeburn  1524:             }
1.175     banghart 1525: 	    $r->print('<input type="hidden" name="currentpath" value="'.$path.'" />'.
1.169     banghart 1526: 		      '<input type="submit" name="cancel" value="'.&mt('Discard Edits and Return to Portfolio').'" />');
1.149     albertel 1527: 	}
1.142     albertel 1528:     }
1.149     albertel 1529:     
1.143     albertel 1530:     $r->print('</form>');
                   1531: 
1.66      matthew  1532:     return;
1.1       www      1533: }
1.64      matthew  1534: 
1.200     raeburn  1535: sub store_metadata {
                   1536:     my ($fn,$uri,$caller) = @_;
                   1537:     my $mfh;
                   1538:     my $formname='store';
                   1539:     my ($file_content,$output,$outcome);
                   1540:     if (&Apache::loncommon::get_env_multiple('form.new_keywords')) {
                   1541:         $Apache::lonpublisher::metadatafields{'keywords'} =
                   1542:             join (',', &Apache::loncommon::get_env_multiple('form.new_keywords'));
                   1543:             }
                   1544:     foreach my $field (sort(keys(%Apache::lonpublisher::metadatafields))) {
                   1545:         next if ($field =~ /\./);
                   1546:         my $unikey=$field;
                   1547:         $unikey=~/^([A-Za-z_]+)/;
                   1548:         my $tag=$1;
                   1549:         $tag=~tr/A-Z/a-z/;
                   1550:         $file_content.= "\n\<$tag";
                   1551:         foreach my $key (split(/\,/,$Apache::lonpublisher::metadatakeys{$unikey})) {
                   1552:             my $value = $Apache::lonpublisher::metadatafields{$unikey.'.'.$key};
                   1553:             $value=~s/\"/\'\'/g;
                   1554:             $file_content.=' '.$key.'="'.$value.'"' ;
                   1555:         }
                   1556:         $file_content.= '>'.
                   1557:             &HTML::Entities::encode
                   1558:                 ($Apache::lonpublisher::metadatafields{$unikey},'<>&"').
                   1559:                 '</'.$tag.'>';
                   1560:     }
                   1561:     if ($fn =~ m|^$Apache::lonnet::perlvar{'lonDocRoot'}/userfiles|) {
                   1562:         my ($path, $new_fn);
                   1563:         if ($fn =~ m|$match_name/groups/\w+/portfolio/|) {
                   1564:             ($path, $new_fn) = ($fn =~ m|/(groups/\w+/portfolio.*)/([^/]*)$|);
                   1565:         } else {
                   1566:             ($path, $new_fn) = ($fn =~ m|/(portfolio.*)/([^/]*)$|);
                   1567:         }
                   1568:         ($outcome,my $result) = 
                   1569:             &store_portfolio_metadata($formname,$file_content,
                   1570:                                       $path,$new_fn,$uri,$caller);
                   1571:         $output .= $result;
                   1572:     } else {
                   1573:         if (! ($mfh=Apache::File->new('>'.$fn))) {
                   1574:             $output .= '<p><font color="red">';
                   1575:             if ($caller eq 'transfer') {
                   1576:                 $output .= &mt('Could not transfer data in added fields to notes');
                   1577:             } else { 
                   1578:                 $output .= &mt('Could not write metadata');
                   1579:             }
                   1580:             $output .= ', '.&mt('FAIL').'</font></p>';
                   1581:             $outcome = 'fail';
                   1582:         } else {
                   1583:             print $mfh ($file_content);
                   1584:             close($mfh);
                   1585:             &update_metadata_table($uri);
                   1586:             $output .= '<p><font color="blue">';
                   1587:             if ($caller eq 'transfer') {
                   1588:                 $output .= &mt('Transferred data in added fields to notes');
                   1589:             } else {
                   1590:                 $output .= &mt('Wrote Metadata');
                   1591:             }
                   1592:             $output .= ' '.&Apache::lonlocal::locallocaltime(time).
                   1593:                        '</font></p>';
                   1594:             $outcome = 'ok';
                   1595:         }
                   1596:     }
                   1597:     return ($outcome,$output);
                   1598: }
                   1599: 
                   1600: sub store_transferred_addedfields {
                   1601:     my ($fn,$uri,$transfers) = @_;
                   1602:     foreach my $item (@{$transfers}) {
                   1603:         $Apache::lonpublisher::metadatafields{'notes'} .= 
                   1604:            ' '.$item.' = '.$Apache::lonpublisher::metadatafields{$item};
                   1605:     }
                   1606:     my ($outcome,$output) = &store_metadata($fn,$uri,'transfer');
                   1607:     if ($outcome eq 'ok') {
                   1608:         foreach my $item (@{$transfers}) {
                   1609:             delete($Apache::lonpublisher::metadatafields{$item});
                   1610:         }
                   1611:     }
                   1612: }
                   1613: 
1.159     raeburn  1614: sub store_portfolio_metadata {
1.200     raeburn  1615:     my ($formname,$content,$path,$new_fn,$uri,$caller) = @_;
                   1616:     my ($outcome,$output);
1.159     raeburn  1617:     $env{'form.'.$formname}=$content."\n";
                   1618:     $env{'form.'.$formname.'.filename'}=$new_fn;
                   1619:     my $result =&Apache::lonnet::userfileupload($formname,'',$path);
                   1620:     if ($result =~ /(error|notfound)/) {
1.200     raeburn  1621:         $output = '<p><font color="red">';
                   1622:         if ($caller eq 'transfer') {
                   1623:             $output .= 
                   1624:                 &mt('Could not transfer data in added fields to notes'); 
                   1625:         } else {
                   1626:             $output .= &mt('Could not write metadata');
                   1627:         }
                   1628:         $output .= ', '.&mt('FAIL').'</font></p>';
                   1629:         $outcome = 'fail';
1.159     raeburn  1630:     } else {
1.192     raeburn  1631:         &update_metadata_table($uri);
1.200     raeburn  1632:         $output = '<p><font color="blue">';
                   1633:         if ($caller eq 'transfer') {
                   1634:             $output .= &mt('Transferred data in added fields to notes');
                   1635:         } else {
                   1636:             $output .= &mt('Wrote Metadata');
                   1637:         }
                   1638:         $output .= ' '.&Apache::lonlocal::locallocaltime(time).
                   1639:                    '</font></p>';
                   1640:         $outcome = 'ok';
1.159     raeburn  1641:     }
1.200     raeburn  1642:     return ($outcome,$output);
1.159     raeburn  1643: }
                   1644: 
1.192     raeburn  1645: sub update_metadata_table {
                   1646:     my ($uri) = @_;
1.196     albertel 1647:     my ($type,$udom,$uname,$file_name,$group) =
                   1648: 	&Apache::lonnet::parse_portfolio_url($uri);
1.192     raeburn  1649:     $file_name =~ s/\.meta$//;
                   1650:     my $current_permissions =
                   1651:         &Apache::lonnet::get_portfile_permissions($udom,$uname);
                   1652:     my %access_controls =
                   1653:         &Apache::lonnet::get_access_controls($current_permissions,$group,
1.196     albertel 1654:                                              $file_name);
1.192     raeburn  1655:     my $access_hash = $access_controls{$file_name};
                   1656:     my $available = 0;
                   1657:     if (ref($access_hash) eq 'HASH') {
                   1658:         foreach my $key (keys(%{$access_hash})) {
                   1659:             my ($num,$scope,$end,$start) =
                   1660:                 ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
                   1661:             if ($scope eq 'public' || $scope eq 'guest') {
                   1662:                 $available = 1;
                   1663:                 last;
                   1664:             }
                   1665:         }
                   1666:     }
                   1667:     if ($available) {
                   1668:         my $result =
                   1669:             &Apache::lonnet::update_portfolio_table($uname,$udom,
1.194     raeburn  1670:             $file_name,'portfolio_metadata',$group,'update');
1.192     raeburn  1671:     }
                   1672: }
                   1673: 
                   1674: 
1.1       www      1675: 1;
                   1676: __END__
1.97      banghart 1677: 

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