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

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

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