loncom/interface/lonmeta.pm - view

File: [LON-CAPA] / loncom / interface / lonmeta.pm
Revision 1.27: download - view: text, annotated - select for diffs
Fri Mar 14 02:26:12 2003 UTC (21 years, 3 months ago) by www
Branches: MAIN
CVS tags: HEAD

Towards bugs #662 - add customized rights of use (multiple domains,
specific courses, etc).
* Adds new extension ".rights" and handler lonrights.pm for editing and
viewing (not implemented yet)
* Adds new "copyright" metadata value "custom"
* Adds new metadata-field "customdistributionfile" to ".rights" file
(active only if copyright=custom)
* Author can cover large number of resources by one ".rights" file -
if distribution changes, only that one files needs republishing (like
a ".library" file)

1: # The LearningOnline Network with CAPA 2: # Metadata display handler 3: # 4: # $Id: lonmeta.pm,v 1.27 2003/03/14 02:26:12 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: 43: # ----------------------------------------- Fetch and evaluate dynamic metadata 44: 45: sub dynamicmeta { 46: my $url=&Apache::lonnet::declutter(shift); 47: $url=~s/\.meta$//; 48: my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//); 49: my $regexp=$url; 50: $regexp=~s/(\W)/\\$1/g; 51: $regexp='___'.$regexp.'___'; 52: my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain, 53: $aauthor,$regexp); 54: my %sum; 55: my %cnt; 56: my %listitems=('count' => 'add', 57: 'course' => 'add', 58: 'avetries' => 'avg', 59: 'stdno' => 'add', 60: 'difficulty' => 'avg', 61: 'clear' => 'avg', 62: 'technical' => 'avg', 63: 'helpful' => 'avg', 64: 'correct' => 'avg', 65: 'depth' => 'avg', 66: 'comments' => 'app', 67: 'usage' => 'cnt' 68: ); 69: foreach (keys %evaldata) { 70: $_=~/___(\w+)$/; 71: if (defined($cnt{$1})) { $cnt{$1}++; } else { $cnt{$1}=1; } 72: unless ($listitems{$1} eq 'app') { 73: if (defined($sum{$1})) { 74: $sum{$1}+=$evaldata{$_}; 75: } else { 76: $sum{$1}=$evaldata{$_}; 77: } 78: } else { 79: if (defined($sum{$1})) { 80: if ($evaldata{$_}) { 81: $sum{$1}.='<hr>'.$evaldata{$_}; 82: } 83: } else { 84: $sum{$1}=''.$evaldata{$_}; 85: } 86: } 87: } 88: my %returnhash=(); 89: foreach (keys %cnt) { 90: if ($listitems{$_} eq 'avg') { 91: $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0; 92: } elsif ($listitems{$_} eq 'cnt') { 93: $returnhash{$_}=$cnt{$_}; 94: } else { 95: $returnhash{$_}=$sum{$_}; 96: } 97: } 98: return %returnhash; 99: } 100: 101: # ------------------------------------- Try to make an alt tag if there is none 102: 103: sub alttag { 104: my ($base,$src)=@_; 105: my $fullpath=&Apache::lonnet::hreflocation($base,$src); 106: my $alttag=&Apache::lonnet::metadata($fullpath,'title').' '. 107: &Apache::lonnet::metadata($fullpath,'subject').' '. 108: &Apache::lonnet::metadata($fullpath,'abstract'); 109: $alttag=~s/\s+/ /gs; 110: $alttag=~s/\"//gs; 111: $alttag=~s/\'//gs; 112: $alttag=~s/\s+$//gs; 113: $alttag=~s/^\s+//gs; 114: if ($alttag) { return $alttag; } else 115: { return 'No information available'; } 116: } 117: 118: # -------------------------------------------------------------- Pretty display 119: 120: sub evalgraph { 121: my $value=shift; 122: unless ($value) { return ''; } 123: my $val=int($value*10.+0.5)-10; 124: my $output='<table border=0 cellpadding=0 cellspacing=0><tr>'; 125: if ($val>=20) { 126: $output.='<td width=20 bgcolor="#555555">&nbsp </td>'; 127: } else { 128: $output.='<td width='.($val).' bgcolor="#555555"> </td>'. 129: '<td width='.(20-$val).' bgcolor="#FF3333"> </td>'; 130: } 131: $output.='<td bgcolor="#FFFF33"> </td>'; 132: if ($val>20) { 133: $output.='<td width='.($val-20).' bgcolor="#33FF33"> </td>'. 134: '<td width='.(40-$val).' bgcolor="#555555"> </td>'; 135: } else { 136: $output.='<td width=20 bgcolor="#555555">&nbsp </td>'; 137: } 138: $output.='<td> ('.$value.') </td></tr></table>'; 139: return $output; 140: } 141: 142: sub diffgraph { 143: my $value=shift; 144: unless ($value) { return ''; } 145: my $val=int(40.0*$value+0.5); 146: my @colors=('#FF9933','#EEAA33','#DDBB33','#CCCC33', 147: '#BBDD33','#CCCC33','#DDBB33','#EEAA33'); 148: my $output='<table border=0 cellpadding=0 cellspacing=0><tr>'; 149: for (my $i=0;$i<8;$i++) { 150: if ($val>$i*5) { 151: $output.='<td width=5 bgcolor="'.$colors[$i].'"> </td>'; 152: } else { 153: $output.='<td width=5 bgcolor="#555555"> </td>'; 154: } 155: } 156: $output.='<td> ('.$value.') </td></tr></table>'; 157: return $output; 158: } 159: 160: # ================================================================ Main Handler 161: 162: sub handler { 163: my $r=shift; 164: 165: my $loaderror=&Apache::lonnet::overloaderror($r); 166: if ($loaderror) { return $loaderror; } 167: 168: 169: my $uri=$r->uri; 170: 171: unless ($uri=~/^\/\~/) { 172: # =========================================== This is not in construction space 173: my ($resdomain,$resuser)= 174: (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//); 175: 176: $loaderror= 177: &Apache::lonnet::overloaderror($r, 178: &Apache::lonnet::homeserver($resuser,$resdomain)); 179: if ($loaderror) { return $loaderror; } 180: 181: my %content=(); 182: 183: # ----------------------------------------------------------- Set document type 184: 185: $r->content_type('text/html'); 186: $r->send_http_header; 187: 188: return OK if $r->header_only; 189: 190: # ------------------------------------------------------------------- Read file 191: foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) { 192: $content{$_}=&Apache::lonnet::metadata($uri,$_); 193: } 194: # ------------------------------------------------------------------ Hide stuff 195: 196: unless ($ENV{'user.adv'}) { 197: foreach ('keywords','notes','abstract','subject') { 198: $content{$_}='<i>- not displayed -</i>'; 199: } 200: } 201: 202: # --------------------------------------------------------------- Render Output 203: my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/); 204: my $creationdate=localtime( 205: &Apache::loncommon::unsqltime($content{'creationdate'})); 206: my $lastrevisiondate=localtime( 207: &Apache::loncommon::unsqltime($content{'lastrevisiondate'})); 208: my $language=&Apache::loncommon::languagedescription($content{'language'}); 209: my $mime=&Apache::loncommon::filedescription($content{'mime'}); 210: my $disuri=&Apache::lonnet::declutter($uri); 211: $disuri=~s/\.meta$//; 212: my $currentversion=&Apache::lonnet::getversion($disuri); 213: my $versiondisplay=''; 214: if ($thisversion) { 215: $versiondisplay='Version: '.$thisversion. 216: ' (most recent version: '.$currentversion.')'; 217: } else { 218: $versiondisplay='Version: '.$currentversion; 219: } 220: my $bodytag=&Apache::loncommon::bodytag 221: ('Catalog Information','','','',$resdomain); 222: $r->print(<<ENDHEAD); 223: <html><head><title>Catalog Information</title></head> 224: $bodytag 225: <h2>$content{'title'}</h2> 226: <h3><tt>$disuri</tt></h3> 227: $versiondisplay<br /> 228: <table cellspacing=2 border=0> 229: <tr><td bgcolor='#AAAAAA'>Author(s)</td> 230: <td bgcolor="#CCCCCC">$content{'author'} </td></tr> 231: <tr><td bgcolor='#AAAAAA'>Subject</td> 232: <td bgcolor="#CCCCCC">$content{'subject'} </td></tr> 233: <tr><td bgcolor='#AAAAAA'>Keyword(s)</td> 234: <td bgcolor="#CCCCCC">$content{'keywords'} </td></tr> 235: <tr><td bgcolor='#AAAAAA'>Notes</td> 236: <td bgcolor="#CCCCCC">$content{'notes'} </td></tr> 237: <tr><td bgcolor='#AAAAAA'>Abstract</td> 238: <td bgcolor="#CCCCCC">$content{'abstract'} </td></tr> 239: <tr><td bgcolor='#AAAAAA'>MIME Type</td> 240: <td bgcolor="#CCCCCC">$mime ($content{'mime'}) </td></tr> 241: <tr><td bgcolor='#AAAAAA'>Language</td> 242: <td bgcolor="#CCCCCC">$language </td></tr> 243: <tr><td bgcolor='#AAAAAA'>Creation Date</td> 244: <td bgcolor="#CCCCCC">$creationdate </td></tr> 245: <tr><td bgcolor='#AAAAAA'> 246: Last Revision Date</td><td bgcolor="#CCCCCC">$lastrevisiondate </td></tr> 247: <tr><td bgcolor='#AAAAAA'>Publisher/Owner</td> 248: <td bgcolor="#CCCCCC">$content{'owner'} </td></tr> 249: <tr><td bgcolor='#AAAAAA'>Copyright/Distribution</td> 250: <td bgcolor="#CCCCCC">$content{'copyright'} 251: </table> 252: ENDHEAD 253: delete($content{'title'}); 254: delete($content{'author'}); 255: delete($content{'subject'}); 256: delete($content{'keywords'}); 257: delete($content{'notes'}); 258: delete($content{'abstract'}); 259: delete($content{'mime'}); 260: delete($content{'language'}); 261: delete($content{'creationdate'}); 262: delete($content{'lastrevisiondate'}); 263: delete($content{'owner'}); 264: delete($content{'copyright'}); 265: if ($ENV{'user.adv'}) { 266: # ------------------------------------------------------------ Dynamic Metadata 267: $r->print( 268: '<h3>Dynamic Metadata (updated periodically)</h3>Processing ...<br>'); 269: $r->rflush(); 270: my %items=( 271: 'count' => 'Network-wide number of accesses (hits)', 272: 'course' => 'Network-wide number of courses using resource', 273: 'usage' => 'Number of resources using or importing resource', 274: 'clear' => 'Material presented in clear way', 275: 'depth' => 'Material covered with sufficient depth', 276: 'helpful' => 'Material is helpful', 277: 'correct' => 'Material appears to be correct', 278: 'technical' => 'Resource is technically correct', 279: 'avetries' => 'Average number of tries till solved', 280: 'stdno' => 'Total number of students who have worked on this problem', 281: 'difficulty' => 'Degree of difficulty'); 282: my %dynmeta=&dynamicmeta($uri); 283: $r->print( 284: '</table><h4>Access and Usage Statistics</h4><table cellspacing=2 border=0>'); 285: foreach ('count','usage','course') { 286: $r->print( 287: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'. 288: $dynmeta{$_}." </td></tr>\n"); 289: } 290: $r->print('</table>'); 291: if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) { 292: $r->print( 293: '<h4>Assessment Statistical Data</h4><table cellspacing=2 border=0>'); 294: foreach ('stdno','avetries') { 295: $r->print( 296: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'. 297: $dynmeta{$_}." </td></tr>\n"); 298: } 299: foreach ('difficulty') { 300: $r->print( 301: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'. 302: &diffgraph($dynmeta{$_})."</td></tr>\n"); 303: } 304: $r->print('</table>'); 305: } 306: $r->print('<h4>Evaluation Data</h4><table cellspacing=2 border=0>'); 307: foreach ('clear','depth','helpful','correct','technical') { 308: $r->print( 309: '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'. 310: &evalgraph($dynmeta{$_})."</td></tr>\n"); 311: } 312: $r->print('</table>'); 313: $disuri=~/^(\w+)\/(\w+)\//; 314: if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2)) 315: || ($ENV{'user.role.ca./'.$1.'/'.$2})) { 316: $r->print( 317: '<h4>Evaluation Comments (visible to author and co-authors only)</h4>'. 318: '<blockquote>'.$dynmeta{'comments'}.'</blockquote>'); 319: $r->print( 320: '<h4>Error Messages (visible to author and co-authors only)</h4>'); 321: my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$1,$2); 322: foreach (keys %errormsgs) { 323: if ($_=~/^$disuri\_\d+$/) { 324: my %content=&Apache::lonmsg::unpackagemsg($errormsgs{$_}); 325: $r->print('<b>'.$content{'time'}.'</b>: '.$content{'message'}. 326: '<br />'); 327: } 328: } 329: } 330: # ------------------------------------------------------------- All other stuff 331: $r->print( 332: '<h3>Additional Metadata (non-standard, parameters, exports)</h3>'); 333: foreach (sort keys %content) { 334: my $name=$_; 335: my $display=&Apache::lonnet::metadata($uri,$name.'.display'); 336: unless ($display) { $display=$name; }; 337: my $otherinfo=''; 338: foreach ('name','part','type','default') { 339: if (defined(&Apache::lonnet::metadata($uri,$name.'.'.$_))) { 340: $otherinfo.=' '.$_.'='. 341: &Apache::lonnet::metadata($uri,$name.'.'.$_).'; '; 342: } 343: } 344: $r->print('<b>'.$display.':</b> '.$content{$name}); 345: if ($otherinfo) { 346: $r->print(' ('.$otherinfo.')'); 347: } 348: $r->print("<br>\n"); 349: } 350: } 351: # ===================================================== End Resource Space Call 352: } else { 353: # ===================================================== Construction Space Call 354: 355: # ----------------------------------------------------------- Set document type 356: 357: $r->content_type('text/html'); 358: $r->send_http_header; 359: 360: return OK if $r->header_only; 361: # ---------------------------------------------------------------------- Header 362: my $bodytag=&Apache::loncommon::bodytag('Edit Catalog Information'); 363: my $disuri=$uri; 364: my $fn=&Apache::lonnet::filelocation('',$uri); 365: $disuri=~s/^\/\~\w+//; 366: $disuri=~s/\.meta$//; 367: my $displayfile='Catalog Information for '.$disuri; 368: if ($disuri=~/\/default$/) { 369: my $dir=$disuri; 370: $dir=~s/default$//; 371: $displayfile='Default Cataloging Information for Directory '.$dir; 372: } 373: %Apache::lonpublisher::metadatafields=(); 374: %Apache::lonpublisher::metadatakeys=(); 375: &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn)); 376: $r->print(<<ENDEDIT); 377: <html><head><title>Edit Catalog Information</title></head> 378: $bodytag 379: <h1>$displayfile</h1> 380: <form method="post"> 381: ENDEDIT 382: foreach ('author','title','subject','keywords','abstract','notes', 383: 'copyright','customdistributionfile','language') { 384: if ($ENV{'form.new_'.$_}) { 385: $Apache::lonpublisher::metadatafields{$_}=$ENV{'form.new_'.$_}; 386: } 387: $r->print( 388: &Apache::lonpublisher::textfield($_,'new_'.$_, 389: $Apache::lonpublisher::metadatafields{$_})); 390: } 391: if ($ENV{'form.store'}) { 392: my $mfh; 393: unless ($mfh=Apache::File->new('>'.$fn)) { 394: $r->print( 395: '<p><font color=red>Could not write metadata, FAIL</font>'); 396: } else { 397: foreach (sort keys %Apache::lonpublisher::metadatafields) { 398: unless ($_=~/\./) { 399: my $unikey=$_; 400: $unikey=~/^([A-Za-z]+)/; 401: my $tag=$1; 402: $tag=~tr/A-Z/a-z/; 403: print $mfh "\n\<$tag"; 404: foreach 405: (split(/\,/,$Apache::lonpublisher::metadatakeys{$unikey})) { 406: my $value= 407: $Apache::lonpublisher::metadatafields{$unikey.'.'.$_}; 408: $value=~s/\"/\'\'/g; 409: print $mfh ' '.$_.'="'.$value.'"'; 410: } 411: print $mfh '>'. 412: &HTML::Entities::encode($Apache::lonpublisher::metadatafields{$unikey}) 413: .'</'.$tag.'>'; 414: } 415: } 416: $r->print('<p>Wrote Metadata'); 417: } 418: } 419: $r->print( 420: '<br /><input type="submit" name="store" value="Store Catalog Information"></form></body></html>'); 421: return OK; 422: } 423: } 424: 425: 1; 426: __END__ 427: 428: 429: 430: 431: 432: 433: