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

1.1       www         1: # The LearningOnline Network with CAPA
1.8       albertel    2: # Metadata display handler
                      3: #
1.46    ! www         4: # $Id: lonmeta.pm,v 1.45 2003/12/29 15:10:54 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: #
                     20: # You should have received a copy of the GNU General Public License
                     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: 
                     29: package Apache::lonmeta;
                     30: 
                     31: use strict;
                     32: use Apache::Constants qw(:common);
1.3       www        33: use Apache::lonnet();
1.10      www        34: use Apache::loncommon();
1.46    ! www        35: use Apache::lonhtmlcommon();
1.23      www        36: use Apache::lonmsg;
                     37: use Apache::lonpublisher;
1.35      www        38: use Apache::lonlocal;
1.43      www        39: use Apache::lonmysql;
1.1       www        40: 
1.44      www        41: # MySQL table columns
                     42: 
                     43: my @columns;
                     44: 
1.9       www        45: # ----------------------------------------- Fetch and evaluate dynamic metadata
                     46: 
                     47: sub dynamicmeta {
                     48:     my $url=&Apache::lonnet::declutter(shift);
                     49:     $url=~s/\.meta$//;
                     50:     my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);
1.19      www        51:     my $regexp=$url;
1.9       www        52:     $regexp=~s/(\W)/\\$1/g;
1.10      www        53:     $regexp='___'.$regexp.'___';
1.16      albertel   54:     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
                     55: 				       $aauthor,$regexp);
1.30      www        56:     my %sum=();
                     57:     my %cnt=();
                     58:     my %concat=();
1.40      matthew    59:     my %listitems=(
1.10      www        60:                    'course'       => 'add',
1.29      www        61:                    'goto'         => 'add',
                     62:                    'comefrom'     => 'add',
1.10      www        63:                    'avetries'     => 'avg',
                     64:                    'stdno'        => 'add',
                     65:                    'difficulty'   => 'avg',
                     66:                    'clear'        => 'avg',
                     67:                    'technical'    => 'avg',
                     68:                    'helpful'      => 'avg',
                     69:                    'correct'      => 'avg',
                     70:                    'depth'        => 'avg',
                     71:                    'comments'     => 'app',
                     72:                    'usage'        => 'cnt'
                     73:                    );
1.39      albertel   74:     while ($_=each(%evaldata)) {
                     75: 	my ($item,$purl,$cat)=split(/___/,$_);
                     76: 	### Apache->request->print("\n".$_.' - '.$item.'<br />');
                     77: 	if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }
1.30      www        78:         unless ($listitems{$cat} eq 'app') {
                     79:             if (defined($sum{$cat})) {
                     80:                $sum{$cat}+=$evaldata{$_};
                     81:                $concat{$cat}.=','.$item;
1.10      www        82: 	    } else {
1.30      www        83:                $sum{$cat}=$evaldata{$_};
                     84:                $concat{$cat}=$item;
1.10      www        85: 	    }
                     86:         } else {
1.30      www        87:             if (defined($sum{$cat})) {
1.10      www        88:                if ($evaldata{$_}) {
1.46    ! www        89:                   $sum{$cat}.='<hr />'.$evaldata{$_};
1.10      www        90: 	       }
                     91:  	    } else {
1.30      www        92: 	       $sum{$cat}=''.$evaldata{$_};
1.10      www        93: 	    }
                     94: 	}
                     95:     }
1.9       www        96:     my %returnhash=();
1.39      albertel   97:     while ($_=each(%cnt)) {
1.11      www        98:        if ($listitems{$_} eq 'avg') {
                     99: 	   $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;
                    100:        } elsif ($listitems{$_} eq 'cnt') {
                    101:            $returnhash{$_}=$cnt{$_};
                    102:        } else {
                    103:            $returnhash{$_}=$sum{$_};
                    104:        }
1.30      www       105:        $returnhash{$_.'_list'}=$concat{$_};
1.39      albertel  106:        ### Apache->request->print("\n<hr />".$_.': '.$returnhash{$_}.'<br />'.$returnhash{$_.'_list'});
1.9       www       107:     }
1.40      matthew   108:     #
1.46    ! www       109:     # Deal with 'count' separately
1.40      matthew   110:     $returnhash{'count'} = &access_count($url,$aauthor,$adomain);
                    111: 
1.9       www       112:     return %returnhash;
1.40      matthew   113: }
                    114: 
                    115: sub access_count {
                    116:     my ($src,$author,$adomain) = @_;
                    117:     my %countdata=&Apache::lonnet::dump('nohist_accesscount',$adomain,
                    118:                                         $author,$src);
                    119:     if (! exists($countdata{$src})) {
                    120:         return 'Not Available';
                    121:     } else {
                    122:         return $countdata{$src};
                    123:     }
1.25      www       124: }
                    125: 
                    126: # ------------------------------------- Try to make an alt tag if there is none
                    127: 
                    128: sub alttag {
1.26      www       129:     my ($base,$src)=@_;
                    130:     my $fullpath=&Apache::lonnet::hreflocation($base,$src);
                    131:     my $alttag=&Apache::lonnet::metadata($fullpath,'title').' '.
                    132:                &Apache::lonnet::metadata($fullpath,'subject').' '.
                    133:                &Apache::lonnet::metadata($fullpath,'abstract');
                    134:     $alttag=~s/\s+/ /gs;
                    135:     $alttag=~s/\"//gs;
                    136:     $alttag=~s/\'//gs;
                    137:     $alttag=~s/\s+$//gs;
                    138:     $alttag=~s/^\s+//gs;
                    139:     if ($alttag) { return $alttag; } else 
                    140:                  { return 'No information available'; }
1.9       www       141: }
1.1       www       142: 
1.29      www       143: # -------------------------------------------------------------- Author display
                    144: 
                    145: sub authordisplay {
                    146:     my ($aname,$adom)=@_;
                    147:     return &Apache::loncommon::aboutmewrapper(
                    148:                 &Apache::loncommon::plainname($aname,$adom),
1.46    ! www       149:                     $aname,$adom,'preview').' <tt>['.$aname.'@'.$adom.']</tt>';
1.29      www       150: }
                    151: 
1.12      www       152: # -------------------------------------------------------------- Pretty display
                    153: 
                    154: sub evalgraph {
                    155:     my $value=shift;
1.13      www       156:     unless ($value) { return ''; }
1.12      www       157:     my $val=int($value*10.+0.5)-10;
                    158:     my $output='<table border=0 cellpadding=0 cellspacing=0><tr>';
                    159:     if ($val>=20) {
                    160: 	$output.='<td width=20 bgcolor="#555555">&nbsp&nbsp;</td>';
                    161:     } else {
                    162:         $output.='<td width='.($val).' bgcolor="#555555">&nbsp;</td>'.
                    163:                  '<td width='.(20-$val).' bgcolor="#FF3333">&nbsp;</td>';
                    164:     }
                    165:     $output.='<td bgcolor="#FFFF33">&nbsp;</td>';
                    166:     if ($val>20) {
                    167: 	$output.='<td width='.($val-20).' bgcolor="#33FF33">&nbsp;</td>'.
                    168:                  '<td width='.(40-$val).' bgcolor="#555555">&nbsp;</td>';
                    169:     } else {
                    170:        $output.='<td width=20 bgcolor="#555555">&nbsp&nbsp;</td>';
                    171:     }
                    172:     $output.='<td> ('.$value.') </td></tr></table>';
                    173:     return $output;
                    174: }
                    175: 
                    176: sub diffgraph {
                    177:     my $value=shift;
1.13      www       178:     unless ($value) { return ''; }
1.12      www       179:     my $val=int(40.0*$value+0.5);
1.13      www       180:     my @colors=('#FF9933','#EEAA33','#DDBB33','#CCCC33',
                    181:                 '#BBDD33','#CCCC33','#DDBB33','#EEAA33');
1.12      www       182:     my $output='<table border=0 cellpadding=0 cellspacing=0><tr>';
                    183:     for (my $i=0;$i<8;$i++) {
                    184: 	if ($val>$i*5) {
                    185:             $output.='<td width=5 bgcolor="'.$colors[$i].'">&nbsp;</td>';
                    186:         } else {
                    187: 	    $output.='<td width=5 bgcolor="#555555">&nbsp;</td>';
                    188: 	}
                    189:     }
                    190:     $output.='<td> ('.$value.') </td></tr></table>';
                    191:     return $output;
                    192: }
                    193: 
1.44      www       194: # ==================================================== Turn MySQL row into hash
                    195: 
                    196: sub metadata_col_to_hash {
                    197:     my @cols=@_;
                    198:     my %hash=();
                    199:     for (my $i=0; $i<=$#columns; $i++) {
                    200: 	$hash{$columns[$i]}=$cols[$i];
                    201:     }
                    202:     return %hash;
                    203: }
                    204: 
1.45      www       205: # ============================================================= The field names
                    206: 
                    207: sub fieldnames {
                    208:     return &Apache::lonlocal::texthash(
                    209: 				   'title' => 'Title',
                    210: 				   'author' =>'Author(s)',
                    211: 				   'subject' => 'Subject',
                    212: 				   'keywords' => 'Keyword(s)',
                    213: 				   'notes' => 'Notes',
                    214: 				   'abstract' => 'Abstract',
                    215:                                    'lowestgradelevel' => 'Lowest Grade Level',
                    216:                                    'highestgradelevel' => 'Highest Grade Level',
                    217:                                    'standards' => 'Standards',
                    218: 				   'mime' => 'MIME Type',
                    219: 				   'language' => 'Language',
                    220: 				   'creationdate' => 'Creation Date',
                    221: 				   'lastrevisiondate' => 'Last Revision Date',
                    222: 				   'owner' => 'Publisher/Owner',
                    223:                                    'copyright' => 'Copyright/Distribution',
                    224: 				   'customdistributionfile' => 'Custom Distribution File',
                    225:                                    'obsolete' => 'Obsolete',
                    226: 				   'obsoletereplacement' => 'Suggested Replacement for Obsolete File',
                    227: 				   'count'      => 'Network-wide number of accesses (hits)',
                    228: 				   'course'     => 'Network-wide number of courses using resource',
                    229: 				   'usage'      => 'Number of resources using or importing resource',
                    230: 				   'goto'       => 'Number of resources that follow this resource in maps',
                    231: 				   'comefrom'   => 'Number of resources that lead up to this resource in maps',
                    232: 				   'clear'      => 'Material presented in clear way',
                    233: 				   'depth'      => 'Material covered with sufficient depth',
                    234: 				   'helpful'    => 'Material is helpful',
                    235: 				   'correct'    => 'Material appears to be correct',
                    236: 				   'technical'  => 'Resource is technically correct', 
                    237: 				   'avetries'   => 'Average number of tries till solved',
                    238: 				   'stdno'      => 'Total number of students who have worked on this problem',
                    239: 				   'difficulty' => 'Degree of difficulty'
                    240: 				       );
                    241: }
1.46    ! www       242: 
        !           243: # =========================================== Pretty printing of metadata field
        !           244: 
        !           245: sub prettyprint {
        !           246:     my ($type,$value)=@_;
        !           247:     unless (defined($value)) { return '&nbsp;'; }
        !           248: # Title
        !           249:     if ($type eq 'title') {
        !           250: 	return '<font size="+1" face="arial">'.$value.'</font>';
        !           251:     }
        !           252: # Dates
        !           253:     if (($type eq 'creationdate') ||
        !           254: 	($type eq 'lastrevisiondate')) {
        !           255: 	return &Apache::lonlocal::locallocaltime(
        !           256: 			  &Apache::lonmysql::unsqltime($value));
        !           257:     }
        !           258: # Language
        !           259:     if ($type eq 'language') {
        !           260: 	return &Apache::loncommon::languagedescription($value);
        !           261:     }
        !           262: # Copyright
        !           263:     if ($type eq 'copyright') {
        !           264: 	return &Apache::loncommon::copyrightdescription($value);
        !           265:     }
        !           266: # MIME
        !           267:     if ($type eq 'mime') {
        !           268:        return '<img src="'.&Apache::loncommon::icon($value).'" />&nbsp;'.
        !           269: 	   &Apache::loncommon::filedescription($value);
        !           270:    }
        !           271: # Person
        !           272:     if (($type eq 'author') || 
        !           273: 	($type eq 'owner') ||
        !           274: 	($type eq 'modifyinguser') ||
        !           275: 	($type eq 'authorspace')) {
        !           276: 	$value=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;
        !           277: 	return $value;
        !           278:     }
        !           279: # File
        !           280:     if (($type eq 'customdistributionfile') ||
        !           281: 	($type eq 'obsoletereplacement') ||
        !           282: 	($type eq 'goto_list') ||
        !           283: 	($type eq 'comefrom_list') ||
        !           284: 	($type eq 'sequsage_list')) {
        !           285: 	return join('<br />',map {
        !           286: 	       &Apache::lonnet::gettitle($_).' ['.
        !           287: 	       &Apache::lonhtmlcommon::crumbs(&Apache::lonnet::clutter($_),'preview').']';
        !           288: 	    } split(/\s*\,\s*/,$value));
        !           289:     }
        !           290: # Evaluations
        !           291:     if (($type eq 'clear') ||
        !           292: 	($type eq 'depth') ||
        !           293: 	($type eq 'helpful') ||
        !           294: 	($type eq 'correct') ||
        !           295: 	($type eq 'technical')) {
        !           296: 	return &evalgraph($value);
        !           297:     }
        !           298: # Difficulty
        !           299:     if ($type eq 'difficulty') {
        !           300: 	return &diffgraph($value);
        !           301:     }
        !           302: # List of courses
        !           303:     if ($type=~/\_list/) {
        !           304: 	return join('<br />',map {
        !           305: 	    my %courseinfo=&Apache::lonnet::coursedescription($_);  
        !           306: 	    '<a href="/public/'.
        !           307: 		$courseinfo{'domain'}.'/'.$courseinfo{'num'}.'/syllabus" target="preview">'.
        !           308: 		$courseinfo{'description'}.'</a>';
        !           309: 	} split(/\s*\,\s*/,$value));
        !           310:     }
        !           311: # No pretty print found
        !           312:     return $value;
        !           313: }
        !           314: # ============================================== Pretty input of metadata field
        !           315: 
        !           316: sub prettyinput {
        !           317:     my ($type,$value,$fieldname)=@_;
        !           318: }
        !           319: 
1.1       www       320: # ================================================================ Main Handler
                    321: 
                    322: sub handler {
                    323:   my $r=shift;
1.20      www       324: 
                    325:     my $loaderror=&Apache::lonnet::overloaderror($r);
                    326:     if ($loaderror) { return $loaderror; }
                    327: 
                    328: 
                    329:     my $uri=$r->uri;
                    330: 
1.23      www       331:   unless ($uri=~/^\/\~/) { 
                    332: # =========================================== This is not in construction space
1.20      www       333:     my ($resdomain,$resuser)=
                    334:            (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
                    335: 
                    336:     $loaderror=
                    337:        &Apache::lonnet::overloaderror($r,
                    338:          &Apache::lonnet::homeserver($resuser,$resdomain));
                    339:     if ($loaderror) { return $loaderror; }
                    340: 
1.3       www       341:   my %content=();
1.1       www       342: 
                    343: # ----------------------------------------------------------- Set document type
                    344: 
1.35      www       345:   &Apache::loncommon::content_type($r,'text/html');
1.1       www       346:   $r->send_http_header;
                    347: 
                    348:   return OK if $r->header_only;
                    349: 
                    350: # ------------------------------------------------------------------- Read file
1.14      harris41  351:   foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
1.3       www       352:       $content{$_}=&Apache::lonnet::metadata($uri,$_);
1.14      harris41  353:   }
1.6       albertel  354: # ------------------------------------------------------------------ Hide stuff
1.7       www       355: 
                    356:   unless ($ENV{'user.adv'}) {
1.14      harris41  357:       foreach ('keywords','notes','abstract','subject') {
1.35      www       358:           $content{$_}='<i>- '.&mt('not displayed').' -</i>';
1.14      harris41  359:       }
1.6       albertel  360:   }
                    361: 
1.1       www       362: # --------------------------------------------------------------- Render Output
1.46    ! www       363: # displayed url
1.45      www       364:     my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
1.46    ! www       365:     my $disuri=&Apache::lonnet::clutter($uri);
1.45      www       366:     $disuri=~s/\.meta$//;
1.46    ! www       367:     $disuri=&Apache::lonhtmlcommon::crumbs($disuri);
        !           368: # version
1.45      www       369:     my $currentversion=&Apache::lonnet::getversion($disuri);
                    370:     my $versiondisplay='';
                    371:     if ($thisversion) {
                    372: 	$versiondisplay=&mt('Version').': '.$thisversion.
                    373: 	    ' ('.&mt('most recent version').': '.$currentversion.')';
                    374:     } else {
                    375: 	$versiondisplay='Version: '.$currentversion;
                    376:     }
1.46    ! www       377: # obsolete
1.45      www       378:     my $obsolete=$content{'obsolete'};
                    379:     my $obsoletewarning='';
                    380:     if (($obsolete) && ($ENV{'user.adv'})) {
                    381: 	$obsoletewarning='<p><font color="red">'.
                    382: 	    &mt('This resource has been marked obsolete by the author(s)').'</font></p>';
                    383:     }
1.36      www       384: 
1.45      www       385:     my %lt=&fieldnames();
                    386:     my $table='';
                    387:     my $bodytag=&Apache::loncommon::bodytag
                    388:             ('Catalog Information','','','',$resdomain);
                    389:     foreach ('title', 
                    390: 	     'author', 
                    391: 	     'subject', 
                    392: 	     'keywords', 
                    393: 	     'notes', 
                    394: 	     'abstract', 
                    395: 	     'mime', 
                    396: 	     'language', 
                    397: 	     'creationdate', 
                    398: 	     'lastrevisiondate', 
                    399: 	     'owner', 
                    400: 	     'copyright', 
                    401: 	     'customdistributionfile', 
                    402: 	     'obsolete', 
                    403: 	     'obsoletereplacement') {
                    404: 	$table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.
                    405: 	        '</td><td bgcolor="#CCCCCC">'.
1.46    ! www       406:                 &prettyprint($_,$content{$_}).'</td></tr>';
1.45      www       407: 	delete $content{$_};
                    408:     }
1.36      www       409: 
1.1       www       410:   $r->print(<<ENDHEAD);
                    411: <html><head><title>Catalog Information</title></head>
1.17      www       412: $bodytag
1.1       www       413: <h2>$content{'title'}</h2>
1.11      www       414: <h3><tt>$disuri</tt></h3>
1.36      www       415: $obsoletewarning
1.21      www       416: $versiondisplay<br />
1.11      www       417: <table cellspacing=2 border=0>
1.45      www       418: $table
1.11      www       419: </table>
1.1       www       420: ENDHEAD
1.7       www       421:   if ($ENV{'user.adv'}) {
1.11      www       422: # ------------------------------------------------------------ Dynamic Metadata
1.15      www       423:    $r->print(
1.35      www       424:    '<h3>'.&mt('Dynamic Metadata').' ('.
                    425: 	     &mt('updated periodically').')</h3>'.&mt('Processing').
                    426: 	     ' ...<br>');
1.15      www       427:    $r->rflush();
1.45      www       428:    my %items=&fieldnames();
1.10      www       429:    my %dynmeta=&dynamicmeta($uri);
1.11      www       430:    $r->print(
1.35      www       431: '</table><h4>'.&mt('Access and Usage Statistics').'</h4><table cellspacing=2 border=0>');
1.30      www       432:    foreach ('count') {
                    433:        $r->print(
                    434: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
                    435: $dynmeta{$_}."&nbsp;</td></tr>\n");
                    436:    }
                    437:    foreach my $cat ('usage','comefrom','goto') {
                    438:        $r->print(
                    439: '<tr><td bgcolor="#AAAAAA">'.$items{$cat}.'</td><td bgcolor="#CCCCCC">'.
1.31      www       440: $dynmeta{$cat}.'<font size="-1"><ul>'.join("\n",
                    441:       map { my $murl=$_; 
                    442:  '<li><a href="'.&Apache::lonnet::clutter($murl).'" target="preview">'.
                    443:                         &Apache::lonnet::gettitle($murl).' [<tt>'.$murl
                    444:                         .'</tt>]</a></li>' }
                    445:       split(/\,/,$dynmeta{$cat.'_list'}))."</ul></font></td></tr>\n");
1.30      www       446:    }
1.31      www       447:    foreach my $cat ('course') {
1.11      www       448:        $r->print(
1.31      www       449: '<tr><td bgcolor="#AAAAAA">'.$items{$cat}.'</td><td bgcolor="#CCCCCC">'.
                    450: $dynmeta{$cat}.'<font size="-1"><ul>'.join("\n",
                    451:       map { my %courseinfo=&Apache::lonnet::coursedescription($_);  
                    452:  '<li><a href="/public/'.
                    453:   $courseinfo{'domain'}.'/'.$courseinfo{'num'}.'/syllabus" target="preview">'.
                    454:   $courseinfo{'description'}.'</a></li>' }
                    455:       split(/\,/,$dynmeta{$cat.'_list'}))."</ul></font></td></tr>\n");
1.11      www       456:    }
                    457:        $r->print('</table>');
1.10      www       458:    if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {
1.11      www       459:       $r->print(
1.35      www       460: '<h4>'.&mt('Assessment Statistical Data').'</h4><table cellspacing=2 border=0>');
1.12      www       461:       foreach ('stdno','avetries') {
1.11      www       462:           $r->print(
                    463: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
                    464: $dynmeta{$_}."&nbsp;</td></tr>\n");
                    465:       }
1.12      www       466:       foreach ('difficulty') {
                    467:          $r->print(
                    468: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
                    469: &diffgraph($dynmeta{$_})."</td></tr>\n");
                    470:       }
1.11      www       471:       $r->print('</table>');    
1.10      www       472:    }
1.35      www       473:    $r->print('<h4>'.&mt('Evaluation Data').'</h4><table cellspacing=2 border=0>');
1.10      www       474:    foreach ('clear','depth','helpful','correct','technical') {
1.11      www       475:        $r->print(
                    476: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
1.12      www       477: &evalgraph($dynmeta{$_})."</td></tr>\n");
1.10      www       478:    }    
1.11      www       479:    $r->print('</table>');
                    480:    $disuri=~/^(\w+)\/(\w+)\//;   
1.10      www       481:    if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))
                    482:        || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
                    483:       $r->print(
1.35      www       484:   '<h4>'.&mt('Evaluation Comments').' ('.&mt('visible to author and co-authors only').')</h4>'.
1.23      www       485:       '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
                    486:       $r->print(
1.37      www       487:    '<h4>'.&mt('Error Messages').' ('.
                    488:           &mt('visible to author and co-authors only').')</h4>');
1.23      www       489:       my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$1,$2);
                    490:       foreach (keys %errormsgs) {
1.28      albertel  491: 	if ($_=~/^\Q$disuri\E\_\d+$/) {
1.23      www       492:           my %content=&Apache::lonmsg::unpackagemsg($errormsgs{$_});
                    493: 	  $r->print('<b>'.$content{'time'}.'</b>: '.$content{'message'}.
                    494:                     '<br />');
                    495:         }
                    496:       }      
1.10      www       497:    }
1.11      www       498: # ------------------------------------------------------------- All other stuff
1.10      www       499:    $r->print(
1.35      www       500:  '<h3>'.&mt('Additional Metadata (non-standard, parameters, exports)').'</h3>');
1.10      www       501:    foreach (sort keys %content) {
1.3       www       502:       my $name=$_;
1.33      www       503:       unless ($name=~/\.display$/) {
                    504: 	  my $display=&Apache::lonnet::metadata($uri,$name.'.display');
                    505: 	  unless ($display) { $display=$name; };
                    506: 	  my $otherinfo='';
                    507: 	  foreach ('name','part','type','default') {
                    508: 	      if (defined(&Apache::lonnet::metadata($uri,$name.'.'.$_))) {
                    509: 		  $otherinfo.=' '.$_.'='.
                    510: 		      &Apache::lonnet::metadata($uri,$name.'.'.$_).'; ';
                    511: 	      }
                    512: 	  }
                    513: 	  $r->print('<b>'.$display.':</b> '.$content{$name});
                    514: 	  if ($otherinfo) {
                    515: 	      $r->print(' ('.$otherinfo.')');
                    516: 	  }
                    517: 	  $r->print("<br>\n");
1.14      harris41  518:       }
1.10      www       519:    }
1.7       www       520:   }
1.23      www       521: # ===================================================== End Resource Space Call
                    522:  } else {
                    523: # ===================================================== Construction Space Call
                    524: 
                    525: # ----------------------------------------------------------- Set document type
                    526: 
1.45      www       527:   &Apache::loncommon::content_type($r,'text/html');
1.23      www       528:   $r->send_http_header;
                    529: 
                    530:   return OK if $r->header_only;
                    531: # ---------------------------------------------------------------------- Header
                    532:   my $bodytag=&Apache::loncommon::bodytag('Edit Catalog Information');
                    533:   my $disuri=$uri;
                    534:   my $fn=&Apache::lonnet::filelocation('',$uri);
                    535:   $disuri=~s/^\/\~\w+//;
                    536:   $disuri=~s/\.meta$//;
                    537:   my $displayfile='Catalog Information for '.$disuri;
                    538:   if ($disuri=~/\/default$/) {
                    539:       my $dir=$disuri;
                    540:       $dir=~s/default$//;
1.37      www       541:       $displayfile=&mt('Default Cataloging Information for Directory').' '.
                    542: 	  $dir;
1.23      www       543:   }
                    544:   %Apache::lonpublisher::metadatafields=();
                    545:   %Apache::lonpublisher::metadatakeys=();
                    546:   &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));
                    547:   $r->print(<<ENDEDIT);
                    548: <html><head><title>Edit Catalog Information</title></head>
                    549: $bodytag
                    550: <h1>$displayfile</h1>
1.24      www       551: <form method="post">
1.23      www       552: ENDEDIT
1.45      www       553:    my %lt=&fieldnames();
1.24      www       554:    foreach ('author','title','subject','keywords','abstract','notes',
1.37      www       555:             'copyright','customdistributionfile','language',
                    556:             'obsolete','obsoletereplacement') {
1.24      www       557:        if ($ENV{'form.new_'.$_}) {
                    558: 	   $Apache::lonpublisher::metadatafields{$_}=$ENV{'form.new_'.$_};
                    559:        }
1.32      albertel  560:        if (m/copyright/) {
1.45      www       561: 	   $r->print(&Apache::lonpublisher::selectbox($lt{$_},'new_'.$_,
1.41      www       562: 			       ($Apache::lonpublisher::metadatafields{$_}?
                    563: 				$Apache::lonpublisher::metadatafields{$_}:'default'),
1.32      albertel  564: 			       \&Apache::loncommon::copyrightdescription,
                    565: 			       (&Apache::loncommon::copyrightids)));
                    566:        } elsif (m/language/) {
1.45      www       567: 	   $r->print(&Apache::lonpublisher::selectbox($lt{$_},'new_'.$_,
1.32      albertel  568: 			      $Apache::lonpublisher::metadatafields{$_},
                    569: 			      \&Apache::loncommon::languagedescription,
                    570: 			      (&Apache::loncommon::languageids)));
                    571:        } else {
1.45      www       572: 	   $r->print(&Apache::lonpublisher::textfield($lt{$_},'new_'.$_,
1.32      albertel  573: 			     $Apache::lonpublisher::metadatafields{$_}));
                    574:        }
1.23      www       575:    }
1.24      www       576:    if ($ENV{'form.store'}) {
                    577:       my $mfh;
                    578:       unless ($mfh=Apache::File->new('>'.$fn)) {
                    579:             $r->print(
1.37      www       580:             '<p><font color=red>'.&mt('Could not write metadata').', '.
                    581: 		      &mt('FAIL').'</font>');
1.24      www       582:       } else {
                    583:           foreach (sort keys %Apache::lonpublisher::metadatafields) {
                    584:             unless ($_=~/\./) {
                    585:                 my $unikey=$_;
                    586:                 $unikey=~/^([A-Za-z]+)/;
                    587:                 my $tag=$1;
                    588:                 $tag=~tr/A-Z/a-z/;
                    589:                 print $mfh "\n\<$tag";
                    590:                 foreach 
                    591:                   (split(/\,/,$Apache::lonpublisher::metadatakeys{$unikey})) {
                    592:                     my $value=
                    593:                        $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
                    594:                     $value=~s/\"/\'\'/g;
                    595:                     print $mfh ' '.$_.'="'.$value.'"';
                    596:                 }
                    597:                 print $mfh '>'.
                    598:         &HTML::Entities::encode($Apache::lonpublisher::metadatafields{$unikey})
                    599:                         .'</'.$tag.'>';
                    600:             }
                    601: 	  }
1.37      www       602:           $r->print('<p>'.&mt('Wrote Metadata'));
1.24      www       603:       }
                    604:     }
                    605:     $r->print(
1.37      www       606:  '<br /><input type="submit" name="store" value="'.
                    607: &mt('Store Catalog Information').'"></form></body></html>');
1.24      www       608:     return OK;
                    609:   }
1.1       www       610: }
                    611: 
1.44      www       612: # ================================================================= BEGIN Block
                    613: BEGIN {
                    614: # Get columns of MySQL metadata table
                    615:     @columns=&Apache::lonmysql::col_order('metadata');
                    616: }
1.1       www       617: 1;
                    618: __END__
                    619: 
                    620: 
                    621: 
                    622: 
                    623: 
                    624: 
                    625: 

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