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

Diff for /loncom/interface/lonmeta.pm between versions 1.57 and 1.98

version 1.57, 2004/01/04 00:28:22 version 1.98, 2005/07/08 10:39:49
Line 29 Line 29
 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::lonhtmlcommon();
 use Apache::lonmsg;  use Apache::lonmsg;
Line 39  use Apache::lonlocal; Line 40  use Apache::lonlocal;
 use Apache::lonmysql;  use Apache::lonmysql;
 use Apache::lonmsg;  use Apache::lonmsg;
   
 # MySQL table columns  
   
 my @columns;  ############################################################
   ############################################################
   ##
   ## &get_dynamic_metadata_from_sql($url)
   ## 
   ## Queries sql database for dynamic metdata
   ## Returns a hash of hashes, with keys of urls which match $url
   ## Returned fields are given below.
   ##
   ## Examples:
   ## 
   ## %DynamicMetadata = &Apache::lonmeta::get_dynmaic_metadata_from_sql
   ##     ('/res/msu/korte/');
   ##
   ## $DynamicMetadata{'/res/msu/korte/example.problem'}->{$field}
   ##
   ############################################################
   ############################################################
   sub get_dynamic_metadata_from_sql {
       my ($url) = shift();
       my ($authordom,$author)=($url=~m:^/res/(\w+)/(\w+)/:);
       if (! defined($authordom)) {
           $authordom = shift();
       }
       if  (! defined($author)) { 
           $author = shift();
       }
       if (! defined($authordom) || ! defined($author)) {
           return ();
       }
       my @Fields = ('url','count','course',
                     'goto','goto_list',
                     'comefrom','comefrom_list',
                     'sequsage','sequsage_list',
                     'stdno','stdno_list',
     'dependencies',
                     'avetries','avetries_list',
                     'difficulty','difficulty_list',
                     'disc','disc_list',
                     'clear','technical','correct',
                     'helpful','depth');
       #
       my $query = 'SELECT '.join(',',@Fields).
           ' FROM metadata WHERE url LIKE "'.$url.'%"';
       my $server = &Apache::lonnet::homeserver($author,$authordom);
       my $reply = &Apache::lonnet::metadata_query($query,undef,undef,
                                                   ,[$server]);
       return () if (! defined($reply) || ref($reply) ne 'HASH');
       my $filename = $reply->{$server};
       if (! defined($filename) || $filename =~ /^error/) {
           return ();
       }
       my $max_time = time + 10; # wait 10 seconds for results at most
       my %ReturnHash;
       #
       # Look for results
       my $finished = 0;
       while (! $finished && time < $max_time) {
           my $datafile=$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename;
           if (! -e "$datafile.end") { next; }
           my $fh;
           if (!($fh=Apache::File->new($datafile))) { next; }
           while (my $result = <$fh>) {
               chomp($result);
               next if (! $result);
               my @Data = 
                   map { 
                       &Apache::lonnet::unescape($_); 
                   } split(',',$result);
               my $url = $Data[0];
               for (my $i=0;$i<=$#Fields;$i++) {
                   $ReturnHash{$url}->{$Fields[$i]}=$Data[$i];
               }
           }
           $finished = 1;
       }
       #
       return %ReturnHash;
   }
   
 # ----------------------------------------- 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 54  sub dynamicmeta { Line 132  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 %concat=();                                                                 \%DynamicData);
     my %listitems=(  
                    'course'       => 'add',  
                    'goto'         => 'add',  
                    'comefrom'     => 'add',  
                    'avetries'     => 'avg',  
                    'stdno'        => 'add',  
                    'difficulty'   => 'avg',  
                    'clear'        => 'avg',  
                    'technical'    => 'avg',  
                    'helpful'      => 'avg',  
                    'correct'      => 'avg',  
                    'depth'        => 'avg',  
                    'comments'     => 'app',  
                    'usage'        => 'cnt'  
                    );  
     while ($_=each(%evaldata)) {  
  my ($item,$purl,$cat)=split(/___/,$_);  
  ### Apache->request->print("\n".$_.' - '.$item.'<br />');  
  if (defined($cnt{$cat})) { $cnt{$cat}++; } else { $cnt{$cat}=1; }  
         unless ($listitems{$cat} eq 'app') {  
             if (defined($sum{$cat})) {  
                $sum{$cat}+=$evaldata{$_};  
                $concat{$cat}.=','.$item;  
     } else {  
                $sum{$cat}=$evaldata{$_};  
                $concat{$cat}=$item;  
     }  
         } else {  
             if (defined($sum{$cat})) {  
                if ($evaldata{$_}) {  
                   $sum{$cat}.='<hr />'.$evaldata{$_};  
        }  
      } else {  
        $sum{$cat}=''.$evaldata{$_};  
     }  
  }  
     }  
     my %returnhash=();  
     while ($_=each(%cnt)) {  
        if ($listitems{$_} eq 'avg') {  
    $returnhash{$_}=int(($sum{$_}/$cnt{$_})*100.0+0.5)/100.0;  
        } elsif ($listitems{$_} eq 'cnt') {  
            $returnhash{$_}=$cnt{$_};  
        } else {  
            $returnhash{$_}=$sum{$_};  
        }  
        $returnhash{$_.'_list'}=$concat{$_};  
        ### Apache->request->print("\n<hr />".$_.': '.$returnhash{$_}.'<br />'.$returnhash{$_.'_list'});  
     }  
     #      #
     # Deal with 'count' separately      # Deal with 'count' separately
     $returnhash{'count'} = &access_count($url,$aauthor,$adomain);      $Data{'count'} = &access_count($url,$aauthor,$adomain);
     # since "usage" is reserved word in MySQL ...      #
     $returnhash{'sequsage'}=$returnhash{'usage'};      # Debugging code I will probably need later
     $returnhash{'sequsage_list'}=$returnhash{'usage_list'};      if (0) {
           &Apache::lonnet::logthis('Dynamic Metadata');
     return %returnhash;          while(my($k,$v)=each(%Data)){
               &Apache::lonnet::logthis('    "'.$k.'"=>"'.$v.'"');
           }
           &Apache::lonnet::logthis('-------------------');
       }
       return %Data;
 }  }
   
 sub access_count {  sub access_count {
Line 127  sub access_count { Line 161  sub access_count {
     }      }
 }  }
   
 # ------------------------------------- Try to make an alt tag if there is none  # Try to make an alt tag if there is none
   
 sub alttag {  sub alttag {
     my ($base,$src)=@_;      my ($base,$src)=@_;
     my $fullpath=&Apache::lonnet::hreflocation($base,$src);      my $fullpath=&Apache::lonnet::hreflocation($base,$src);
     my $alttag=&Apache::lonnet::metadata($fullpath,'title').' '.      my $alttag=&Apache::lonnet::metadata($fullpath,'title').' '.
                &Apache::lonnet::metadata($fullpath,'subject').' '.          &Apache::lonnet::metadata($fullpath,'subject').' '.
                &Apache::lonnet::metadata($fullpath,'abstract');          &Apache::lonnet::metadata($fullpath,'abstract');
     $alttag=~s/\s+/ /gs;      $alttag=~s/\s+/ /gs;
     $alttag=~s/\"//gs;      $alttag=~s/\"//gs;
     $alttag=~s/\'//gs;      $alttag=~s/\'//gs;
     $alttag=~s/\s+$//gs;      $alttag=~s/\s+$//gs;
     $alttag=~s/^\s+//gs;      $alttag=~s/^\s+//gs;
     if ($alttag) { return $alttag; } else       if ($alttag) { 
                  { return &mt('No information available'); }          return $alttag; 
       } else { 
           return &mt('No information available'); 
       }
 }  }
   
 # -------------------------------------------------------------- Author display  # Author display
   
 sub authordisplay {  sub authordisplay {
     my ($aname,$adom)=@_;      my ($aname,$adom)=@_;
     return &Apache::loncommon::aboutmewrapper(      return &Apache::loncommon::aboutmewrapper
                 &Apache::loncommon::plainname($aname,$adom),          (&Apache::loncommon::plainname($aname,$adom),
                     $aname,$adom,'preview').' <tt>['.$aname.'@'.$adom.']</tt>';           $aname,$adom,'preview').' <tt>['.$aname.'@'.$adom.']</tt>';
 }  }
   
 # -------------------------------------------------------------- Pretty display  # 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;
 }  }
   
 # ==================================================== Turn MySQL row into hash  
   
 sub metadata_col_to_hash {  
     my @cols=@_;  
     my %hash=();  
     for (my $i=0; $i<=$#columns; $i++) {  
  $hash{$columns[$i]}=$cols[$i];  
     }  
     return %hash;  
 }  
   
 # ============================================================= The field names  
   
   # The field names
 sub fieldnames {  sub fieldnames {
     return &Apache::lonlocal::texthash(      my $file_type=shift;
    'title' => 'Title',      my %fields = 
    'author' =>'Author(s)',          ('title' => 'Title',
    'authorspace' => 'Author Space',           'author' =>'Author(s)',
    'modifyinguser' => 'Last Modifying User',           'authorspace' => 'Author Space',
    'subject' => 'Subject',           'modifyinguser' => 'Last Modifying User',
    'keywords' => 'Keyword(s)',           'subject' => 'Subject',
    'notes' => 'Notes',           'keywords' => 'Keyword(s)',
    'abstract' => 'Abstract',           'notes' => 'Notes',
                                    'lowestgradelevel' => 'Lowest Grade Level',           'abstract' => 'Abstract',
                                    'highestgradelevel' => 'Highest Grade Level',           'lowestgradelevel' => 'Lowest Grade Level',
                                    'standards' => 'Standards',           'highestgradelevel' => 'Highest Grade Level');
    'mime' => 'MIME Type',      if (! defined($file_type) || $file_type ne 'portfolio') {
    'language' => 'Language',          %fields = 
    'creationdate' => 'Creation Date',          (%fields,
    'lastrevisiondate' => 'Last Revision Date',           'domain' => 'Domain',
    'owner' => 'Publisher/Owner',           'standards' => 'Standards',
                                    'copyright' => 'Copyright/Distribution',           'mime' => 'MIME Type',
    'customdistributionfile' => 'Custom Distribution File',           'language' => 'Language',
                                    'obsolete' => 'Obsolete',           'creationdate' => 'Creation Date',
    'obsoletereplacement' => 'Suggested Replacement for Obsolete File',           'lastrevisiondate' => 'Last Revision Date',
    'count'      => 'Network-wide number of accesses (hits)',           'owner' => 'Publisher/Owner',
    'course'     => 'Network-wide number of courses using resource',           'copyright' => 'Copyright/Distribution',
    'course_list' => 'Network-wide courses using resource',           'customdistributionfile' => 'Custom Distribution File',
    'sequsage'      => 'Number of resources using or importing resource',           'sourceavail' => 'Source Available',
    'sequsage_list' => 'Resources using or importing resource',           'sourcerights' => 'Source Custom Distribution File',
    'goto'       => 'Number of resources that follow this resource in maps',           'obsolete' => 'Obsolete',
    'goto_list'  => 'Resources that follow this resource in maps',           'obsoletereplacement' => 'Suggested Replacement for Obsolete File',
    'comefrom'   => 'Number of resources that lead up to this resource in maps',           'count'      => 'Network-wide number of accesses (hits)',
    'comefrom_list' => 'Resources that lead up to this resource in maps',           'course'     => 'Network-wide number of courses using resource',
    'clear'      => 'Material presented in clear way',           'course_list' => 'Network-wide courses using resource',
    'depth'      => 'Material covered with sufficient depth',           'sequsage'      => 'Number of resources using or importing resource',
    'helpful'    => 'Material is helpful',           'sequsage_list' => 'Resources using or importing resource',
    'correct'    => 'Material appears to be correct',           'goto'       => 'Number of resources that follow this resource in maps',
    'technical'  => 'Resource is technically correct',            'goto_list'  => 'Resources that follow this resource in maps',
    'avetries'   => 'Average number of tries till solved',           'comefrom'   => 'Number of resources that lead up to this resource in maps',
    'stdno'      => 'Total number of students who have worked on this problem',           'comefrom_list' => 'Resources that lead up to this resource in maps',
    'difficulty' => 'Degree of difficulty'           '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',
    'dependencies' => 'Resources used by this resource',
            );
       }
       return &Apache::lonlocal::texthash(%fields);
 }  }
   
 # =========================================== Pretty printing of metadata field  # Pretty printing of metadata field
   
 sub prettyprint {  sub prettyprint {
     my ($type,$value)=@_;      my ($type,$value,$target,$prefix,$form,$noformat)=@_;
     unless (defined($value)) { return '&nbsp;'; }  # $target,$prefix,$form are optional and for filecrumbs only
 # Title      if (! defined($value)) { 
           return '&nbsp;'; 
       }
       # Title
     if ($type eq 'title') {      if ($type eq 'title') {
  return '<font size="+1" face="arial">'.$value.'</font>';   return '<font size="+1" face="arial">'.$value.'</font>';
     }      }
 # Dates      # Dates
     if (($type eq 'creationdate') ||      if (($type eq 'creationdate') ||
  ($type eq 'lastrevisiondate')) {   ($type eq 'lastrevisiondate')) {
  return ($value?&Apache::lonlocal::locallocaltime(   return ($value?&Apache::lonlocal::locallocaltime(
   &Apache::lonmysql::unsqltime($value)):    &Apache::lonmysql::unsqltime($value)):
  &mt('not available'));   &mt('not available'));
     }      }
 # Language      # Language
     if ($type eq 'language') {      if ($type eq 'language') {
  return &Apache::loncommon::languagedescription($value);   return &Apache::loncommon::languagedescription($value);
     }      }
 # Copyright      # Copyright
     if ($type eq 'copyright') {      if ($type eq 'copyright') {
  return &Apache::loncommon::copyrightdescription($value);   return &Apache::loncommon::copyrightdescription($value);
     }      }
 # MIME      # Copyright
       if ($type eq 'sourceavail') {
    return &Apache::loncommon::source_copyrightdescription($value);
       }
       # MIME
     if ($type eq 'mime') {      if ($type eq 'mime') {
        return '<img src="'.&Apache::loncommon::icon($value).'" />&nbsp;'.          return '<img src="'.&Apache::loncommon::icon($value).'" />&nbsp;'.
    &Apache::loncommon::filedescription($value);              &Apache::loncommon::filedescription($value);
    }      }
 # Person      # Person
     if (($type eq 'author') ||       if (($type eq 'author') || 
  ($type eq 'owner') ||   ($type eq 'owner') ||
  ($type eq 'modifyinguser') ||   ($type eq 'modifyinguser') ||
Line 287  sub prettyprint { Line 332  sub prettyprint {
  $value=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;   $value=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;
  return $value;   return $value;
     }      }
 # Gradelevel      # Gradelevel
     if (($type eq 'lowestgradelevel') ||      if (($type eq 'lowestgradelevel') ||
  ($type eq 'highestgradelevel')) {   ($type eq 'highestgradelevel')) {
  return &Apache::loncommon::gradeleveldescription($value);   return &Apache::loncommon::gradeleveldescription($value);
     }      }
 # Only for advance users below      # Only for advance users below
     unless ($ENV{'user.adv'}) { return '<i>- '.&mt('not displayed').' -</i>' };      if (! $env{'user.adv'}) { 
 # File          return '<i>- '.&mt('not displayed').' -</i>';
       }
       # File
     if (($type eq 'customdistributionfile') ||      if (($type eq 'customdistributionfile') ||
  ($type eq 'obsoletereplacement') ||   ($type eq 'obsoletereplacement') ||
  ($type eq 'goto_list') ||   ($type eq 'goto_list') ||
  ($type eq 'comefrom_list') ||   ($type eq 'comefrom_list') ||
  ($type eq 'sequsage_list')) {   ($type eq 'sequsage_list') ||
  return join('<br />',map {   ($type eq 'dependencies')) {
        my $url=&Apache::lonnet::clutter($_);   return '<ul><font size="-1">'.join("\n",map {
        '<br /><b>'.&Apache::lonnet::gettitle($url).'</b>'.              my $url = &Apache::lonnet::clutter($_);
        &Apache::lonhtmlcommon::crumbs($url,'preview','');              my $title = &Apache::lonnet::gettitle($url);
     } split(/\s*\,\s*/,$value));              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';
                   } 
               }
               $_ = '<li>'.$title.' '.
    &Apache::lonhtmlcommon::crumbs($url,$target,$prefix,$form,'-1',$noformat).
                   '</li>'
       } split(/\s*\,\s*/,$value)).'</ul></font>';
     }      }
 # Evaluations      # Evaluations
     if (($type eq 'clear') ||      if (($type eq 'clear') ||
  ($type eq 'depth') ||   ($type eq 'depth') ||
  ($type eq 'helpful') ||   ($type eq 'helpful') ||
Line 314  sub prettyprint { Line 378  sub prettyprint {
  ($type eq 'technical')) {   ($type eq 'technical')) {
  return &evalgraph($value);   return &evalgraph($value);
     }      }
 # Difficulty      # Difficulty
     if ($type eq 'difficulty') {      if ($type eq 'difficulty' || $type eq 'disc') {
  return &diffgraph($value);   return &diffgraph($value);
     }      }
 # List of courses      # List of courses
     if ($type=~/\_list/) {      if ($type=~/\_list/) {
  return join('<br />',map {          my @Courses = split(/\s*\,\s*/,$value);
     my %courseinfo=&Apache::lonnet::coursedescription($_);            my $Str;
     '<a href="/public/'.          foreach my $course (@Courses) {
  $courseinfo{'domain'}.'/'.$courseinfo{'num'}.'/syllabus" target="preview">'.              my %courseinfo = &Apache::lonnet::coursedescription($course);
  $courseinfo{'description'}.'</a>';              if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
  } split(/\s*\,\s*/,$value));                  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      # No pretty print found
     return $value;      return $value;
 }  }
 # ============================================== Pretty input of metadata field  
   
   # Pretty input of metadata field
 sub direct {  sub direct {
     return shift;      return shift;
 }  }
   
 sub selectbox {  sub selectbox {
     my ($name,$value,$functionref,@idlist)=@_;      my ($name,$value,$functionref,@idlist)=@_;
     unless (defined($functionref)) { $functionref=\&direct; }      if (! defined($functionref)) {
           $functionref=\&direct;
       }
     my $selout='<select name="'.$name.'">';      my $selout='<select name="'.$name.'">';
     foreach (@idlist) {      foreach (@idlist) {
         $selout.='<option value=\''.$_.'\'';          $selout.='<option value=\''.$_.'\'';
Line 352  sub selectbox { Line 425  sub selectbox {
   
 sub relatedfield {  sub relatedfield {
     my ($show,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue)=@_;      my ($show,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue)=@_;
     unless ($relatedsearchflag) { return ''; }      if (! $relatedsearchflag) { 
     unless (defined($relatedsep)) { $relatedsep=' '; }          return '';
     unless ($show) { return $relatedsep.'&nbsp;'; }      }
       if (! defined($relatedsep)) {
           $relatedsep=' ';
       }
       if (! $show) {
           return $relatedsep.'&nbsp;';
       }
     return $relatedsep.'<input type="checkbox" name="'.$fieldname.'_related"'.      return $relatedsep.'<input type="checkbox" name="'.$fieldname.'_related"'.
  ($relatedvalue?' checked="1"':'').' />';   ($relatedvalue?' checked="1"':'').' />';
 }  }
   
 sub prettyinput {  sub prettyinput {
     my ($type,$value,$fieldname,$formname,      my ($type,$value,$fieldname,$formname,
  $relatedsearchflag,$relatedsep,$relatedvalue)=@_;   $relatedsearchflag,$relatedsep,$relatedvalue,$size)=@_;
 # Language      if (! defined($size)) {
           $size = 80;
       }
       # Language
     if ($type eq 'language') {      if ($type eq 'language') {
  return &selectbox($fieldname,   return &selectbox($fieldname,
   $value,    $value,
   \&Apache::loncommon::languagedescription,    \&Apache::loncommon::languagedescription,
   (&Apache::loncommon::languageids)).    (&Apache::loncommon::languageids)).
        &relatedfield(0,$relatedsearchflag,$relatedsep);                                &relatedfield(0,$relatedsearchflag,$relatedsep);
     }      }
 # Copyright      # Copyright
     if ($type eq 'copyright') {      if ($type eq 'copyright') {
  return &selectbox($fieldname,   return &selectbox($fieldname,
   $value,    $value,
   \&Apache::loncommon::copyrightdescription,    \&Apache::loncommon::copyrightdescription,
   (&Apache::loncommon::copyrightids)).    (&Apache::loncommon::copyrightids)).
        &relatedfield(0,$relatedsearchflag,$relatedsep);                                &relatedfield(0,$relatedsearchflag,$relatedsep);
     }      }
 # Gradelevels      # Source Copyright
       if ($type eq 'sourceavail') {
    return &selectbox($fieldname,
     $value,
     \&Apache::loncommon::source_copyrightdescription,
     (&Apache::loncommon::source_copyrightids)).
                                 &relatedfield(0,$relatedsearchflag,$relatedsep);
       }
       # Gradelevels
     if (($type eq 'lowestgradelevel') ||      if (($type eq 'lowestgradelevel') ||
  ($type eq 'highestgradelevel')) {   ($type eq 'highestgradelevel')) {
  return &Apache::loncommon::select_level_form($value,$fieldname).   return &Apache::loncommon::select_level_form($value,$fieldname).
        &relatedfield(0,$relatedsearchflag,$relatedsep);              &relatedfield(0,$relatedsearchflag,$relatedsep);
     }      }
 # Obsolete      # Obsolete
     if ($type eq 'obsolete') {      if ($type eq 'obsolete') {
  return '<input type="checkbox" name="'.$fieldname.'"'.   return '<input type="checkbox" name="'.$fieldname.'"'.
     ($value?' checked="1"':'').' />'.      ($value?' checked="1"':'').' />'.
        &relatedfield(0,$relatedsearchflag,$relatedsep);               &relatedfield(0,$relatedsearchflag,$relatedsep); 
     }      }
 # Obsolete replacement file      # Obsolete replacement file
     if ($type eq 'obsoletereplacement') {      if ($type eq 'obsoletereplacement') {
  return '<input type="text" name="'.$fieldname.   return '<input type="text" name="'.$fieldname.
     '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.      '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
     "('".$formname."','".$fieldname."'".      "('".$formname."','".$fieldname."'".
     ",'')\">".&mt('Select').'</a>'.      ",'')\">".&mt('Select').'</a>'.
        &relatedfield(0,$relatedsearchflag,$relatedsep);               &relatedfield(0,$relatedsearchflag,$relatedsep); 
    }      }
 # Customdistribution file      # Customdistribution file
     if ($type eq 'customdistributionfile') {      if ($type eq 'customdistributionfile') {
  return '<input type="text" name="'.$fieldname.   return '<input type="text" name="'.$fieldname.
     '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.      '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
     "('".$formname."','".$fieldname."'".      "('".$formname."','".$fieldname."'".
     ",'rights')\">".&mt('Select').'</a>'.      ",'rights')\">".&mt('Select').'</a>'.
        &relatedfield(0,$relatedsearchflag,$relatedsep);               &relatedfield(0,$relatedsearchflag,$relatedsep); 
       }
       # Source Customdistribution file
       if ($type eq 'sourcerights') {
    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      # Dates
     if (($type eq 'creationdate') ||      if (($type eq 'creationdate') ||
  ($type eq 'lastrevisiondate')) {   ($type eq 'lastrevisiondate')) {
  return &Apache::lonhtmlcommon::date_setter($formname,   return 
    $fieldname,$value).              &Apache::lonhtmlcommon::date_setter($formname,$fieldname,$value).
        &relatedfield(0,$relatedsearchflag,$relatedsep);              &relatedfield(0,$relatedsearchflag,$relatedsep);
     }      }
 # No pretty input found      # No pretty input found
     $value=~s/^\s+//gs;      $value=~s/^\s+//gs;
     $value=~s/\s+$//gs;      $value=~s/\s+$//gs;
     $value=~s/\s+/ /gs;      $value=~s/\s+/ /gs;
     $value=~s/\"/\&quod\;/gs;      $value=~s/\"/\&quot\;/gs;
     return       return 
     '<input type="text" name="'.$fieldname.'" size="80" value="'.$value.'" />'.          '<input type="text" name="'.$fieldname.'" size="'.$size.'" '.
     &relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue);           'value="'.$value.'" />'.
           &relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,
                         $relatedvalue); 
 }  }
   
 # ================================================================ Main Handler  # Main Handler
   
 sub handler {  sub handler {
   my $r=shift;      my $r=shift;
       #
     my $loaderror=&Apache::lonnet::overloaderror($r);  
     if ($loaderror) { return $loaderror; }  
   
   
     my $uri=$r->uri;      my $uri=$r->uri;
       #
   unless ($uri=~/^\/\~/) {       # Set document type
 # =========================================== This is not in construction space      &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
       return OK if $r->header_only;
       #
     my ($resdomain,$resuser)=      my ($resdomain,$resuser)=
            (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);          (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
       my $html=&Apache::lonxml::xmlbegin();
     $loaderror=      $r->print($html.'<head><title>'.
        &Apache::lonnet::overloaderror($r,                'Catalog Information'.
          &Apache::lonnet::homeserver($resuser,$resdomain));                '</title></head>');
     if ($loaderror) { return $loaderror; }      if ($uri=~m:/adm/bombs/(.*)$:) {
           $r->print(&Apache::loncommon::bodytag('Error Messages'));
   my %content=();          # Looking for all bombs?
           &report_bombs($r,$uri);
 # ----------------------------------------------------------- Set document type      } elsif ($uri=~/\/portfolio\//) {
           $r->print(&Apache::loncommon::bodytag
   &Apache::loncommon::content_type($r,'text/html');            ('Edit Portfolio File Information','','','',$resdomain));
   $r->send_http_header;          &present_editable_metadata($r,$uri,'portfolio');
           
       } 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;
   }
   
   return OK if $r->header_only;  #####################################################
   #####################################################
   ###                                               ###
   ###                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)) {
    if ($env{'form.clearbombs'}) {
       &Apache::lonmsg::clear_author_res_msg($uri);
    }
           my $clear=&mt('Clear all Messages in Subdirectory');
    $r->print(<<ENDCLEAR);
   <form method="post">
   <input type="submit" name="clearbombs" value="$clear" />
   </form>
   ENDCLEAR
           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;
   }
   
 # ------------------------------------------------------------------- Read file  #####################################################
   foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {  #####################################################
       $content{$_}=&Apache::lonnet::metadata($uri,$_);  ###                                               ###
   }  ###        Uneditable Metadata Display            ###
 # --------------------------------------------------------------- Render Output  ###                                               ###
 # displayed url  #####################################################
   #####################################################
   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$/);      my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
     $uri=~s/\.meta$//;      $uri=~s/\.meta$//;
     my $disuri=&Apache::lonnet::clutter($uri);      my $disuri=&Apache::lonnet::clutter($uri);
 # version      # version
     my $currentversion=&Apache::lonnet::getversion($disuri);      my $currentversion=&Apache::lonnet::getversion($disuri);
     my $versiondisplay='';      my $versiondisplay='';
     if ($thisversion) {      if ($thisversion) {
  $versiondisplay=&mt('Version').': '.$thisversion.          $versiondisplay=&mt('Version').': '.$thisversion.
     ' ('.&mt('most recent version').': '.              ' ('.&mt('most recent version').': '.
     ($currentversion>0?$currentversion:&mt('information not available')).')';              ($currentversion>0 ? 
                $currentversion   :
                &mt('information not available')).')';
     } else {      } else {
  $versiondisplay='Version: '.$currentversion;          $versiondisplay='Version: '.$currentversion;
     }      }
 # crumbify displayed URL      # crumbify displayed URL               uri     target prefix form  size
     $disuri=&Apache::lonhtmlcommon::crumbs($disuri);      $disuri=&Apache::lonhtmlcommon::crumbs($disuri,undef, undef, undef,'+1');
 # obsolete      $disuri =~ s:<br />::g;
       # obsolete
     my $obsolete=$content{'obsolete'};      my $obsolete=$content{'obsolete'};
     my $obsoletewarning='';      my $obsoletewarning='';
     if (($obsolete) && ($ENV{'user.adv'})) {      if (($obsolete) && ($env{'user.adv'})) {
  $obsoletewarning='<p><font color="red">'.          $obsoletewarning='<p><font color="red">'.
     &mt('This resource has been marked obsolete by the author(s)').'</font></p>';              &mt('This resource has been marked obsolete by the author(s)').
               '</font></p>';
     }      }
       #
     my %lt=&fieldnames();      my %lt=&fieldnames();
     my $table='';      my $table='';
     my $bodytag=&Apache::loncommon::bodytag      my $title = $content{'title'};
             ('Catalog Information','','','',$resdomain);      if (! defined($title)) {
           $title = 'Untitled Resource';
       }
     foreach ('title',       foreach ('title', 
      'author',                'author', 
      'subject',                'subject', 
      'keywords',                'keywords', 
      'notes',                'notes', 
      'abstract',               'abstract',
      'lowestgradelevel',               'lowestgradelevel',
      'highestgradelevel',               'highestgradelevel',
      'standards',                'standards', 
      'mime',                'mime', 
      'language',                'language', 
      'creationdate',                'creationdate', 
      'lastrevisiondate',                'lastrevisiondate', 
      'owner',                'owner', 
      'copyright',                'copyright', 
      'customdistributionfile',                'customdistributionfile',
      'obsolete',                'sourceavail',
      'obsoletereplacement') {               'sourcerights', 
  $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.               'obsolete', 
         '</td><td bgcolor="#CCCCCC">'.               'obsoletereplacement') {
                 &prettyprint($_,$content{$_}).'</td></tr>';          $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.
  delete $content{$_};              '</td><td bgcolor="#CCCCCC">'.
     }              &prettyprint($_,$content{$_}).'</td></tr>';
           delete $content{$_};
   $r->print(<<ENDHEAD);      }
 <html><head><title>Catalog Information</title></head>      #
 $bodytag      $r->print(<<ENDHEAD);
 <h2>$content{'title'}</h2>  <h2>$title</h2>
 <h3><tt>$disuri</tt></h3>  <p>
   $disuri<br />
 $obsoletewarning  $obsoletewarning
 $versiondisplay<br />  $versiondisplay
 <table cellspacing=2 border=0>  </p>
   <table cellspacing="2" border="0">
 $table  $table
 </table>  </table>
 ENDHEAD  ENDHEAD
   if ($ENV{'user.adv'}) {      if ($env{'user.adv'}) {
 # ------------------------------------------------------------ Dynamic Metadata          &print_dynamic_metadata($r,$uri,\%content);
       $r->print(      }
  '<h3>'.&mt('Dynamic Metadata').' ('.      return;
  &mt('updated periodically').')</h3>'.&mt('Processing').  }
  ' ...<br />');  
       $r->rflush();  sub print_dynamic_metadata {
       my %items=&fieldnames();      my ($r,$uri,$content) = @_;
       my %dynmeta=&dynamicmeta($uri);      #
 # General Access and Usage Statistics      my %content = %$content;
       $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4><table cellspacing=2 border=0>');      my %lt=&fieldnames();
       foreach ('count',      #
        'sequsage','sequsage_list',      my $description = 'Dynamic Metadata (updated periodically)';
        'comefrom','comefrom_list',      $r->print('<h3>'.&mt($description).'</h3>'.
        'goto','goto_list',                &mt('Processing'));
        'course','course_list') {      $r->rflush();
   $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td><td bgcolor="#CCCCCC">'.      my %items=&fieldnames();
     &prettyprint($dynmeta{$_})."</td></tr>\n");      my %dynmeta=&dynamicmeta($uri);
       }      #
       $r->print('</table>');      # General Access and Usage Statistics
       if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {      if (exists($dynmeta{'count'}) ||
 # This is an assessment, print assessment data          exists($dynmeta{'sequsage'}) ||
   $r->print(          exists($dynmeta{'comefrom'}) ||
     '<h4>'.&mt('Assessment Statistical Data').'</h4><table cellspacing=2 border=0>');          exists($dynmeta{'goto'}) ||
   foreach ('stdno','avetries','difficulty') {          exists($dynmeta{'course'})) {
       $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td><td bgcolor="#CCCCCC">'.          $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.
  &prettyprint($dynmeta{$_})."</td></tr>\n");                    '<table cellspacing="2" border="0">');
   }          foreach ('count',
   $r->print('</table>');                       'sequsage','sequsage_list',
       }                   'comefrom','comefrom_list',
       $r->print('<h4>'.&mt('Evaluation Data').'</h4><table cellspacing=2 border=0>');                   'goto','goto_list',
       foreach ('clear','depth','helpful','correct','technical') {                   'course','course_list') {
   $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td><td bgcolor="#CCCCCC">'.              $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
     &prettyprint($dynmeta{$_})."</td></tr>\n");                        '<td bgcolor="#CCCCCC">'.
      }                            &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
       $r->print('</table>');          }
       $uri=~/^\/res\/(\w+)\/(\w+)\//;           $r->print('</table>');
       if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))      } else {
   || ($ENV{'user.role.ca./'.$1.'/'.$2})) {          $r->print('<h4>'.&mt('No Access or Usages Statistics are available for this resource.').'</h4>');
   $r->print('<h4>'.&mt('Evaluation Comments').' ('.      }
     &mt('visible to author and co-authors only').')</h4>'.      #
     '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');      # Assessment statistics
   $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.      if ($uri=~/\.(problem|exam|quiz|assess|survey|form)$/) {
     &mt('visible to author and co-authors only').')</h4>'.          if (exists($dynmeta{'stdno'}) ||
     &Apache::lonmsg::retrieve_author_res_msg($uri));              exists($dynmeta{'avetries'}) ||
       }              exists($dynmeta{'difficulty'}) ||
 # ------------------------------------------------------------- All other stuff              exists($dynmeta{'disc'})) {
       $r->print(              # This is an assessment, print assessment data
  '<h3>'.&mt('Additional Metadata (non-standard, parameters, exports)').'</h3>');              $r->print('<h4>'.
       foreach (sort keys %content) {                        &mt('Overall Assessment Statistical Data').
   my $name=$_;                        '</h4>'.
   unless ($name=~/\.display$/) {                        '<table cellspacing="2" border="0">');
       my $display=&Apache::lonnet::metadata($uri,$name.'.display');              $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{'stdno'}.'</td>'.
       unless ($display) { $display=$name; };                        '<td bgcolor="#CCCCCC">'.
       my $otherinfo='';                        &prettyprint('stdno',$dynmeta{'stdno'}).
       foreach ('name','part','type','default') {                        '</td>'."</tr>\n");
   if (defined(&Apache::lonnet::metadata($uri,$name.'.'.$_))) {              foreach ('avetries','difficulty','disc') {
       $otherinfo.=' '.$_.'='.                  $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
   &Apache::lonnet::metadata($uri,$name.'.'.$_).'; ';                            '<td bgcolor="#CCCCCC">'.
   }                            &prettyprint($_,sprintf('%5.2f',$dynmeta{$_})).
       }                            '</td>'."</tr>\n");
       $r->print('<b>'.$display.':</b> '.$content{$name});              }
       if ($otherinfo) {              $r->print('</table>');    
   $r->print(' ('.$otherinfo.')');          }
       }          if (exists($dynmeta{'stats'})) {
       $r->print("<br />\n");              #
   }              # New assessment statistics
       }              $r->print('<h4>'.
   }                        &mt('Detailed Assessment Statistical Data').
 # ===================================================== End Resource Space Call                        '</h4>');
  } else {              my $table = '<table cellspacing="2" border="0">'.
 # ===================================================== Construction Space Call                  '<tr>'.
                   '<th>Course</th>'.
 # ----------------------------------------------------------- Set document type                  '<th>Section(s)</th>'.
                   '<th>Num Students</th>'.
   &Apache::loncommon::content_type($r,'text/html');                  '<th>Mean Tries</th>'.
   $r->send_http_header;                  '<th>Degree of Difficulty</th>'.
                   '<th>Degree of Discrimination</th>'.
   return OK if $r->header_only;                  '<th>Time of computation</th>'.
 # ---------------------------------------------------------------------- Header                  '</tr>'.$/;
   my $disuri=$uri;              foreach my $identifier (sort(keys(%{$dynmeta{'stats'}}))) {
   my $fn=&Apache::lonnet::filelocation('',$uri);                  my $data = $dynmeta{'stats'}->{$identifier};
   $disuri=~s/^\/\~/\/priv\//;                  my $course = $data->{'course'};
   $disuri=~s/\.meta$//;                  my %courseinfo = &Apache::lonnet::coursedescription($course);
   my $target=$uri;                  if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
   $target=~s/^\/\~/\/res\/$ENV{'request.role.domain'}\//;                      &Apache::lonnet::logthis('lookup for '.$course.' failed');
   $target=~s/\.meta$//;                      next;
   my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);                  }
   if ($bombs) {                  $table .= '<tr>';
       if ($ENV{'form.delmsg'}) {                  $table .= 
   if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {                      '<td><nobr>'.$courseinfo{'description'}.'</nobr></td>';
       $bombs=&mt('Messages deleted.');                  $table .= 
   } else {                      '<td align="right">'.$data->{'sections'}.'</td>';
       $bombs=&mt('Error deleting messages');                  $table .=
   }                      '<td align="right">'.$data->{'stdno'}.'</td>';
       }                  foreach ('avetries','difficulty','disc') {
       my $bodytag=&Apache::loncommon::bodytag('Error Messages');                      $table .= '<td align="right">';
       my $del=&mt('Delete Messages');                      if (exists($data->{$_})) {
       $r->print(<<ENDBOMBS);                          $table .= sprintf('%.2f',$data->{$_}).'&nbsp;';
 <html><head><title>Edit Catalog Information</title></head>                      } else {
 $bodytag                          $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><table border="0" cellspacing="1">');
       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('<tr><td bgcolor="#bbccbb"><font size="-1" color="#556655">'.$display.'</font></td><td bgcolor="#ccddcc"><font size="-1" color="#556655">'.$content{$name});
               if ($otherinfo) {
                   $r->print(' ('.$otherinfo.')');
               }
               $r->print("</font></td></tr>\n");
           }
       }
       $r->print("</table>");
       return;
   }
   
   #####################################################
   #####################################################
   ###                                               ###
   ###          Editable metadata display            ###
   ###                                               ###
   #####################################################
   #####################################################
   sub present_editable_metadata {
       my ($r,$uri, $file_type) = @_;
       # 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');
               }
           }
           if ($env{'form.clearmsg'}) {
       my $cleardir=$target;
       $cleardir=~s/\/[^\/]+$/\//;
               if (&Apache::lonmsg::clear_author_res_msg($cleardir) eq 'ok') {
                   $bombs=&mt('Messages cleared.');
               } else {
                   $bombs=&mt('Error clearing messages');
               }
           }
           my $del=&mt('Delete Messages for this Resource');
    my $clear=&mt('Clear all Messages in Subdirectory');
           $r->print(<<ENDBOMBS);
 <h1>$disuri</h1>  <h1>$disuri</h1>
 <form method="post" name="defaultmeta">  <form method="post" name="defaultmeta">
 <input type="submit" name="delmsg" value="$del" />  <input type="submit" name="delmsg" value="$del" />
   <input type="submit" name="clearmsg" value="$clear" />
 <br />$bombs  <br />$bombs
 </form>  
 </body>  
 </html>  
 ENDBOMBS  ENDBOMBS
   } else {      } else {
       my $displayfile='Catalog Information for '.$disuri;          my $displayfile='Catalog Information for '.$disuri;
       if ($disuri=~/\/default$/) {          if ($disuri=~/\/default$/) {
   my $dir=$disuri;              my $dir=$disuri;
   $dir=~s/default$//;              $dir=~s/default$//;
   $displayfile=&mt('Default Cataloging Information for Directory').' '.              $displayfile=
       $dir;                  &mt('Default Cataloging Information for Directory').' '.
       }                  $dir;
       my $bodytag=&Apache::loncommon::bodytag('Edit Catalog Information');          }
       %Apache::lonpublisher::metadatafields=();          %Apache::lonpublisher::metadatafields=();
       %Apache::lonpublisher::metadatakeys=();          %Apache::lonpublisher::metadatakeys=();
       &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));          my $result=&Apache::lonnet::getfile($fn);
       $r->print(<<ENDEDIT);          if ($result == -1){
 <html><head><title>Edit Catalog Information</title></head>              $r->print('Creating new '.$fn);
 $bodytag          } else {
               &Apache::lonpublisher::metaeval($result);
           }
           $r->print(<<ENDEDIT);
 <h1>$displayfile</h1>  <h1>$displayfile</h1>
 <form method="post" name="defaultmeta">  <form method="post" name="defaultmeta">
 ENDEDIT  ENDEDIT
       $r->print('<script language="JavaScript">'.          $r->print('<script language="JavaScript">'.
  &Apache::loncommon::browser_and_searcher_javascript.                    &Apache::loncommon::browser_and_searcher_javascript().
  '</script>');                    '</script>');
       my %lt=&fieldnames();          my %lt=&fieldnames($file_type);
       foreach ('author','title','subject','keywords','abstract','notes',   my $output;
        'copyright','customdistributionfile','language','standards',   my @fields;
        'lowestgradelevel','highestgradelevel',   if ($file_type eq 'portfolio') {
        'obsolete','obsoletereplacement') {      @fields =  ('author','title','subject','keywords','abstract','notes','lowestgradelevel',
   if (defined($ENV{'form.new_'.$_})) {                  'highestgradelevel');
       $Apache::lonpublisher::metadatafields{$_}=$ENV{'form.new_'.$_};   } else {
   }      @fields = ('author','title','subject','keywords','abstract','notes',
   unless ($Apache::lonpublisher::metadatafields{'copyright'}) {                   'copyright','customdistributionfile','language',
       $Apache::lonpublisher::metadatafields{'copyright'}='default';                   'standards',
   }                   'lowestgradelevel','highestgradelevel','sourceavail','sourcerights',
   $r->print('<p>'.$lt{$_}.': '.&prettyinput($_,                   'obsolete','obsoletereplacement');
     $Apache::lonpublisher::metadatafields{$_},          }
     'new_'.$_,'defaultmeta').'</p>');          foreach (@fields) {
       }              if (defined($env{'form.new_'.$_})) {
       if ($ENV{'form.store'}) {                  $Apache::lonpublisher::metadatafields{$_}=
   my $mfh;                      $env{'form.new_'.$_};
   unless ($mfh=Apache::File->new('>'.$fn)) {              }
       $r->print(              if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
  '<p><font color=red>'.&mt('Could not write metadata').', '.                  $Apache::lonpublisher::metadatafields{'copyright'}=
  &mt('FAIL').'</font>');                      'default';
   } else {              }
       foreach (sort keys %Apache::lonpublisher::metadatafields) {              $output.=('<p>'.$lt{$_}.': '.
   unless ($_=~/\./) {                        &prettyinput($_,
       my $unikey=$_;     $Apache::lonpublisher::metadatafields{$_},
       $unikey=~/^([A-Za-z]+)/;     'new_'.$_,'defaultmeta').'</p>');
       my $tag=$1;          }
       $tag=~tr/A-Z/a-z/;          if ($env{'form.store'}) {
       print $mfh "\n\<$tag";              my $mfh;
       foreach               my $formname='store';
   (split(/\,/,$Apache::lonpublisher::metadatakeys{$unikey})) {              my $file_content;
       my $value=              foreach (sort keys %Apache::lonpublisher::metadatafields) {
   $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};                  next if ($_ =~ /\./);
       $value=~s/\"/\'\'/g;                  my $unikey=$_;
       print $mfh ' '.$_.'="'.$value.'"';                  $unikey=~/^([A-Za-z]+)/;
   }                  my $tag=$1;
       print $mfh '>'.                  $tag=~tr/A-Z/a-z/;
   &HTML::Entities::encode($Apache::lonpublisher::metadatafields{$unikey})                  $file_content.= "\n\<$tag";
   .'</'.$tag.'>';                  foreach (split(/\,/,
   }                               $Apache::lonpublisher::metadatakeys{$unikey})
       }                           ) {
       $r->print('<p>'.&mt('Wrote Metadata'));                      my $value=
   }                       $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
       }                      $value=~s/\"/\'\'/g;
       $r->print(                      $file_content.=' '.$_.'="'.$value.'"' ;
  '<br /><input type="submit" name="store" value="'.                      # print $mfh ' '.$_.'="'.$value.'"';
  &mt('Store Catalog Information').'"></form></body></html>');                  }
   }                  $file_content.= '>'.
     return OK;                      &HTML::Entities::encode
  }                      ($Apache::lonpublisher::metadatafields{$unikey},
                        '<>&"').
                        '</'.$tag.'>';
               }
               if ($fn =~ /\/portfolio\//) {
                   $fn =~ /\/portfolio\/(.*)$/;
                   my $new_fn = '/'.$1;
                   $env{'form.'.$formname}=$file_content;
                   $env{'form.'.$formname.'.filename'}=$new_fn;
                   &Apache::lonnet::userfileupload('uploaddoc','',
            'portfolio'.$env{'form.currentpath'});
           my $status =&Apache::lonnet::userfileupload($formname,'','portfolio');
                   if (&Apache::lonnet::userfileupload($formname,'','portfolio') eq 'error: no uploaded file') {
                       $r->print('<p><font color="red">'.
                         &mt('Could not write metadata').', '.
                        &mt('FAIL').'</font></p>');
                   } else {
                       $r->print('<p><font color="blue">'.&mt('Wrote Metadata').
     ' '.&Apache::lonlocal::locallocaltime(time).
     '</font></p>');
                   }
               } else {
                   if (!  ($mfh=Apache::File->new('>'.$fn))) {
                       $r->print('<p><font color="red">'.
                           &mt('Could not write metadata').', '.
                           &mt('FAIL').'</font></p>');
                   } else {
                       print $mfh $file_content;
       $r->print('<p><font color="blue">'.&mt('Wrote Metadata').
         ' '.&Apache::lonlocal::locallocaltime(time).
         '</font></p>');
                   }
               }
           }
    $r->print($output.'<br /><input type="submit" name="store" value="'.
                     &mt('Store Catalog Information').'">');
       }
       $r->print('</form>');
       return;
 }  }
   
 # ================================================================= BEGIN Block  
 BEGIN {  
 # Get columns of MySQL metadata table  
     @columns=&Apache::lonmysql::col_order('metadata');  
 }  
 1;  1;
 __END__  __END__
   
        
   
   
   
   
   
Removed from v.1.57  
changed lines
  Added in v.1.98

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