File:  [LON-CAPA] / loncom / interface / lonmeta.pm
Revision 1.18: download - view: text, annotated - select for diffs
Mon Aug 26 17:02:47 2002 UTC (21 years, 9 months ago) by www
Branches: MAIN
CVS tags: HEAD
Oops, forgot to remove <body>-tag

    1: # The LearningOnline Network with CAPA
    2: # Metadata display handler
    3: #
    4: # $Id: lonmeta.pm,v 1.18 2002/08/26 17:02:47 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: 
   41: # ----------------------------------------- Fetch and evaluate dynamic metadata
   42: 
   43: sub dynamicmeta {
   44:     my $url=&Apache::lonnet::declutter(shift);
   45:     $url=~s/\.meta$//;
   46:     my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);
   47:     my $regexp=&Apache::lonnet::escape($url);
   48:     $regexp=~s/(\W)/\\$1/g;
   49:     $regexp='___'.$regexp.'___';
   50:     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
   51: 				       $aauthor,$regexp);
   52:     my %sum;
   53:     my %cnt;
   54:     my %listitems=('count'        => 'add',
   55:                    'course'       => 'add',
   56:                    'avetries'     => 'avg',
   57:                    'stdno'        => 'add',
   58:                    'difficulty'   => 'avg',
   59:                    'clear'        => 'avg',
   60:                    'technical'    => 'avg',
   61:                    'helpful'      => 'avg',
   62:                    'correct'      => 'avg',
   63:                    'depth'        => 'avg',
   64:                    'comments'     => 'app',
   65:                    'usage'        => 'cnt'
   66:                    );
   67:     foreach (keys %evaldata) {
   68: 	$_=~/___(\w+)$/;
   69:         if (defined($cnt{$1})) { $cnt{$1}++; } else { $cnt{$1}=1; }
   70:         unless ($listitems{$1} eq 'app') {
   71:             if (defined($sum{$1})) {
   72:                $sum{$1}+=$evaldata{$_};
   73: 	    } else {
   74:                $sum{$1}=$evaldata{$_};
   75: 	    }
   76:         } else {
   77:             if (defined($sum{$1})) {
   78:                if ($evaldata{$_}) {
   79:                   $sum{$1}.='<hr>'.$evaldata{$_};
   80: 	       }
   81:  	    } else {
   82: 	       $sum{$1}=''.$evaldata{$_};
   83: 	    }
   84: 	}
   85:     }
   86:     my %returnhash=();
   87:     foreach (keys %cnt) {
   88:        if ($listitems{$_} eq 'avg') {
   89: 	   $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;
   90:        } elsif ($listitems{$_} eq 'cnt') {
   91:            $returnhash{$_}=$cnt{$_};
   92:        } else {
   93:            $returnhash{$_}=$sum{$_};
   94:        }
   95:     }
   96:     return %returnhash;
   97: }
   98: 
   99: # -------------------------------------------------------------- Pretty display
  100: 
  101: sub evalgraph {
  102:     my $value=shift;
  103:     unless ($value) { return ''; }
  104:     my $val=int($value*10.+0.5)-10;
  105:     my $output='<table border=0 cellpadding=0 cellspacing=0><tr>';
  106:     if ($val>=20) {
  107: 	$output.='<td width=20 bgcolor="#555555">&nbsp&nbsp;</td>';
  108:     } else {
  109:         $output.='<td width='.($val).' bgcolor="#555555">&nbsp;</td>'.
  110:                  '<td width='.(20-$val).' bgcolor="#FF3333">&nbsp;</td>';
  111:     }
  112:     $output.='<td bgcolor="#FFFF33">&nbsp;</td>';
  113:     if ($val>20) {
  114: 	$output.='<td width='.($val-20).' bgcolor="#33FF33">&nbsp;</td>'.
  115:                  '<td width='.(40-$val).' bgcolor="#555555">&nbsp;</td>';
  116:     } else {
  117:        $output.='<td width=20 bgcolor="#555555">&nbsp&nbsp;</td>';
  118:     }
  119:     $output.='<td> ('.$value.') </td></tr></table>';
  120:     return $output;
  121: }
  122: 
  123: sub diffgraph {
  124:     my $value=shift;
  125:     unless ($value) { return ''; }
  126:     my $val=int(40.0*$value+0.5);
  127:     my @colors=('#FF9933','#EEAA33','#DDBB33','#CCCC33',
  128:                 '#BBDD33','#CCCC33','#DDBB33','#EEAA33');
  129:     my $output='<table border=0 cellpadding=0 cellspacing=0><tr>';
  130:     for (my $i=0;$i<8;$i++) {
  131: 	if ($val>$i*5) {
  132:             $output.='<td width=5 bgcolor="'.$colors[$i].'">&nbsp;</td>';
  133:         } else {
  134: 	    $output.='<td width=5 bgcolor="#555555">&nbsp;</td>';
  135: 	}
  136:     }
  137:     $output.='<td> ('.$value.') </td></tr></table>';
  138:     return $output;
  139: }
  140: 
  141: # ================================================================ Main Handler
  142: 
  143: sub handler {
  144:   my $r=shift;
  145:   my %content=();
  146: 
  147: # ----------------------------------------------------------- Set document type
  148: 
  149:   $r->content_type('text/html');
  150:   $r->send_http_header;
  151: 
  152:   return OK if $r->header_only;
  153: 
  154: # ------------------------------------------------------------------- Read file
  155: 
  156:   my $uri=$r->uri;
  157:   foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
  158:       $content{$_}=&Apache::lonnet::metadata($uri,$_);
  159:   }
  160:   my ($resdomain)=(&Apache::lonnet::declutter($uri)=~/^(\w+)\//);
  161: # ------------------------------------------------------------------ Hide stuff
  162: 
  163:   unless ($ENV{'user.adv'}) {
  164:       foreach ('keywords','notes','abstract','subject') {
  165:           $content{$_}='<i>- not displayed -</i>';
  166:       }
  167:   }
  168: 
  169: # --------------------------------------------------------------- Render Output
  170: 
  171: my $creationdate=localtime($content{'creationdate'});
  172: my $lastrevisiondate=localtime($content{'lastrevisiondate'});
  173: my $language=&Apache::loncommon::languagedescription($content{'language'});
  174: my $mime=&Apache::loncommon::filedescription($content{'mime'}); 
  175: my $disuri=&Apache::lonnet::declutter($uri);
  176:   $disuri=~s/\.meta$//;
  177: my $bodytag=&Apache::loncommon::bodytag
  178:             ('Catalog Information','','','',$resdomain);
  179:   $r->print(<<ENDHEAD);
  180: <html><head><title>Catalog Information</title></head>
  181: $bodytag
  182: <h2>$content{'title'}</h2>
  183: <h3><tt>$disuri</tt></h3>
  184: <table cellspacing=2 border=0>
  185: <tr><td bgcolor='#AAAAAA'>Author(s)</td>
  186: <td bgcolor="#CCCCCC">$content{'author'}&nbsp;</td></tr>
  187: <tr><td bgcolor='#AAAAAA'>Subject</td>
  188: <td bgcolor="#CCCCCC">$content{'subject'}&nbsp;</td></tr>
  189: <tr><td bgcolor='#AAAAAA'>Keyword(s)</td>
  190: <td bgcolor="#CCCCCC">$content{'keywords'}&nbsp;</td></tr>
  191: <tr><td bgcolor='#AAAAAA'>Notes</td>
  192: <td bgcolor="#CCCCCC">$content{'notes'}&nbsp;</td></tr>
  193: <tr><td bgcolor='#AAAAAA'>Abstract</td>
  194: <td bgcolor="#CCCCCC">$content{'abstract'}&nbsp;</td></tr>
  195: <tr><td bgcolor='#AAAAAA'>MIME Type</td>
  196: <td bgcolor="#CCCCCC">$mime ($content{'mime'})&nbsp;</td></tr>
  197: <tr><td bgcolor='#AAAAAA'>Language</td>
  198: <td bgcolor="#CCCCCC">$language&nbsp;</td></tr>
  199: <tr><td bgcolor='#AAAAAA'>Creation Date</td>
  200: <td bgcolor="#CCCCCC">$creationdate&nbsp;</td></tr>
  201: <tr><td bgcolor='#AAAAAA'>
  202: Last Revision Date</td><td bgcolor="#CCCCCC">$lastrevisiondate&nbsp;</td></tr>
  203: <tr><td bgcolor='#AAAAAA'>Publisher/Owner</td>
  204: <td bgcolor="#CCCCCC">$content{'owner'}&nbsp;</td></tr>
  205: <tr><td bgcolor='#AAAAAA'>Copyright/Distribution</td>
  206: <td bgcolor="#CCCCCC">$content{'copyright'}
  207: </table>
  208: ENDHEAD
  209:   delete($content{'title'});
  210:   delete($content{'author'});
  211:   delete($content{'subject'});
  212:   delete($content{'keywords'});
  213:   delete($content{'notes'});
  214:   delete($content{'abstract'});
  215:   delete($content{'mime'});
  216:   delete($content{'language'});
  217:   delete($content{'creationdate'});
  218:   delete($content{'lastrevisiondate'});
  219:   delete($content{'owner'});
  220:   delete($content{'copyright'});
  221:   if ($ENV{'user.adv'}) {
  222: # ------------------------------------------------------------ Dynamic Metadata
  223:    $r->print(
  224:    '<h3>Dynamic Metadata (updated periodically)</h3>Processing ...<br>');
  225:    $r->rflush();
  226:     my %items=(
  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:  'clear'      => 'Material presented in clear way',
  231:  'depth'      => 'Material covered with sufficient depth',
  232:  'helpful'    => 'Material is helpful',
  233:  'correct'    => 'Material appears to be correct',
  234:  'technical'  => 'Resource is technically correct', 
  235:  'avetries'   => 'Average number of tries till solved',
  236:  'stdno'      => 'Total number of students who have worked on this problem',
  237:  'difficulty' => 'Degree of difficulty');
  238:    my %dynmeta=&dynamicmeta($uri);
  239:    $r->print(
  240: '</table><h4>Access and Usage Statistics</h4><table cellspacing=2 border=0>');
  241:    foreach ('count','usage','course') {
  242:        $r->print(
  243: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
  244: $dynmeta{$_}."&nbsp;</td></tr>\n");
  245:    }
  246:        $r->print('</table>');
  247:    if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {
  248:       $r->print(
  249: '<h4>Assessment Statistical Data</h4><table cellspacing=2 border=0>');
  250:       foreach ('stdno','avetries') {
  251:           $r->print(
  252: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
  253: $dynmeta{$_}."&nbsp;</td></tr>\n");
  254:       }
  255:       foreach ('difficulty') {
  256:          $r->print(
  257: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
  258: &diffgraph($dynmeta{$_})."</td></tr>\n");
  259:       }
  260:       $r->print('</table>');    
  261:    }
  262:    $r->print('<h4>Evaluation Data</h4><table cellspacing=2 border=0>');
  263:    foreach ('clear','depth','helpful','correct','technical') {
  264:        $r->print(
  265: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
  266: &evalgraph($dynmeta{$_})."</td></tr>\n");
  267:    }    
  268:    $r->print('</table>');
  269:    $disuri=~/^(\w+)\/(\w+)\//;   
  270:    if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))
  271:        || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
  272:       $r->print(
  273:   '<h4>Evaluation Comments (visible to author and co-authors only)</h4>'.
  274:       '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');      
  275:    }
  276: # ------------------------------------------------------------- All other stuff
  277:    $r->print(
  278:  '<h3>Additional Metadata (non-standard, parameters, exports)</h3>');
  279:    foreach (sort keys %content) {
  280:       my $name=$_;
  281:       my $display=&Apache::lonnet::metadata($uri,$name.'.display');
  282:       unless ($display) { $display=$name; };
  283:       my $otherinfo='';
  284:       foreach ('name','part','type','default') {
  285:           if (defined(&Apache::lonnet::metadata($uri,$name.'.'.$_))) {
  286:              $otherinfo.=' '.$_.'='.
  287: 		 &Apache::lonnet::metadata($uri,$name.'.'.$_).'; ';
  288:           }
  289:       }
  290:       $r->print('<b>'.$display.':</b> '.$content{$name});
  291:       if ($otherinfo) {
  292:          $r->print(' ('.$otherinfo.')');
  293:       }
  294:       $r->print("<br>\n");
  295:    }
  296:   }
  297:   $r->print('</body></html>');
  298:   return OK;
  299: }
  300: 
  301: 1;
  302: __END__
  303: 
  304: 
  305: 
  306: 
  307: 
  308: 
  309: 

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