[BACK]Return to lonmeta.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonmeta.pm between versions 1.22 and 1.74

version 1.22, 2002/10/18 13:49:49 version 1.74, 2004/04/19 16:43:53
Line 24 Line 24
 # /home/httpd/html/adm/gpl.txt  # /home/httpd/html/adm/gpl.txt
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  
 # (TeX Content Handler  
 #  
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  
 #  
 # 10/19,10/21,10/23,11/27,08/09/01,12/22,12/24,12/25 Gerd Kortemeyer  
   
 package Apache::lonmeta;  package Apache::lonmeta;
   
 use strict;  use strict;
   use LONCAPA::lonmetadata();
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lonnet();  use Apache::lonnet();
 use Apache::loncommon();  use Apache::loncommon();
   use Apache::lonhtmlcommon();
   use Apache::lonmsg;
   use Apache::lonpublisher;
   use Apache::lonlocal;
   use Apache::lonmysql;
   use Apache::lonmsg;
   
 # ----------------------------------------- Fetch and evaluate dynamic metadata  
   
   # Fetch and evaluate dynamic metadata
 sub dynamicmeta {  sub dynamicmeta {
     my $url=&Apache::lonnet::declutter(shift);      my $url=&Apache::lonnet::declutter(shift);
     $url=~s/\.meta$//;      $url=~s/\.meta$//;
Line 49  sub dynamicmeta { Line 51  sub dynamicmeta {
     $regexp='___'.$regexp.'___';      $regexp='___'.$regexp.'___';
     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,      my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
        $aauthor,$regexp);         $aauthor,$regexp);
     my %sum;      my %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
     my %cnt;      my %Data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,
     my %listitems=('count'        => 'add',                                                                 \%DynamicData);
                    'course'       => 'add',      #
                    'avetries'     => 'avg',      # Deal with 'count' separately
                    'stdno'        => 'add',      $Data{'count'} = &access_count($url,$aauthor,$adomain);
                    'difficulty'   => 'avg',      #
                    'clear'        => 'avg',      # Debugging code I will probably need later
                    'technical'    => 'avg',      if (0) {
                    'helpful'      => 'avg',          &Apache::lonnet::logthis('Dynamic Metadata');
                    'correct'      => 'avg',          while(my($k,$v)=each(%Data)){
                    'depth'        => 'avg',              &Apache::lonnet::logthis('    "'.$k.'"=>"'.$v.'"');
                    'comments'     => 'app',          }
                    'usage'        => 'cnt'          &Apache::lonnet::logthis('-------------------');
                    );  
     foreach (keys %evaldata) {  
  $_=~/___(\w+)$/;  
         if (defined($cnt{$1})) { $cnt{$1}++; } else { $cnt{$1}=1; }  
         unless ($listitems{$1} eq 'app') {  
             if (defined($sum{$1})) {  
                $sum{$1}+=$evaldata{$_};  
     } else {  
                $sum{$1}=$evaldata{$_};  
     }  
         } else {  
             if (defined($sum{$1})) {  
                if ($evaldata{$_}) {  
                   $sum{$1}.='<hr>'.$evaldata{$_};  
        }  
      } else {  
        $sum{$1}=''.$evaldata{$_};  
     }  
  }  
     }      }
     my %returnhash=();      return %Data;
     foreach (keys %cnt) {  }
        if ($listitems{$_} eq 'avg') {  
    $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;  sub access_count {
        } elsif ($listitems{$_} eq 'cnt') {      my ($src,$author,$adomain) = @_;
            $returnhash{$_}=$cnt{$_};      my %countdata=&Apache::lonnet::dump('nohist_accesscount',$adomain,
        } else {                                          $author,$src);
            $returnhash{$_}=$sum{$_};      if (! exists($countdata{$src})) {
        }          return &mt('Not Available');
       } else {
           return $countdata{$src};
       }
   }
   
   # Try to make an alt tag if there is none
   sub alttag {
       my ($base,$src)=@_;
       my $fullpath=&Apache::lonnet::hreflocation($base,$src);
       my $alttag=&Apache::lonnet::metadata($fullpath,'title').' '.
           &Apache::lonnet::metadata($fullpath,'subject').' '.
           &Apache::lonnet::metadata($fullpath,'abstract');
       $alttag=~s/\s+/ /gs;
       $alttag=~s/\"//gs;
       $alttag=~s/\'//gs;
       $alttag=~s/\s+$//gs;
       $alttag=~s/^\s+//gs;
       if ($alttag) { 
           return $alttag; 
       } else { 
           return &mt('No information available'); 
     }      }
     return %returnhash;  
 }  }
   
 # -------------------------------------------------------------- Pretty display  # Author display
   sub authordisplay {
       my ($aname,$adom)=@_;
       return &Apache::loncommon::aboutmewrapper
           (&Apache::loncommon::plainname($aname,$adom),
            $aname,$adom,'preview').' <tt>['.$aname.'@'.$adom.']</tt>';
   }
   
   # Pretty display
 sub evalgraph {  sub evalgraph {
     my $value=shift;      my $value=shift;
     unless ($value) { return ''; }      if (! $value) { 
           return '';
       }
     my $val=int($value*10.+0.5)-10;      my $val=int($value*10.+0.5)-10;
     my $output='<table border=0 cellpadding=0 cellspacing=0><tr>';      my $output='<table border="0" cellpadding="0" cellspacing="0"><tr>';
     if ($val>=20) {      if ($val>=20) {
  $output.='<td width=20 bgcolor="#555555">&nbsp&nbsp;</td>';   $output.='<td width="20" bgcolor="#555555">&nbsp&nbsp;</td>';
     } else {      } else {
         $output.='<td width='.($val).' bgcolor="#555555">&nbsp;</td>'.          $output.='<td width="'.($val).'" bgcolor="#555555">&nbsp;</td>'.
                  '<td width='.(20-$val).' bgcolor="#FF3333">&nbsp;</td>';                   '<td width="'.(20-$val).'" bgcolor="#FF3333">&nbsp;</td>';
     }      }
     $output.='<td bgcolor="#FFFF33">&nbsp;</td>';      $output.='<td bgcolor="#FFFF33">&nbsp;</td>';
     if ($val>20) {      if ($val>20) {
  $output.='<td width='.($val-20).' bgcolor="#33FF33">&nbsp;</td>'.   $output.='<td width="'.($val-20).'" bgcolor="#33FF33">&nbsp;</td>'.
                  '<td width='.(40-$val).' bgcolor="#555555">&nbsp;</td>';                   '<td width="'.(40-$val).'" bgcolor="#555555">&nbsp;</td>';
     } else {      } else {
        $output.='<td width=20 bgcolor="#555555">&nbsp&nbsp;</td>';          $output.='<td width="20" bgcolor="#555555">&nbsp&nbsp;</td>';
     }      }
     $output.='<td> ('.$value.') </td></tr></table>';      $output.='<td> ('.sprintf("%5.2f",$value).') </td></tr></table>';
     return $output;      return $output;
 }  }
   
 sub diffgraph {  sub diffgraph {
     my $value=shift;      my $value=shift;
     unless ($value) { return ''; }      if (! $value) { 
           return '';
       }
     my $val=int(40.0*$value+0.5);      my $val=int(40.0*$value+0.5);
     my @colors=('#FF9933','#EEAA33','#DDBB33','#CCCC33',      my @colors=('#FF9933','#EEAA33','#DDBB33','#CCCC33',
                 '#BBDD33','#CCCC33','#DDBB33','#EEAA33');                  '#BBDD33','#CCCC33','#DDBB33','#EEAA33');
     my $output='<table border=0 cellpadding=0 cellspacing=0><tr>';      my $output='<table border="0" cellpadding="0" cellspacing="0"><tr>';
     for (my $i=0;$i<8;$i++) {      for (my $i=0;$i<8;$i++) {
  if ($val>$i*5) {   if ($val>$i*5) {
             $output.='<td width=5 bgcolor="'.$colors[$i].'">&nbsp;</td>';              $output.='<td width="5" bgcolor="'.$colors[$i].'">&nbsp;</td>';
         } else {          } else {
     $output.='<td width=5 bgcolor="#555555">&nbsp;</td>';      $output.='<td width="5" bgcolor="#555555">&nbsp;</td>';
  }   }
     }      }
     $output.='<td> ('.$value.') </td></tr></table>';      $output.='<td> ('.sprintf("%3.2f",$value).') </td></tr></table>';
     return $output;      return $output;
 }  }
   
 # ================================================================ Main Handler  
   
 sub handler {  # The field names
   my $r=shift;  sub fieldnames {
       return &Apache::lonlocal::texthash
           (
            'title' => 'Title',
            'author' =>'Author(s)',
            'authorspace' => 'Author Space',
            'modifyinguser' => 'Last Modifying User',
            'subject' => 'Subject',
            'keywords' => 'Keyword(s)',
            'notes' => 'Notes',
            'abstract' => 'Abstract',
            'lowestgradelevel' => 'Lowest Grade Level',
            'highestgradelevel' => 'Highest Grade Level',
            'standards' => 'Standards',
            'mime' => 'MIME Type',
            'language' => 'Language',
            'creationdate' => 'Creation Date',
            'lastrevisiondate' => 'Last Revision Date',
            'owner' => 'Publisher/Owner',
            'copyright' => 'Copyright/Distribution',
            'customdistributionfile' => 'Custom Distribution File',
            'obsolete' => 'Obsolete',
            'obsoletereplacement' => 'Suggested Replacement for Obsolete File',
            'count'      => 'Network-wide number of accesses (hits)',
            'course'     => 'Network-wide number of courses using resource',
            'course_list' => 'Network-wide courses using resource',
            'sequsage'      => 'Number of resources using or importing resource',
            'sequsage_list' => 'Resources using or importing resource',
            'goto'       => 'Number of resources that follow this resource in maps',
            'goto_list'  => 'Resources that follow this resource in maps',
            'comefrom'   => 'Number of resources that lead up to this resource in maps',
            'comefrom_list' => 'Resources that lead up to this resource in maps',
            'clear'      => 'Material presented in clear way',
            'depth'      => 'Material covered with sufficient depth',
            'helpful'    => 'Material is helpful',
            'correct'    => 'Material appears to be correct',
            'technical'  => 'Resource is technically correct', 
            'avetries'   => 'Average number of tries till solved',
            'stdno'      => 'Total number of students who have worked on this problem',
            'difficulty' => 'Degree of difficulty',
            'disc'       => 'Degree of discrimination',
            );
   }
   
     my $loaderror=&Apache::lonnet::overloaderror($r);  # Pretty printing of metadata field
     if ($loaderror) { return $loaderror; }  
   
   sub prettyprint {
       my ($type,$value)=@_;
       if (! defined($value)) { 
           return '&nbsp;'; 
       }
       # Title
       if ($type eq 'title') {
    return '<font size="+1" face="arial">'.$value.'</font>';
       }
       # Dates
       if (($type eq 'creationdate') ||
    ($type eq 'lastrevisiondate')) {
    return ($value?&Apache::lonlocal::locallocaltime(
     &Apache::lonmysql::unsqltime($value)):
    &mt('not available'));
       }
       # Language
       if ($type eq 'language') {
    return &Apache::loncommon::languagedescription($value);
       }
       # Copyright
       if ($type eq 'copyright') {
    return &Apache::loncommon::copyrightdescription($value);
       }
       # MIME
       if ($type eq 'mime') {
           return '<img src="'.&Apache::loncommon::icon($value).'" />&nbsp;'.
               &Apache::loncommon::filedescription($value);
       }
       # Person
       if (($type eq 'author') || 
    ($type eq 'owner') ||
    ($type eq 'modifyinguser') ||
    ($type eq 'authorspace')) {
    $value=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;
    return $value;
       }
       # Gradelevel
       if (($type eq 'lowestgradelevel') ||
    ($type eq 'highestgradelevel')) {
    return &Apache::loncommon::gradeleveldescription($value);
       }
       # Only for advance users below
       if (! $ENV{'user.adv'}) { 
           return '<i>- '.&mt('not displayed').' -</i>';
       }
       # File
       if (($type eq 'customdistributionfile') ||
    ($type eq 'obsoletereplacement') ||
    ($type eq 'goto_list') ||
    ($type eq 'comefrom_list') ||
    ($type eq 'sequsage_list')) {
    return join('<br />',map {
               my $url = &Apache::lonnet::clutter($_);
               my $title = &Apache::lonnet::gettitle($url);
               if ($title eq '') {
                   $title = 'Untitled';
                   if ($url =~ /\.sequence$/) {
                       $title .= ' Sequence';
                   } elsif ($url =~ /\.page$/) {
                       $title .= ' Page';
                   } elsif ($url =~ /\.problem$/) {
                       $title .= ' Problem';
                   } elsif ($url =~ /\.html$/) {
                       $title .= ' HTML document';
                   } elsif ($url =~ m:/syllabus$:) {
                       $title .= ' Syllabus';
                   } 
               }
               $_ = '<b>'.$title.'</b> '.
                   '<a href="'.$url.'" target="preview">'.
                   '<font size="-1">'.$url.'</font>'.
                   '</a>'
           } split(/\s*\,\s*/,$value));
       }
       # Evaluations
       if (($type eq 'clear') ||
    ($type eq 'depth') ||
    ($type eq 'helpful') ||
    ($type eq 'correct') ||
    ($type eq 'technical')) {
    return &evalgraph($value);
       }
       # Difficulty
       if ($type eq 'difficulty' || $type eq 'disc') {
    return &diffgraph($value);
       }
       # List of courses
       if ($type=~/\_list/) {
           my @Courses = split(/\s*\,\s*/,$value);
           my $Str;
           foreach my $course (@Courses) {
               my %courseinfo = &Apache::lonnet::coursedescription($course);
               if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
                   next;
               }
               if ($Str ne '') { $Str .= '<br />'; }
               $Str .= '<a href="/public/'.$courseinfo{'domain'}.'/'.
                   $courseinfo{'num'}.'/syllabus" target="preview">'.
                   $courseinfo{'description'}.'</a>';
           }
    return $Str;
       }
       # No pretty print found
       return $value;
   }
   
     my $uri=$r->uri;  # Pretty input of metadata field
   sub direct {
       return shift;
   }
   
     my ($resdomain,$resuser)=  sub selectbox {
            (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);      my ($name,$value,$functionref,@idlist)=@_;
       if (! defined($functionref)) {
           $functionref=\&direct;
       }
       my $selout='<select name="'.$name.'">';
       foreach (@idlist) {
           $selout.='<option value=\''.$_.'\'';
           if ($_ eq $value) {
       $selout.=' selected>'.&{$functionref}($_).'</option>';
    }
           else {$selout.='>'.&{$functionref}($_).'</option>';}
       }
       return $selout.'</select>';
   }
   
     $loaderror=  sub relatedfield {
        &Apache::lonnet::overloaderror($r,      my ($show,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue)=@_;
          &Apache::lonnet::homeserver($resuser,$resdomain));      if (! $relatedsearchflag) { 
     if ($loaderror) { return $loaderror; }          return '';
       }
   my %content=();      if (! defined($relatedsep)) {
           $relatedsep=' ';
 # ----------------------------------------------------------- Set document type      }
       if (! $show) {
   $r->content_type('text/html');          return $relatedsep.'&nbsp;';
   $r->send_http_header;      }
       return $relatedsep.'<input type="checkbox" name="'.$fieldname.'_related"'.
   return OK if $r->header_only;   ($relatedvalue?' checked="1"':'').' />';
   
 # ------------------------------------------------------------------- Read file  
   foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {  
       $content{$_}=&Apache::lonnet::metadata($uri,$_);  
   }  
 # ------------------------------------------------------------------ Hide stuff  
   
   unless ($ENV{'user.adv'}) {  
       foreach ('keywords','notes','abstract','subject') {  
           $content{$_}='<i>- not displayed -</i>';  
       }  
   }  
   
 # --------------------------------------------------------------- Render Output  
   my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta/);  
 my $creationdate=localtime(  
  &Apache::loncommon::unsqltime($content{'creationdate'}));  
 my $lastrevisiondate=localtime(  
  &Apache::loncommon::unsqltime($content{'lastrevisiondate'}));  
 my $language=&Apache::loncommon::languagedescription($content{'language'});  
 my $mime=&Apache::loncommon::filedescription($content{'mime'});   
 my $disuri=&Apache::lonnet::declutter($uri);  
   $disuri=~s/\.meta$//;  
 my $currentversion=&Apache::lonnet::getversion($disuri);  
 my $versiondisplay='';  
 if ($thisversion) {  
     $versiondisplay='Version: '.$thisversion.  
     ' (most recent version: '.$currentversion.')';  
 } else {  
     $versiondisplay='Version: '.$currentversion;  
 }  
 my $bodytag=&Apache::loncommon::bodytag  
             ('Catalog Information','','','',$resdomain);  
   $r->print(<<ENDHEAD);  
 <html><head><title>Catalog Information</title></head>  
 $bodytag  
 <h2>$content{'title'}</h2>  
 <h3><tt>$disuri</tt></h3>  
 $versiondisplay<br />  
 <table cellspacing=2 border=0>  
 <tr><td bgcolor='#AAAAAA'>Author(s)</td>  
 <td bgcolor="#CCCCCC">$content{'author'}&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>Subject</td>  
 <td bgcolor="#CCCCCC">$content{'subject'}&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>Keyword(s)</td>  
 <td bgcolor="#CCCCCC">$content{'keywords'}&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>Notes</td>  
 <td bgcolor="#CCCCCC">$content{'notes'}&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>Abstract</td>  
 <td bgcolor="#CCCCCC">$content{'abstract'}&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>MIME Type</td>  
 <td bgcolor="#CCCCCC">$mime ($content{'mime'})&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>Language</td>  
 <td bgcolor="#CCCCCC">$language&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>Creation Date</td>  
 <td bgcolor="#CCCCCC">$creationdate&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>  
 Last Revision Date</td><td bgcolor="#CCCCCC">$lastrevisiondate&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>Publisher/Owner</td>  
 <td bgcolor="#CCCCCC">$content{'owner'}&nbsp;</td></tr>  
 <tr><td bgcolor='#AAAAAA'>Copyright/Distribution</td>  
 <td bgcolor="#CCCCCC">$content{'copyright'}  
 </table>  
 ENDHEAD  
   delete($content{'title'});  
   delete($content{'author'});  
   delete($content{'subject'});  
   delete($content{'keywords'});  
   delete($content{'notes'});  
   delete($content{'abstract'});  
   delete($content{'mime'});  
   delete($content{'language'});  
   delete($content{'creationdate'});  
   delete($content{'lastrevisiondate'});  
   delete($content{'owner'});  
   delete($content{'copyright'});  
   if ($ENV{'user.adv'}) {  
 # ------------------------------------------------------------ Dynamic Metadata  
    $r->print(  
    '<h3>Dynamic Metadata (updated periodically)</h3>Processing ...<br>');  
    $r->rflush();  
     my %items=(  
  'count'      => 'Network-wide number of accesses (hits)',  
  'course'     => 'Network-wide number of courses using resource',  
  'usage'      => 'Number of resources using or importing resource',  
  'clear'      => 'Material presented in clear way',  
  'depth'      => 'Material covered with sufficient depth',  
  'helpful'    => 'Material is helpful',  
  'correct'    => 'Material appears to be correct',  
  'technical'  => 'Resource is technically correct',   
  'avetries'   => 'Average number of tries till solved',  
  'stdno'      => 'Total number of students who have worked on this problem',  
  'difficulty' => 'Degree of difficulty');  
    my %dynmeta=&dynamicmeta($uri);  
    $r->print(  
 '</table><h4>Access and Usage Statistics</h4><table cellspacing=2 border=0>');  
    foreach ('count','usage','course') {  
        $r->print(  
 '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.  
 $dynmeta{$_}."&nbsp;</td></tr>\n");  
    }  
        $r->print('</table>');  
    if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {  
       $r->print(  
 '<h4>Assessment Statistical Data</h4><table cellspacing=2 border=0>');  
       foreach ('stdno','avetries') {  
           $r->print(  
 '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.  
 $dynmeta{$_}."&nbsp;</td></tr>\n");  
       }  
       foreach ('difficulty') {  
          $r->print(  
 '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.  
 &diffgraph($dynmeta{$_})."</td></tr>\n");  
       }  
       $r->print('</table>');      
    }  
    $r->print('<h4>Evaluation Data</h4><table cellspacing=2 border=0>');  
    foreach ('clear','depth','helpful','correct','technical') {  
        $r->print(  
 '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.  
 &evalgraph($dynmeta{$_})."</td></tr>\n");  
    }      
    $r->print('</table>');  
    $disuri=~/^(\w+)\/(\w+)\//;     
    if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))  
        || ($ENV{'user.role.ca./'.$1.'/'.$2})) {  
       $r->print(  
   '<h4>Evaluation Comments (visible to author and co-authors only)</h4>'.  
       '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');        
    }  
 # ------------------------------------------------------------- All other stuff  
    $r->print(  
  '<h3>Additional Metadata (non-standard, parameters, exports)</h3>');  
    foreach (sort keys %content) {  
       my $name=$_;  
       my $display=&Apache::lonnet::metadata($uri,$name.'.display');  
       unless ($display) { $display=$name; };  
       my $otherinfo='';  
       foreach ('name','part','type','default') {  
           if (defined(&Apache::lonnet::metadata($uri,$name.'.'.$_))) {  
              $otherinfo.=' '.$_.'='.  
  &Apache::lonnet::metadata($uri,$name.'.'.$_).'; ';  
           }  
       }  
       $r->print('<b>'.$display.':</b> '.$content{$name});  
       if ($otherinfo) {  
          $r->print(' ('.$otherinfo.')');  
       }  
       $r->print("<br>\n");  
    }  
   }  
   $r->print('</body></html>');  
   return OK;  
 }  }
   
 1;  sub prettyinput {
 __END__      my ($type,$value,$fieldname,$formname,
    $relatedsearchflag,$relatedsep,$relatedvalue,$size)=@_;
       # Language
       if ($type eq 'language') {
    return &selectbox($fieldname,
     $value,
     \&Apache::loncommon::languagedescription,
     (&Apache::loncommon::languageids)).
                                 &relatedfield(0,$relatedsearchflag,$relatedsep);
       }
       # Copyright
       if ($type eq 'copyright') {
    return &selectbox($fieldname,
     $value,
     \&Apache::loncommon::copyrightdescription,
     (&Apache::loncommon::copyrightids)).
                                 &relatedfield(0,$relatedsearchflag,$relatedsep);
       }
       # Gradelevels
       if (($type eq 'lowestgradelevel') ||
    ($type eq 'highestgradelevel')) {
    return &Apache::loncommon::select_level_form($value,$fieldname).
               &relatedfield(0,$relatedsearchflag,$relatedsep);
       }
       # Obsolete
       if ($type eq 'obsolete') {
    return '<input type="checkbox" name="'.$fieldname.'"'.
       ($value?' checked="1"':'').' />'.
               &relatedfield(0,$relatedsearchflag,$relatedsep); 
       }
       # Obsolete replacement file
       if ($type eq 'obsoletereplacement') {
    return '<input type="text" name="'.$fieldname.
       '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
       "('".$formname."','".$fieldname."'".
       ",'')\">".&mt('Select').'</a>'.
               &relatedfield(0,$relatedsearchflag,$relatedsep); 
       }
       # Customdistribution file
       if ($type eq 'customdistributionfile') {
    return '<input type="text" name="'.$fieldname.
       '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
       "('".$formname."','".$fieldname."'".
       ",'rights')\">".&mt('Select').'</a>'.
               &relatedfield(0,$relatedsearchflag,$relatedsep); 
       }
       # Dates
       if (($type eq 'creationdate') ||
    ($type eq 'lastrevisiondate')) {
    return 
               &Apache::lonhtmlcommon::date_setter($formname,$fieldname,$value).
               &relatedfield(0,$relatedsearchflag,$relatedsep);
       }
       # No pretty input found
       $value=~s/^\s+//gs;
       $value=~s/\s+$//gs;
       $value=~s/\s+/ /gs;
       $value=~s/\"/\&quod\;/gs;
       return 
           '<input type="text" name="'.$fieldname.'" size="'.$size.'" '.
           'value="'.$value.'" />'.
           &relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,
                         $relatedvalue); 
   }
   
   # Main Handler
   sub handler {
       my $r=shift;
       #
       my $uri=$r->uri;
       #
       # Check to see if this server is overloaded
       my $loaderror=&Apache::lonnet::overloaderror($r);
       if ($loaderror) { 
           return $loaderror;
       }
       #
       # Check to see if original resource server is overloaded
       my ($resdomain,$resuser)=
           (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
       $loaderror=&Apache::lonnet::overloaderror
           ($r,&Apache::lonnet::homeserver($resuser,$resdomain));
       if ($loaderror) { 
           return $loaderror;
       }
       #
       # Set document type
       &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
       return OK if $r->header_only;
       #
       $r->print('<html><head><title>'.
                 'Catalog Information'.
                 '</title></head>');
       if ($uri=~m:/adm/bombs/(.*)$:) {
           $r->print(&Apache::loncommon::bodytag('Error Messages'));
           # Looking for all bombs?
           &report_bombs($r,$uri);
       } elsif ($uri=~/^\/\~/) { 
           # Construction space
           $r->print(&Apache::loncommon::bodytag
                     ('Edit Catalog Information','','','',$resdomain));
           &present_editable_metadata($r,$uri);
       } else {
           $r->print(&Apache::loncommon::bodytag
                     ('Catalog Information','','','',$resdomain));
           &present_uneditable_metadata($r,$uri);
       }
       $r->print('</body></html>');
       return OK;
   }
   
   #####################################################
   #####################################################
   ###                                               ###
   ###                Report Bombs                   ###
   ###                                               ###
   #####################################################
   #####################################################
   sub report_bombs {
       my ($r,$uri) = @_;
       # Set document type
       $uri =~ s:/adm/bombs/::;
       $uri = &Apache::lonnet::declutter($uri);
       $r->print('<h1>'.&Apache::lonnet::clutter($uri).'</h1>');
       my ($domain,$author)=($uri=~/^(\w+)\/(\w+)\//);
       if (&Apache::loncacc::constructaccess('/~'.$author.'/',$domain)) {
           my %brokenurls = 
               &Apache::lonmsg::all_url_author_res_msg($author,$domain);
           foreach (sort(keys(%brokenurls))) {
               if ($_=~/^\Q$uri\E/) {
                   $r->print
                       ('<a href="'.&Apache::lonnet::clutter($_).'">'.$_.'</a>'.
                        &Apache::lonmsg::retrieve_author_res_msg($_).
                        '<hr />');
               }
           }
       } else {
           $r->print(&mt('Not authorized'));
       }
       return;
   }
   
   #####################################################
   #####################################################
   ###                                               ###
   ###        Uneditable Metadata Display            ###
   ###                                               ###
   #####################################################
   #####################################################
   sub present_uneditable_metadata {
       my ($r,$uri) = @_;
       #
       my %content=();
       # Read file
       foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
           $content{$_}=&Apache::lonnet::metadata($uri,$_);
       }
       # Render Output
       # displayed url
       my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
       $uri=~s/\.meta$//;
       my $disuri=&Apache::lonnet::clutter($uri);
       # version
       my $currentversion=&Apache::lonnet::getversion($disuri);
       my $versiondisplay='';
       if ($thisversion) {
           $versiondisplay=&mt('Version').': '.$thisversion.
               ' ('.&mt('most recent version').': '.
               ($currentversion>0 ? 
                $currentversion   :
                &mt('information not available')).')';
       } else {
           $versiondisplay='Version: '.$currentversion;
       }
       # crumbify displayed URL               uri     target prefix form  size
       $disuri=&Apache::lonhtmlcommon::crumbs($disuri,undef, undef, undef,'+1');
       $disuri =~ s:<br />::g;
       # obsolete
       my $obsolete=$content{'obsolete'};
       my $obsoletewarning='';
       if (($obsolete) && ($ENV{'user.adv'})) {
           $obsoletewarning='<p><font color="red">'.
               &mt('This resource has been marked obsolete by the author(s)').
               '</font></p>';
       }
       #
       my %lt=&fieldnames();
       my $table='';
       my $title = $content{'title'};
       if (! defined($title)) {
           $title = 'Untitled Resource';
       }
       foreach ('title', 
                'author', 
                'subject', 
                'keywords', 
                'notes', 
                'abstract',
                'lowestgradelevel',
                'highestgradelevel',
                'standards', 
                'mime', 
                'language', 
                'creationdate', 
                'lastrevisiondate', 
                'owner', 
                'copyright', 
                'customdistributionfile', 
                'obsolete', 
                'obsoletereplacement') {
           $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.
               '</td><td bgcolor="#CCCCCC">'.
               &prettyprint($_,$content{$_}).'</td></tr>';
           delete $content{$_};
       }
       #
       $r->print(<<ENDHEAD);
   <h2>$title</h2>
   <p>
   $disuri<br />
   $obsoletewarning
   $versiondisplay
   </p>
   <table cellspacing=2 border=0>
   $table
   </table>
   ENDHEAD
       if ($ENV{'user.adv'}) {
           &print_dynamic_metadata($r,$uri,\%content);
       }
       return;
   }
   
   sub print_dynamic_metadata {
       my ($r,$uri,$content) = @_;
       #
       my %content = %$content;
       my %lt=&fieldnames();
       #
       my $description = 'Dynamic Metadata (updated periodically)';
       $r->print('<h3>'.&mt($description).'</h3>'.
                 &mt('Processing'));
       $r->rflush();
       my %items=&fieldnames();
       my %dynmeta=&dynamicmeta($uri);
       &Apache::lonnet::logthis('dynamic metadata keys:'.$/.
                                join("\n",keys(%dynmeta)));
       #
       # General Access and Usage Statistics
       if (exists($dynmeta{'count'}) ||
           exists($dynmeta{'sequsage'}) ||
           exists($dynmeta{'comefrom'}) ||
           exists($dynmeta{'goto'}) ||
           exists($dynmeta{'course'})) {
           $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.
                     '<table cellspacing=2 border=0>');
           foreach ('count',
                    'sequsage','sequsage_list',
                    'comefrom','comefrom_list',
                    'goto','goto_list',
                    'course','course_list') {
               $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                         '<td bgcolor="#CCCCCC">'.
                         &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
           }
           $r->print('</table>');
       } else {
           $r->print('<h4>'.&mt('No Access or Usages Statistics are available for this resource.').'</h4>');
       }
       #
       # Assessment statistics
       if ($uri=~/\.(problem|exam|quiz|assess|survey|form)$/) {
           if (exists($dynmeta{'stdno'}) ||
               exists($dynmeta{'avetries'}) ||
               exists($dynmeta{'difficulty'}) ||
               exists($dynmeta{'disc'})) {
               # This is an assessment, print assessment data
               $r->print('<h4>'.
                         &mt('Overall Assessment Statistical Data').
                         '</h4>'.
                         '<table cellspacing=2 border=0>');
               $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{'stdno'}.'</td>'.
                         '<td bgcolor="#CCCCCC">'.
                         &prettyprint('stdno',$dynmeta{'stdno'}).
                         '</td>'."</tr>\n");
               foreach ('avetries','difficulty','disc') {
                   $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                             '<td bgcolor="#CCCCCC">'.
                             &prettyprint($_,sprintf('%5.2f',$dynmeta{$_})).
                             '</td>'."</tr>\n");
               }
               $r->print('</table>');    
           }
           if (exists($dynmeta{'stats'})) {
               #
               # New assessment statistics
               $r->print('<h4>'.
                         &mt('Detailed Assessment Statistical Data').
                         '</h4>');
               my $table = '<table cellspacing=2 border=0>'.
                   '<tr>'.
                   '<th>Course</th>'.
                   '<th>Section(s)</th>'.
                   '<th>Num Students</th>'.
                   '<th>Mean Tries</th>'.
                   '<th>Degree of Difficulty</th>'.
                   '<th>Degree of Discrimination</th>'.
                   '<th>Time of computation</th>'.
                   '</tr>'.$/;
               foreach my $identifier (sort(keys(%{$dynmeta{'stats'}}))) {
                   my $data = $dynmeta{'stats'}->{$identifier};
                   my $course = $data->{'course'};
                   my %courseinfo = &Apache::lonnet::coursedescription($course);
                   if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
                       &Apache::lonnet::logthis('lookup for '.$course.' failed');
                       next;
                   }
                   $table .= '<tr>';
                   $table .= 
                       '<td><nobr>'.$courseinfo{'description'}.'</nobr></td>';
                   $table .= 
                       '<td align="right">'.$data->{'sections'}.'</td>';
                   $table .=
                       '<td align="right">'.$data->{'stdno'}.'</td>';
                   foreach ('avetries','difficulty','disc') {
                       $table .= '<td align="right">';
                       if (exists($data->{$_})) {
                           $table .= sprintf('%.2f',$data->{$_}).'&nbsp;';
                       } else {
                           $table .= '';
                       }
                       $table .= '</td>';
                   }
                   $table .=
                       '<td><nobr>'.
                       &Apache::lonlocal::locallocaltime($data->{'timestamp'}).
                       '</nobr></td>';
                   $table .=
                       '</tr>'.$/;
               }
               $table .= '</table>'.$/;
               $r->print($table);
           } else {
               $r->print('No new dynamic data found.');
           }
       } else {
           $r->print('<h4>'.
             &mt('No Assessment Statistical Data is available for this resource').
                     '</h4>');
       }
   
       #
       #
       if (exists($dynmeta{'clear'})   || 
           exists($dynmeta{'depth'})   || 
           exists($dynmeta{'helpful'}) || 
           exists($dynmeta{'correct'}) || 
           exists($dynmeta{'technical'})){ 
           $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.
                     '<table cellspacing=2 border=0>');
           foreach ('clear','depth','helpful','correct','technical') {
               $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                         '<td bgcolor="#CCCCCC">'.
                         &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
           }
           $r->print('</table>');
       } else {
           $r->print('<h4>'.&mt('No Evaluation Data is available for this resource.').'</h4>');
       }
       $uri=~/^\/res\/(\w+)\/(\w+)\//; 
       if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))
           || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
           if (exists($dynmeta{'comments'})) {
               $r->print('<h4>'.&mt('Evaluation Comments').' ('.
                         &mt('visible to author and co-authors only').
                         ')</h4>'.
                         '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
           } else {
               $r->print('<h4>'.&mt('There are no Evaluation Comments on this resource.').'</h4>');
           }
           my $bombs = &Apache::lonmsg::retrieve_author_res_msg($uri);
           if (defined($bombs) && $bombs ne '') {
               $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.
                         &mt('visible to author and co-authors only').')'.
                         '</h4>'.$bombs);
           } else {
               $r->print('<h4>'.&mt('There are currently no Error Messages for this resource.').'</h4>');
           }
       }
       #
       # All other stuff
       $r->print('<h3>'.
                 &mt('Additional Metadata (non-standard, parameters, exports)').
                 '</h3>');
       foreach (sort(keys(%content))) {
           my $name=$_;
           if ($name!~/\.display$/) {
               my $display=&Apache::lonnet::metadata($uri,
                                                     $name.'.display');
               if (! $display) { 
                   $display=$name;
               };
               my $otherinfo='';
               foreach ('name','part','type','default') {
                   if (defined(&Apache::lonnet::metadata($uri,
                                                         $name.'.'.$_))) {
                       $otherinfo.=' '.$_.'='.
                           &Apache::lonnet::metadata($uri,
                                                     $name.'.'.$_).'; ';
                   }
               }
               $r->print('<b>'.$display.':</b> '.$content{$name});
               if ($otherinfo) {
                   $r->print(' ('.$otherinfo.')');
               }
               $r->print("<br />\n");
           }
       }
       return;
   }
   
   #####################################################
   #####################################################
   ###                                               ###
   ###          Editable metadata display            ###
   ###                                               ###
   #####################################################
   #####################################################
   sub present_editable_metadata {
       my ($r,$uri) = @_;
       # Construction Space Call
       # Header
       my $disuri=$uri;
       my $fn=&Apache::lonnet::filelocation('',$uri);
       $disuri=~s/^\/\~/\/priv\//;
       $disuri=~s/\.meta$//;
       my $target=$uri;
       $target=~s/^\/\~/\/res\/$ENV{'request.role.domain'}\//;
       $target=~s/\.meta$//;
       my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);
       if ($bombs) {
           if ($ENV{'form.delmsg'}) {
               if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {
                   $bombs=&mt('Messages deleted.');
               } else {
                   $bombs=&mt('Error deleting messages');
               }
           }
           my $del=&mt('Delete Messages');
           $r->print(<<ENDBOMBS);
   <h1>$disuri</h1>
   <form method="post" name="defaultmeta">
   <input type="submit" name="delmsg" value="$del" />
   <br />$bombs
   ENDBOMBS
       } else {
           my $displayfile='Catalog Information for '.$disuri;
           if ($disuri=~/\/default$/) {
               my $dir=$disuri;
               $dir=~s/default$//;
               $displayfile=
                   &mt('Default Cataloging Information for Directory').' '.
                   $dir;
           }
           my $bodytag=
               &Apache::loncommon::bodytag('Edit Catalog Information');
           %Apache::lonpublisher::metadatafields=();
           %Apache::lonpublisher::metadatakeys=();
           &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));
           $r->print(<<ENDEDIT);
   <html><head><title>Edit Catalog Information</title></head>
   $bodytag
   <h1>$displayfile</h1>
   <form method="post" name="defaultmeta">
   ENDEDIT
           $r->print('<script language="JavaScript">'.
                     &Apache::loncommon::browser_and_searcher_javascript.
                     '</script>');
           my %lt=&fieldnames();
           foreach ('author','title','subject','keywords','abstract','notes',
                    'copyright','customdistributionfile','language',
                    'standards',
                    'lowestgradelevel','highestgradelevel',
                    'obsolete','obsoletereplacement') {
               if (defined($ENV{'form.new_'.$_})) {
                   $Apache::lonpublisher::metadatafields{$_}=
                       $ENV{'form.new_'.$_};
               }
               if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
                   $Apache::lonpublisher::metadatafields{'copyright'}=
                       'default';
               }
               $r->print('<p>'.$lt{$_}.': '.
                         &prettyinput
                         ($_,$Apache::lonpublisher::metadatafields{$_},
                          'new_'.$_,'defaultmeta').'</p>');
           }
           if ($ENV{'form.store'}) {
               my $mfh;
               if (!  ($mfh=Apache::File->new('>'.$fn))) {
                   $r->print('<p><font color=red>'.
                             &mt('Could not write metadata').', '.
                             &mt('FAIL').'</font>');
               } else {
                   foreach (sort keys %Apache::lonpublisher::metadatafields) {
                       next if ($_ =~ /\./);
                       my $unikey=$_;
                       $unikey=~/^([A-Za-z]+)/;
                       my $tag=$1;
                       $tag=~tr/A-Z/a-z/;
                       print $mfh "\n\<$tag";
                       foreach (split(/\,/,
                                    $Apache::lonpublisher::metadatakeys{$unikey})
                                ) {
                           my $value=
                            $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
                           $value=~s/\"/\'\'/g;
                           print $mfh ' '.$_.'="'.$value.'"';
                       }
                       print $mfh '>'.
                           &HTML::Entities::encode
                           ($Apache::lonpublisher::metadatafields{$unikey},
                            '<>&"').
                            '</'.$tag.'>';
                   }
                   $r->print('<p>'.&mt('Wrote Metadata'));
               }
           }
           $r->print('<br /><input type="submit" name="store" value="'.
                     &mt('Store Catalog Information').'">');
       }
       $r->print('</form>');
       return;
   }
   
   1;
   __END__
Removed from v.1.22  
changed lines
  Added in v.1.74

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.