File:  [LON-CAPA] / loncom / interface / lonmeta.pm
Revision 1.43: download - view: text, annotated - select for diffs
Fri Dec 26 21:17:37 2003 UTC (20 years, 5 months ago) by www
Branches: MAIN
CVS tags: HEAD
No need to have the same subroutine unsqltime twice - lonmysql is the better
place for it.

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

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