Return to lonmeta.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonmeta.pm between versions 1.32 and 1.132

-version 1.32, 2003/06/30 17:17:30
+version 1.132, 2005/11/22 19:43:53
  Line 17
  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  # GNU General Public License for more details.
  #
  # You should have received a copy of the GNU General Public License
  # along with LON-CAPA; if not, write to the Free Software
  # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  #
  # /home/httpd/html/adm/gpl.txt
  #
  # 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;
  use strict;
+ use LONCAPA::lonmetadata();
  use Apache::Constants qw(:common);
- use Apache::lonnet();
+ use Apache::lonnet;
  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
+ ############################################################
+ ############################################################
+ ##
+ ## &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
  sub dynamicmeta {
      my $url=&Apache::lonnet::declutter(shift);
      $url=~s/\.meta$//;
- Line 51  sub dynamicmeta {
+ Line 132  sub dynamicmeta {
      $regexp='___'.$regexp.'___';
      my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
  				       $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=('count'        => 'add',
+     #
-                    'course'       => 'add',
+     # Deal with 'count' separately
-                    'goto'         => 'add',
+     $Data{'count'} = &access_count($url,$aauthor,$adomain);
-                    'comefrom'     => 'add',
+     #
-                    'avetries'     => 'avg',
+     # Debugging code I will probably need later
-                    'stdno'        => 'add',
+     if (0) {
-                    'difficulty'   => 'avg',
+         &Apache::lonnet::logthis('Dynamic Metadata');
-                    'clear'        => 'avg',
+         while(my($k,$v)=each(%Data)){
-                    'technical'    => 'avg',
+             &Apache::lonnet::logthis('    "'.$k.'"=>"'.$v.'"');
-                    'helpful'      => 'avg',
+         }
-                    'correct'      => 'avg',
+         &Apache::lonnet::logthis('-------------------');
-                    'depth'        => 'avg',
-                    'comments'     => 'app',
-                    'usage'        => 'cnt'
-                    );
-     foreach (keys %evaldata) {
- 	my ($item,$purl,$cat)=split(/\_\_\_/,$_);
- ###	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=();
-     foreach (keys %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{$_};
- ### print "\n<hr />".$_.': '.$returnhash{$_}.'<br />'.$returnhash{$_.'_list'};
      }
-     return %returnhash;
+     return %Data;
  }
- # ------------------------------------- Try to make an alt tag if there is none
+ sub access_count {
+     my ($src,$author,$adomain) = @_;
+     my %countdata=&Apache::lonnet::dump('nohist_accesscount',$adomain,
+                                         $author,$src);
+     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,'subject').' '.
-                &Apache::lonnet::metadata($fullpath,'abstract');
+         &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
+     if ($alttag) {
-                  { return 'No information available'; }
+         return $alttag;
+     } else {
+         return &mt('No information available');
+     }
  }
- # -------------------------------------------------------------- Author display
+ # Author display
  sub authordisplay {
      my ($aname,$adom)=@_;
-     return &Apache::loncommon::aboutmewrapper(
+     return &Apache::loncommon::aboutmewrapper
-                 &Apache::loncommon::plainname($aname,$adom),
+         (&Apache::loncommon::plainname($aname,$adom),
-                     $aname,$adom).' <tt>['.$aname.'@'.$adom.']</tt>';
+          $aname,$adom,'preview').' <tt>['.$aname.'@'.$adom.']</tt>';
  }
- # -------------------------------------------------------------- Pretty display
+ # Pretty display
  sub evalgraph {
      my $value=shift;
-     unless ($value) { return ''; }
+     if (! $value) {
+         return '';
+     }
      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) {
- 	$output.='<td width=20 bgcolor="#555555">&nbsp&nbsp;</td>';
+ 	$output.='<td width="20" bgcolor="#555555">&nbsp&nbsp;</td>';
      } 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>';
      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 {
-        $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;
  }
  sub diffgraph {
      my $value=shift;
-     unless ($value) { return ''; }
+     if (! $value) {
+         return '';
+     }
      my $val=int(40.0*$value+0.5);
      my @colors=('#FF9933','#EEAA33','#DDBB33','#CCCC33',
                  '#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++) {
  	if ($val>$i*5) {
-             $output.='<td width=5 bgcolor="'.$colors[$i].'">&nbsp;</td>';
+             $output.='<td width="5" bgcolor="'.$colors[$i].'">&nbsp;</td>';
          } 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;
  }
- # ================================================================ Main Handler
- sub handler {
+ # The field names
-   my $r=shift;
+ sub fieldnames {
+     my $file_type=shift;
+     my %fields =
+         ('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',
+          'courserestricted' => 'Course Restricting Metadata');
+     if (! defined($file_type) || $file_type ne 'portfolio') {
+         %fields =
+         (%fields,
+          'domain' => 'Domain',
+          'standards' => 'Standards',
+          'mime' => 'MIME Type',
+          'language' => 'Language',
+          'creationdate' => 'Creation Date',
+          'lastrevisiondate' => 'Last Revision Date',
+          'owner' => 'Publisher/Owner',
+          'copyright' => 'Copyright/Distribution',
+          'customdistributionfile' => 'Custom Distribution File',
+          'sourceavail' => 'Source Available',
+          'sourcerights' => 'Source 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',
+ 	 'dependencies' => 'Resources used by this resource',
+          );
+     }
+     return &Apache::lonlocal::texthash(%fields);
+ }
+ sub select_course {
+     my ($r)=@_;
+     my %courses;
+     foreach my $key (keys (%env)) {
+         if ($key =~ m/\.metadata\./) {
+             $key =~ m/^course\.(.+)(\.metadata.+$)/;
+             my $course = $1;
+             my $coursekey = 'course.'.$course.'.description';
+             my $value = $env{$coursekey};
+             $courses{$coursekey} = $value;
+         }
+     }
+     $r->print('<h3>Course Related Meta-Data</h3><br />');
+     $r->print('<form action="" method="post">');
+     $r->print('Select course restrictions<br />');
+     $r->print('<select name="metacourse" >');
+     my $meta_not_found = 1;
+     foreach my $key (keys (%courses)) {
+         if ($meta_not_found) {
+             undef($meta_not_found);
+             $r->print('<h3>Portfolio Meta-Data</h3><br />');
+             $r->print('<form action="" method="post">');
+             $r->print('Select your course<br />');
+             $r->print('<select name="metacourse" >');
+         }
+         $key =~ m/(^.+)\.description$/;
+         $r->print('<option value="'.$1.'">');
+         $r->print($courses{$key});
+         $r->print('</option>');
+     }
+     unless ($meta_not_found) {
+         $r->print('</select><br />');
+         $r->print('<input type="submit" value="Assign Portfolio Metadata" />');
+         $r->print('</form>');
+     }
+     return 'ok';
+ }
+ # Pretty printing of metadata field
+ sub prettyprint {
+     my ($type,$value,$target,$prefix,$form,$noformat)=@_;
+ # $target,$prefix,$form are optional and for filecrumbs only
+     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);
+     }
+     # Copyright
+     if ($type eq 'sourceavail') {
+ 	return &Apache::loncommon::source_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') ||
+ 	($type eq 'dependencies')) {
+ 	return '<ul><font size="-1">'.join("\n",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';
+                 }
+             }
+             $_ = '<li>'.$title.' '.
+ 		&Apache::lonhtmlcommon::crumbs($url,$target,$prefix,$form,'-1',$noformat).
+                 '</li>'
+ 	    } split(/\s*\,\s*/,$value)).'</ul></font>';
+     }
+     # 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 $loaderror=&Apache::lonnet::overloaderror($r);
+ # Pretty input of metadata field
-     if ($loaderror) { return $loaderror; }
+ sub direct {
+     return shift;
+ }
+ sub selectbox {
+     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>';
+ }
-     my $uri=$r->uri;
+ sub relatedfield {
+     my ($show,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue)=@_;
+     if (! $relatedsearchflag) {
+         return '';
+     }
+     if (! defined($relatedsep)) {
+         $relatedsep=' ';
+     }
+     if (! $show) {
+         return $relatedsep.'&nbsp;';
+     }
+     return $relatedsep.'<input type="checkbox" name="'.$fieldname.'_related"'.
+ 	($relatedvalue?' checked="1"':'').' />';
+ }
+ sub prettyinput {
+     my ($type,$value,$fieldname,$formname,
+ 	$relatedsearchflag,$relatedsep,$relatedvalue,$size,$course_key)=@_;
+     if (! defined($size)) {
+         $size = 80;
+     }
+     my $output;
+     if (defined($course_key)) {
+         my $stu_add;
+         my $only_one;
+         my %meta_options;
+         my @cur_values_inst;
+         my $cur_values_stu;
+         my $values = $env{$course_key.'.metadata.'.$type.'.values'};
+         if ($env{$course_key.'.metadata.'.$type.'.options'} =~ m/stuadd/) {
+             $stu_add = 'true';
+         }
+         if ($env{$course_key.'.metadata.'.$type.'.options'} =~ m/onlyone/) {
+             $only_one = 'true';
+         }
+         # need to take instructor values out of list where instructor and student
+         # values may be mixed.
+         if ($values && $stu_add) {
+             foreach my $item (split(/,/,$values)) {
+                 $item =~ s/^\s+//;
+                 $meta_options{$item} = $type;
+             }
+             foreach my $item (split(/,/,$value)) {
+                 $item =~ s/^\s+//;
+                 if ($meta_options{$item}) {
+                     push(@cur_values_inst,$item);
+                 } else {
+                     $cur_values_stu .= $item.',';
+                 }
+             }
+         } else {
+             $cur_values_stu = $value;
+         }
+         if ($type eq 'courserestricted') {
+             return ('<input type="hidden" name="new_courserestricted" value="'.$course_key.'" />');
+         }
+         if (($type eq 'keywords') || ($type eq 'subject')
+              || ($type eq 'author')||($type eq  'notes')
+              || ($type eq  'abstract')|| ($type eq  'title')) {
+             if ($values) {
+                 if ($only_one) {
+                     $output .= (&Apache::loncommon::select_form($value,'new_'.$type,%meta_options));
+                 } else {
+                     $output .= (&Apache::loncommon::multiple_select_form('new_'.$type,\@cur_values_inst,undef,\%meta_options));
+                 }
+             }
+             if ($stu_add) {
+                 $output .= '<input type="text" name="'.$fieldname.'" size="'.$size.'" '.
+                 'value="'.$cur_values_stu.'" />'.
+                 &relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,
+                       $relatedvalue);
+             }
+             return ($output);
+         }
+         if (($type eq 'lowestgradelevel') ||
+ 	    ($type eq 'highestgradelevel')) {
+ 	    return &Apache::loncommon::select_level_form($value,$fieldname).
+             &relatedfield(0,$relatedsearchflag,$relatedsep);
+         }
+         return();
+     }
+     # 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);
+     }
+     # 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') ||
+ 	($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);
+     }
+     # 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
+     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/\"/\&quot\;/gs;
+     return
+         '<input type="text" name="'.$fieldname.'" size="'.$size.'" '.
+         'value="'.$value.'" />'.
+         &relatedfield(1,$relatedsearchflag,$relatedsep,$fieldname,
+                       $relatedvalue);
+ }
-   unless ($uri=~/^\/\~/) {
+ # Main Handler
- # =========================================== This is not in construction space
+ sub handler {
+     my $r=shift;
+     #
+     my $uri=$r->uri;
+     #
+     # Set document type
+     &Apache::loncommon::content_type($r,'text/html');
+     $r->send_http_header;
+     return OK if $r->header_only;
+     #
      my ($resdomain,$resuser)=
-            (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
+         (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
+     my $html=&Apache::lonxml::xmlbegin();
+     $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=~/\/portfolio\//) {
+ 	($resdomain,$resuser)=
+ 	    (&Apache::lonnet::declutter($uri)=~m|^(\w+)/(\w+)/portfolio|);
+         $r->print(&Apache::loncommon::bodytag
+           ('Edit Portfolio File Information','','','',$resdomain));
+         &present_editable_metadata($r,$uri,'portfolio');
+         &select_course($r);
+     } 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;
+ }
-     $loaderror=
+ #####################################################
-        &Apache::lonnet::overloaderror($r,
+ #####################################################
-          &Apache::lonnet::homeserver($resuser,$resdomain));
+ ###                                               ###
-     if ($loaderror) { return $loaderror; }
+ ###                Report Bombs                   ###
+ ###                                               ###
-   my %content=();
+ #####################################################
+ #####################################################
- # ----------------------------------------------------------- Set document type
+ sub report_bombs {
+     my ($r,$uri) = @_;
-   $r->content_type('text/html');
+     # Set document type
-   $r->send_http_header;
+     $uri =~ s:/adm/bombs/::;
+     $uri = &Apache::lonnet::declutter($uri);
-   return OK if $r->header_only;
+     $r->print('<h1>'.&Apache::lonnet::clutter($uri).'</h1>');
+     my ($domain,$author)=($uri=~/^(\w+)\/(\w+)\//);
- # ------------------------------------------------------------------- Read file
+     if (&Apache::loncacc::constructaccess('/~'.$author.'/',$domain)) {
-   foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
+ 	if ($env{'form.clearbombs'}) {
-       $content{$_}=&Apache::lonnet::metadata($uri,$_);
+ 	    &Apache::lonmsg::clear_author_res_msg($uri);
-   }
+ 	}
- # ------------------------------------------------------------------ Hide stuff
+         my $clear=&mt('Clear all Messages in Subdirectory');
+ 	$r->print(<<ENDCLEAR);
-   unless ($ENV{'user.adv'}) {
+ <form method="post">
-       foreach ('keywords','notes','abstract','subject') {
+ <input type="submit" name="clearbombs" value="$clear" />
-           $content{$_}='<i>- not displayed -</i>';
+ </form>
-       }
+ ENDCLEAR
-   }
+         my %brokenurls =
+             &Apache::lonmsg::all_url_author_res_msg($author,$domain);
- # --------------------------------------------------------------- Render Output
+         foreach (sort(keys(%brokenurls))) {
-   my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
+             if ($_=~/^\Q$uri\E/) {
- my $creationdate=localtime(
+                 $r->print
-  &Apache::loncommon::unsqltime($content{'creationdate'}));
+                     ('<a href="'.&Apache::lonnet::clutter($_).'">'.$_.'</a>'.
- my $lastrevisiondate=localtime(
+                      &Apache::lonmsg::retrieve_author_res_msg($_).
-  &Apache::loncommon::unsqltime($content{'lastrevisiondate'}));
+                      '<hr />');
- my $language=&Apache::loncommon::languagedescription($content{'language'});
+             }
- my $mime=&Apache::loncommon::filedescription($content{'mime'});
+         }
- my $disuri=&Apache::lonnet::declutter($uri);
+     } else {
-   $disuri=~s/\.meta$//;
+         $r->print(&mt('Not authorized'));
- my $currentversion=&Apache::lonnet::getversion($disuri);
+     }
- my $author=$content{'author'};
+     return;
- $author=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;
+ }
- my $owner=$content{'owner'};
- $owner=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;
+ #####################################################
- my $versiondisplay='';
+ #####################################################
- if ($thisversion) {
+ ###                                               ###
-     $versiondisplay='Version: '.$thisversion.
+ ###        Uneditable Metadata Display            ###
-     ' (most recent version: '.$currentversion.')';
+ ###                                               ###
- } else {
+ #####################################################
-     $versiondisplay='Version: '.$currentversion;
+ #####################################################
- }
+ sub present_uneditable_metadata {
- my $customdistributionfile='';
+     my ($r,$uri) = @_;
- if ($content{'customdistributionfile'}) {
+     #
-    $customdistributionfile='<a href="'.$content{'customdistributionfile'}.
+     my %content=();
-      '"><tt>'.$content{'customdistributionfile'}.'</tt></a>';
+     # Read file
- }
+     foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
- my $bodytag=&Apache::loncommon::bodytag
+         $content{$_}=&Apache::lonnet::metadata($uri,$_);
-             ('Catalog Information','','','',$resdomain);
+     }
-   $r->print(<<ENDHEAD);
+     # Render Output
- <html><head><title>Catalog Information</title></head>
+     # displayed url
- $bodytag
+     my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
- <h2>$content{'title'}</h2>
+     $uri=~s/\.meta$//;
- <h3><tt>$disuri</tt></h3>
+     my $disuri=&Apache::lonnet::clutter($uri);
- $versiondisplay<br />
+     # version
- <table cellspacing=2 border=0>
+     my $currentversion=&Apache::lonnet::getversion($disuri);
- <tr><td bgcolor='#AAAAAA'>Author(s)</td>
+     my $versiondisplay='';
- <td bgcolor="#CCCCCC">$author&nbsp;</td></tr>
+     if ($thisversion) {
- <tr><td bgcolor='#AAAAAA'>Subject</td>
+         $versiondisplay=&mt('Version').': '.$thisversion.
- <td bgcolor="#CCCCCC">$content{'subject'}&nbsp;</td></tr>
+             ' ('.&mt('most recent version').': '.
- <tr><td bgcolor='#AAAAAA'>Keyword(s)</td>
+             ($currentversion>0 ?
- <td bgcolor="#CCCCCC">$content{'keywords'}&nbsp;</td></tr>
+              $currentversion   :
- <tr><td bgcolor='#AAAAAA'>Notes</td>
+              &mt('information not available')).')';
- <td bgcolor="#CCCCCC">$content{'notes'}&nbsp;</td></tr>
+     } else {
- <tr><td bgcolor='#AAAAAA'>Abstract</td>
+         $versiondisplay='Version: '.$currentversion;
- <td bgcolor="#CCCCCC">$content{'abstract'}&nbsp;</td></tr>
+     }
- <tr><td bgcolor='#AAAAAA'>MIME Type</td>
+     # crumbify displayed URL               uri     target prefix form  size
- <td bgcolor="#CCCCCC">$mime ($content{'mime'})&nbsp;</td></tr>
+     $disuri=&Apache::lonhtmlcommon::crumbs($disuri,undef, undef, undef,'+1');
- <tr><td bgcolor='#AAAAAA'>Language</td>
+     $disuri =~ s:<br />::g;
- <td bgcolor="#CCCCCC">$language&nbsp;</td></tr>
+     # obsolete
- <tr><td bgcolor='#AAAAAA'>Creation Date</td>
+     my $obsolete=$content{'obsolete'};
- <td bgcolor="#CCCCCC">$creationdate&nbsp;</td></tr>
+     my $obsoletewarning='';
- <tr><td bgcolor='#AAAAAA'>
+     if (($obsolete) && ($env{'user.adv'})) {
- Last Revision Date</td><td bgcolor="#CCCCCC">$lastrevisiondate&nbsp;</td></tr>
+         $obsoletewarning='<p><font color="red">'.
- <tr><td bgcolor='#AAAAAA'>Publisher/Owner</td>
+             &mt('This resource has been marked obsolete by the author(s)').
- <td bgcolor="#CCCCCC">$owner&nbsp;</td></tr>
+             '</font></p>';
- <tr><td bgcolor='#AAAAAA'>Copyright/Distribution</td>
+     }
- <td bgcolor="#CCCCCC">$content{'copyright'}&nbsp;</td></tr>
+     #
- <tr><td bgcolor='#AAAAAA'>Custom Distribution File</td>
+     my %lt=&fieldnames();
- <td bgcolor="#CCCCCC">$customdistributionfile&nbsp;</td></tr>
+     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',
+              'sourceavail',
+              'sourcerights',
+              '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
-   delete($content{'title'});
+     if ($env{'user.adv'}) {
-   delete($content{'author'});
+         &print_dynamic_metadata($r,$uri,\%content);
-   delete($content{'subject'});
+     }
-   delete($content{'keywords'});
+     return;
-   delete($content{'notes'});
+ }
-   delete($content{'abstract'});
-   delete($content{'mime'});
+ sub print_dynamic_metadata {
-   delete($content{'language'});
+     my ($r,$uri,$content) = @_;
-   delete($content{'creationdate'});
+     #
-   delete($content{'lastrevisiondate'});
+     my %content = %$content;
-   delete($content{'owner'});
+     my %lt=&fieldnames();
-   delete($content{'copyright'});
+     #
-   if ($ENV{'user.adv'}) {
+     my $description = 'Dynamic Metadata (updated periodically)';
- # ------------------------------------------------------------ Dynamic Metadata
+     $r->print('<h3>'.&mt($description).'</h3>'.
-    $r->print(
+               &mt('Processing'));
-    '<h3>Dynamic Metadata (updated periodically)</h3>Processing ...<br>');
+     $r->rflush();
-    $r->rflush();
+     my %items=&fieldnames();
-     my %items=(
+     my %dynmeta=&dynamicmeta($uri);
-  'count'      => 'Network-wide number of accesses (hits)',
+     #
-  'course'     => 'Network-wide number of courses using resource',
+     # General Access and Usage Statistics
-  'usage'      => 'Number of resources using or importing resource',
+     if (exists($dynmeta{'count'}) ||
-  'goto'       => 'Number of resources that follow this resource in maps',
+         exists($dynmeta{'sequsage'}) ||
-  'comefrom'   => 'Number of resources that lead up to this resource in maps',
+         exists($dynmeta{'comefrom'}) ||
-  'clear'      => 'Material presented in clear way',
+         exists($dynmeta{'goto'}) ||
-  'depth'      => 'Material covered with sufficient depth',
+         exists($dynmeta{'course'})) {
-  'helpful'    => 'Material is helpful',
+         $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.
-  'correct'    => 'Material appears to be correct',
+                   '<table cellspacing="2" border="0">');
-  'technical'  => 'Resource is technically correct',
+         foreach ('count',
-  'avetries'   => 'Average number of tries till solved',
+                  'sequsage','sequsage_list',
-  'stdno'      => 'Total number of students who have worked on this problem',
+                  'comefrom','comefrom_list',
-  'difficulty' => 'Degree of difficulty');
+                  'goto','goto_list',
-    my %dynmeta=&dynamicmeta($uri);
+                  'course','course_list') {
-    $r->print(
+             $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
- '</table><h4>Access and Usage Statistics</h4><table cellspacing=2 border=0>');
+                       '<td bgcolor="#CCCCCC">'.
-    foreach ('count') {
+                       &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
-        $r->print(
+         }
- '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
+         $r->print('</table>');
- $dynmeta{$_}."&nbsp;</td></tr>\n");
+     } else {
-    }
+         $r->print('<h4>'.&mt('No Access or Usages Statistics are available for this resource.').'</h4>');
-    foreach my $cat ('usage','comefrom','goto') {
+     }
-        $r->print(
+     #
- '<tr><td bgcolor="#AAAAAA">'.$items{$cat}.'</td><td bgcolor="#CCCCCC">'.
+     # Assessment statistics
- $dynmeta{$cat}.'<font size="-1"><ul>'.join("\n",
+     if ($uri=~/\.(problem|exam|quiz|assess|survey|form)$/) {
-       map { my $murl=$_;
+         if (exists($dynmeta{'stdno'}) ||
-  '<li><a href="'.&Apache::lonnet::clutter($murl).'" target="preview">'.
+             exists($dynmeta{'avetries'}) ||
-                         &Apache::lonnet::gettitle($murl).' [<tt>'.$murl
+             exists($dynmeta{'difficulty'}) ||
-                         .'</tt>]</a></li>' }
+             exists($dynmeta{'disc'})) {
-       split(/\,/,$dynmeta{$cat.'_list'}))."</ul></font></td></tr>\n");
+             # This is an assessment, print assessment data
-    }
+             $r->print('<h4>'.
-    foreach my $cat ('course') {
+                       &mt('Overall Assessment Statistical Data').
-        $r->print(
+                       '</h4>'.
- '<tr><td bgcolor="#AAAAAA">'.$items{$cat}.'</td><td bgcolor="#CCCCCC">'.
+                       '<table cellspacing="2" border="0">');
- $dynmeta{$cat}.'<font size="-1"><ul>'.join("\n",
+             $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{'stdno'}.'</td>'.
-       map { my %courseinfo=&Apache::lonnet::coursedescription($_);
+                       '<td bgcolor="#CCCCCC">'.
-  '<li><a href="/public/'.
+                       &prettyprint('stdno',$dynmeta{'stdno'}).
-   $courseinfo{'domain'}.'/'.$courseinfo{'num'}.'/syllabus" target="preview">'.
+                       '</td>'."</tr>\n");
-   $courseinfo{'description'}.'</a></li>' }
+             foreach ('avetries','difficulty','disc') {
-       split(/\,/,$dynmeta{$cat.'_list'}))."</ul></font></td></tr>\n");
+                 $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
-    }
+                           '<td bgcolor="#CCCCCC">'.
-        $r->print('</table>');
+                           &prettyprint($_,sprintf('%5.2f',$dynmeta{$_})).
-    if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {
+                           '</td>'."</tr>\n");
-       $r->print(
+             }
- '<h4>Assessment Statistical Data</h4><table cellspacing=2 border=0>');
+             $r->print('</table>');
-       foreach ('stdno','avetries') {
+         }
-           $r->print(
+         if (exists($dynmeta{'stats'})) {
- '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
+             #
- $dynmeta{$_}."&nbsp;</td></tr>\n");
+             # New assessment statistics
-       }
+             $r->print('<h4>'.
-       foreach ('difficulty') {
+                       &mt('Detailed Assessment Statistical Data').
-          $r->print(
+                       '</h4>');
- '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
+             my $table = '<table cellspacing="2" border="0">'.
- &diffgraph($dynmeta{$_})."</td></tr>\n");
+                 '<tr>'.
-       }
+                 '<th>Course</th>'.
-       $r->print('</table>');
+                 '<th>Section(s)</th>'.
-    }
+                 '<th>Num Students</th>'.
-    $r->print('<h4>Evaluation Data</h4><table cellspacing=2 border=0>');
+                 '<th>Mean Tries</th>'.
-    foreach ('clear','depth','helpful','correct','technical') {
+                 '<th>Degree of Difficulty</th>'.
-        $r->print(
+                 '<th>Degree of Discrimination</th>'.
- '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.
+                 '<th>Time of computation</th>'.
- &evalgraph($dynmeta{$_})."</td></tr>\n");
+                 '</tr>'.$/;
-    }
+             foreach my $identifier (sort(keys(%{$dynmeta{'stats'}}))) {
-    $r->print('</table>');
+                 my $data = $dynmeta{'stats'}->{$identifier};
-    $disuri=~/^(\w+)\/(\w+)\//;
+                 my $course = $data->{'course'};
-    if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))
+                 my %courseinfo = &Apache::lonnet::coursedescription($course);
-        || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
+                 if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') {
-       $r->print(
+                     &Apache::lonnet::logthis('lookup for '.$course.' failed');
-   '<h4>Evaluation Comments (visible to author and co-authors only)</h4>'.
+                     next;
-       '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
+                 }
-       $r->print(
+                 $table .= '<tr>';
-    '<h4>Error Messages (visible to author and co-authors only)</h4>');
+                 $table .=
-       my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$1,$2);
+                     '<td><nobr>'.$courseinfo{'description'}.'</nobr></td>';
-       foreach (keys %errormsgs) {
+                 $table .=
- 	if ($_=~/^\Q$disuri\E\_\d+$/) {
+                     '<td align="right">'.$data->{'sections'}.'</td>';
-           my %content=&Apache::lonmsg::unpackagemsg($errormsgs{$_});
+                 $table .=
- 	  $r->print('<b>'.$content{'time'}.'</b>: '.$content{'message'}.
+                     '<td align="right">'.$data->{'stdno'}.'</td>';
-                     '<br />');
+                 foreach ('avetries','difficulty','disc') {
-         }
+                     $table .= '<td align="right">';
-       }
+                     if (exists($data->{$_})) {
-    }
+                         $table .= sprintf('%.2f',$data->{$_}).'&nbsp;';
- # ------------------------------------------------------------- All other stuff
+                     } else {
-    $r->print(
+                         $table .= '';
-  '<h3>Additional Metadata (non-standard, parameters, exports)</h3>');
+                     }
-    foreach (sort keys %content) {
+                     $table .= '</td>';
-       my $name=$_;
+                 }
-       my $display=&Apache::lonnet::metadata($uri,$name.'.display');
+                 $table .=
-       unless ($display) { $display=$name; };
+                     '<td><nobr>'.
-       my $otherinfo='';
+                     &Apache::lonlocal::locallocaltime($data->{'timestamp'}).
-       foreach ('name','part','type','default') {
+                     '</nobr></td>';
-           if (defined(&Apache::lonnet::metadata($uri,$name.'.'.$_))) {
+                 $table .=
-              $otherinfo.=' '.$_.'='.
+                     '</tr>'.$/;
- 		 &Apache::lonnet::metadata($uri,$name.'.'.$_).'; ';
+             }
-           }
+             $table .= '</table>'.$/;
-       }
+             $r->print($table);
-       $r->print('<b>'.$display.':</b> '.$content{$name});
+         } else {
-       if ($otherinfo) {
+             $r->print('No new dynamic data found.');
-          $r->print(' ('.$otherinfo.')');
+         }
-       }
+     } else {
-       $r->print("<br>\n");
+         $r->print('<h4>'.
-    }
+           &mt('No Assessment Statistical Data is available for this resource').
-   }
+                   '</h4>');
- # ===================================================== End Resource Space Call
+     }
-  } else {
- # ===================================================== Construction Space Call
+     #
+     #
- # ----------------------------------------------------------- Set document type
+     if (exists($dynmeta{'clear'})   ||
+         exists($dynmeta{'depth'})   ||
-   $r->content_type('text/html');
+         exists($dynmeta{'helpful'}) ||
-   $r->send_http_header;
+         exists($dynmeta{'correct'}) ||
+         exists($dynmeta{'technical'})){
-   return OK if $r->header_only;
+         $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.
- # ---------------------------------------------------------------------- Header
+                   '<table cellspacing="2" border="0">');
-   my $bodytag=&Apache::loncommon::bodytag('Edit Catalog Information');
+         foreach ('clear','depth','helpful','correct','technical') {
-   my $disuri=$uri;
+             $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
-   my $fn=&Apache::lonnet::filelocation('',$uri);
+                       '<td bgcolor="#CCCCCC">'.
-   $disuri=~s/^\/\~\w+//;
+                       &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
-   $disuri=~s/\.meta$//;
+         }
-   my $displayfile='Catalog Information for '.$disuri;
+         $r->print('</table>');
-   if ($disuri=~/\/default$/) {
+     } else {
-       my $dir=$disuri;
+         $r->print('<h4>'.&mt('No Evaluation Data is available for this resource.').'</h4>');
-       $dir=~s/default$//;
+     }
-       $displayfile='Default Cataloging Information for Directory '.$dir;
+     $uri=~/^\/res\/(\w+)\/(\w+)\//;
-   }
+     if ((($env{'user.domain'} eq $1) && ($env{'user.name'} eq $2))
-   %Apache::lonpublisher::metadatafields=();
+         || ($env{'user.role.ca./'.$1.'/'.$2})) {
-   %Apache::lonpublisher::metadatakeys=();
+         if (exists($dynmeta{'comments'})) {
-   &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));
+             $r->print('<h4>'.&mt('Evaluation Comments').' ('.
-   $r->print(<<ENDEDIT);
+                       &mt('visible to author and co-authors only').
- <html><head><title>Edit Catalog Information</title></head>
+                       ')</h4>'.
- $bodytag
+                       '<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$//;
+     $disuri=~s|^/editupload||;
+     my $target=$uri;
+     $target=~s/^\/\~/\/res\/$env{'request.role.domain'}\//;
+     $target=~s/\.meta$//;
+     my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);
+     if ($bombs) {
+         my $showdel=1;
+         if ($env{'form.delmsg'}) {
+             if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {
+                 $bombs=&mt('Messages deleted.');
+ 		$showdel=0;
+             } 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.');
+ 		$showdel=0;
+             } else {
+                 $bombs=&mt('Error clearing messages');
+             }
+         }
+         my $del=&mt('Delete Messages for this Resource');
+ 	my $clear=&mt('Clear all Messages in Subdirectory');
+ 	my $goback=&mt('Back to Source File');
+         $r->print(<<ENDBOMBS);
+ <h1>$disuri</h1>
+ <form method="post" name="defaultmeta">
+ ENDBOMBS
+         if ($showdel) {
+ 	    $r->print(<<ENDDEL);
+ <input type="submit" name="delmsg" value="$del" />
+ <input type="submit" name="clearmsg" value="$clear" />
+ ENDDEL
+         } else {
+             $r->print('<a href="'.$disuri.'" />'.$goback.'</a>');
+ 	}
+ 	$r->print('<br />'.$bombs);
+     } else {
+         my $displayfile='Catalog Information for '.$disuri;
+         if ($disuri=~/\/default$/) {
+             my $dir=$disuri;
+             $dir=~s/default$//;
+             $displayfile=
+                 &mt('Default Cataloging Information for Directory').' '.
+                 $dir;
+         }
+         %Apache::lonpublisher::metadatafields=();
+         %Apache::lonpublisher::metadatakeys=();
+         my $result=&Apache::lonnet::getfile($fn);
+         if ($result == -1){
+             $r->print('Creating new '.$disuri);
+         } else {
+             &Apache::lonpublisher::metaeval($result);
+         }
+         $r->print(<<ENDEDIT);
  <h1>$displayfile</h1>
- <form method="post">
+ <form method="post" name="defaultmeta">
  ENDEDIT
-    foreach ('author','title','subject','keywords','abstract','notes',
+         $r->print('<script language="JavaScript">'.
-             'copyright','customdistributionfile','language') {
+                   &Apache::loncommon::browser_and_searcher_javascript().
-        if ($ENV{'form.new_'.$_}) {
+                   '</script>');
- 	   $Apache::lonpublisher::metadatafields{$_}=$ENV{'form.new_'.$_};
+         my %lt=&fieldnames($file_type);
-        }
+ 	my $output;
-        if (m/copyright/) {
+ 	my @fields;
- 	   $r->print(&Apache::lonpublisher::selectbox($_,'new_'.$_,
+ 	if ($file_type eq 'portfolio') {
- 			       $Apache::lonpublisher::metadatafields{$_},
+ 	    @fields =  ('author','title','subject','keywords','abstract','notes','lowestgradelevel',
- 			       \&Apache::loncommon::copyrightdescription,
+ 	                'highestgradelevel','courserestricted');
- 			       (&Apache::loncommon::copyrightids)));
+ 	} else {
-        } elsif (m/language/) {
+ 	    @fields = ('author','title','subject','keywords','abstract','notes',
- 	   $r->print(&Apache::lonpublisher::selectbox($_,'new_'.$_,
+                  'copyright','customdistributionfile','language',
- 			      $Apache::lonpublisher::metadatafields{$_},
+                  'standards',
- 			      \&Apache::loncommon::languagedescription,
+                  'lowestgradelevel','highestgradelevel','sourceavail','sourcerights',
- 			      (&Apache::loncommon::languageids)));
+                  'obsolete','obsoletereplacement');
-        } else {
+         }
- 	   $r->print(&Apache::lonpublisher::textfield($_,'new_'.$_,
+         my $metacourse;
- 			     $Apache::lonpublisher::metadatafields{$_}));
+         if ($env{'form.metacourse'} ) {
-        }
+             $Apache::lonpublisher::metadatafields{'courserestricted'} = $env{'form.metacourse'};
-    }
+             $metacourse = $env{'form.metacourse'};
-    if ($ENV{'form.store'}) {
+          } else {
-       my $mfh;
+             if (! $Apache::lonpublisher::metadatafields{'courserestricted'}) {
-       unless ($mfh=Apache::File->new('>'.$fn)) {
+                 $Apache::lonpublisher::metadatafields{'courserestricted'}=
-             $r->print(
+                     'none';
-             '<p><font color=red>Could not write metadata, FAIL</font>');
+                 $metacourse = 'none';
-       } else {
+             } else {
-           foreach (sort keys %Apache::lonpublisher::metadatafields) {
+                 $metacourse = $Apache::lonpublisher::metadatafields{'courserestricted'};
-             unless ($_=~/\./) {
+             }
+         }
+         if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
+                 $Apache::lonpublisher::metadatafields{'copyright'}=
+                 'default';
+         }
+         if ($metacourse ne 'none') {
+              $r->print('Document metadata restricted by :<strong> '.$env{$metacourse.".description"}."</strong><br />");
+         }
+         foreach my $field_name(@fields) {
+             if (defined($env{'form.new_'.$field_name})) {
+                 $Apache::lonpublisher::metadatafields{$field_name}=
+                     join(',',&Apache::loncommon::get_env_multiple('form.new_'.$field_name));
+             }
+             if ($metacourse ne 'none') {
+                 # handle restrictions here
+                 if ($env{$metacourse.'.metadata.'.$field_name.'.options'} =~ m/active/){
+                     $output.=('<p>'.$lt{$field_name}.': '.
+                               &prettyinput($field_name,
+ 				   $Apache::lonpublisher::metadatafields{$field_name},
+ 				   'new_'.$field_name,'defaultmeta',undef,undef,undef,undef,$metacourse).'</p>');
+                  } elsif ($field_name eq 'courserestricted') {
+                             $output.=(
+                                 &prettyinput($field_name,
+ 				    $Apache::lonpublisher::metadatafields{$field_name},
+ 				    'new_'.$field_name,'defaultmeta',undef,undef,undef,undef,$metacourse));
+                  }
+             } else {
+                 if ($field_name ne 'courserestricted') {
+                     $output.=('<p>'.$lt{$field_name}.': '.
+                             &prettyinput($field_name,
+ 				   $Apache::lonpublisher::metadatafields{$field_name},
+ 				   'new_'.$field_name,'defaultmeta').'</p>');
+ 	        } else {
+                     $output.=&prettyinput($field_name,
+ 				   $Apache::lonpublisher::metadatafields{$field_name},
+ 				   'new_'.$field_name,'defaultmeta');
+                 }
+             }
+         }
+         if ($env{'form.store'}) {
+             my $mfh;
+             my $formname='store';
+             my $file_content;
+             foreach my $meta_field (keys %env) {
+                 if (&Apache::loncommon::get_env_multiple('form.new_keywords')) {
+                     $Apache::lonpublisher::metadatafields{'keywords'} =
+                         join (',', &Apache::loncommon::get_env_multiple('form.new_keywords'));
+                 }
+             }
+             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";
+                 $file_content.= "\n\<$tag";
-                 foreach
+                 foreach (split(/\,/,
-                   (split(/\,/,$Apache::lonpublisher::metadatakeys{$unikey})) {
+                              $Apache::lonpublisher::metadatakeys{$unikey})
+                          ) {
                      my $value=
-                        $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
+                      $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
                      $value=~s/\"/\'\'/g;
-                     print $mfh ' '.$_.'="'.$value.'"';
+                     $file_content.=' '.$_.'="'.$value.'"' ;
+                     # print $mfh ' '.$_.'="'.$value.'"';
+                 }
+                 $file_content.= '>'.
+                     &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'});
+                 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>');
                  }
-                 print $mfh '>'.
+             }
-         &HTML::Entities::encode($Apache::lonpublisher::metadatafields{$unikey})
+         }
-                         .'</'.$tag.'>';
+ 	$r->print($output.'<br /><input type="submit" name="store" value="'.
-             }
+                   &mt('Store Catalog Information').'">');
- 	  }
-           $r->print('<p>Wrote Metadata');
-       }
      }
-     $r->print(
+     $r->print('</form>');
-  '<br /><input type="submit" name="store" value="Store Catalog Information"></form></body></html>');
+     return;
-     return OK;
-   }
  }
 ;
  __END__

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.

Removed from v.1.32
changed lines
	Added in v.1.132