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

Diff for /loncom/interface/lonmeta.pm between versions 1.48 and 1.68

version 1.48, 2003/12/29 21:17:00 version 1.68, 2004/04/14 18:30:36
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();
Line 37  use Apache::lonmsg; Line 38  use Apache::lonmsg;
 use Apache::lonpublisher;  use Apache::lonpublisher;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonmysql;  use Apache::lonmysql;
   use Apache::lonmsg;
   
 # MySQL table columns  
   
 my @columns;  
   
 # ----------------------------------------- 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 53  sub dynamicmeta { Line 51  sub dynamicmeta {
     $regexp='___'.$regexp.'___';      $regexp='___'.$regexp.'___';
     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,      my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
        $aauthor,$regexp);         $aauthor,$regexp);
     my %sum=();      my %DynamicData = &LONCAPA::lonmetadata::process_reseval_data(\%evaldata);
     my %cnt=();      my %Data = &LONCAPA::lonmetadata::process_dynamic_metadata($url,
     my %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 126  sub access_count { Line 80  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) {
Line 170  sub evalgraph { Line 126  sub evalgraph {
  $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> ('.$value.') </td></tr></table>';
     return $output;      return $output;
Line 178  sub evalgraph { Line 134  sub evalgraph {
   
 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');
Line 194  sub diffgraph { Line 152  sub diffgraph {
     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(      return &Apache::lonlocal::texthash
    'title' => 'Title',          (
    'author' =>'Author(s)',           'title' => 'Title',
    'subject' => 'Subject',           'author' =>'Author(s)',
    'keywords' => 'Keyword(s)',           'authorspace' => 'Author Space',
    'notes' => 'Notes',           'modifyinguser' => 'Last Modifying User',
    'abstract' => 'Abstract',           'subject' => 'Subject',
                                    'lowestgradelevel' => 'Lowest Grade Level',           'keywords' => 'Keyword(s)',
                                    'highestgradelevel' => 'Highest Grade Level',           'notes' => 'Notes',
                                    'standards' => 'Standards',           'abstract' => 'Abstract',
    'mime' => 'MIME Type',           'lowestgradelevel' => 'Lowest Grade Level',
    'language' => 'Language',           'highestgradelevel' => 'Highest Grade Level',
    'creationdate' => 'Creation Date',           'standards' => 'Standards',
    'lastrevisiondate' => 'Last Revision Date',           'mime' => 'MIME Type',
    'owner' => 'Publisher/Owner',           'language' => 'Language',
                                    'copyright' => 'Copyright/Distribution',           'creationdate' => 'Creation Date',
    'customdistributionfile' => 'Custom Distribution File',           'lastrevisiondate' => 'Last Revision Date',
                                    'obsolete' => 'Obsolete',           'owner' => 'Publisher/Owner',
    'obsoletereplacement' => 'Suggested Replacement for Obsolete File',           'copyright' => 'Copyright/Distribution',
    'count'      => 'Network-wide number of accesses (hits)',           'customdistributionfile' => 'Custom Distribution File',
    'course'     => 'Network-wide number of courses using resource',           'obsolete' => 'Obsolete',
    'course_list' => 'Network-wide courses using resource',           'obsoletereplacement' => 'Suggested Replacement for Obsolete File',
    'sequsage'      => 'Number of resources using or importing resource',           'count'      => 'Network-wide number of accesses (hits)',
    'sequsage_list' => 'Resources using or importing resource',           'course'     => 'Network-wide number of courses using resource',
    'goto'       => 'Number of resources that follow this resource in maps',           'course_list' => 'Network-wide courses using resource',
    'goto_list'  => 'Resources that follow this resource in maps',           'sequsage'      => 'Number of resources using or importing resource',
    'comefrom'   => 'Number of resources that lead up to this resource in maps',           'sequsage_list' => 'Resources using or importing resource',
    'comefrom_list' => 'Resources that lead up to this resource in maps',           'goto'       => 'Number of resources that follow this resource in maps',
    'clear'      => 'Material presented in clear way',           'goto_list'  => 'Resources that follow this resource in maps',
    'depth'      => 'Material covered with sufficient depth',           'comefrom'   => 'Number of resources that lead up to this resource in maps',
    'helpful'    => 'Material is helpful',           'comefrom_list' => 'Resources that lead up to this resource in maps',
    'correct'    => 'Material appears to be correct',           'clear'      => 'Material presented in clear way',
    'technical'  => 'Resource is technically correct',            'depth'      => 'Material covered with sufficient depth',
    'avetries'   => 'Average number of tries till solved',           'helpful'    => 'Material is helpful',
    'stdno'      => 'Total number of students who have worked on this problem',           'correct'    => 'Material appears to be correct',
    'difficulty' => 'Degree of difficulty'           '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'
            );
 }  }
   
 # =========================================== Pretty printing of metadata field  # Pretty printing of metadata field
   
 sub prettyprint {  sub prettyprint {
     my ($type,$value)=@_;      my ($type,$value)=@_;
     unless (defined($value)) { return '&nbsp;'; }      if (! defined($value)) { 
 # Title          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 &Apache::lonlocal::locallocaltime(   return ($value?&Apache::lonlocal::locallocaltime(
   &Apache::lonmysql::unsqltime($value));    &Apache::lonmysql::unsqltime($value)):
    &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      # 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 283  sub prettyprint { Line 236  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 {   return join('<br />',map {
        &Apache::lonnet::gettitle($_).' ['.              my $url=&Apache::lonnet::clutter($_);
        &Apache::lonhtmlcommon::crumbs(&Apache::lonnet::clutter($_),'preview').']';              '<b>'.&Apache::lonnet::gettitle($url).'</b>'.
     } split(/\s*\,\s*/,$value));                  &Apache::lonhtmlcommon::crumbs($url,'preview','',undef,'+0');
           } split(/\s*\,\s*/,$value));
     }      }
 # Evaluations      # Evaluations
     if (($type eq 'clear') ||      if (($type eq 'clear') ||
  ($type eq 'depth') ||   ($type eq 'depth') ||
  ($type eq 'helpful') ||   ($type eq 'helpful') ||
Line 309  sub prettyprint { Line 265  sub prettyprint {
  ($type eq 'technical')) {   ($type eq 'technical')) {
  return &evalgraph($value);   return &evalgraph($value);
     }      }
 # Difficulty      # Difficulty
     if ($type eq 'difficulty') {      if ($type eq 'difficulty') {
  return &diffgraph($value);   return &diffgraph($value);
     }      }
 # List of courses      # List of courses
     if ($type=~/\_list/) {      if ($type=~/\_list/) {
  return join('<br />',map {   return join('<br />',map {
     my %courseinfo=&Apache::lonnet::coursedescription($_);        my %courseinfo=&Apache::lonnet::coursedescription($_);  
Line 322  sub prettyprint { Line 278  sub prettyprint {
  $courseinfo{'description'}.'</a>';   $courseinfo{'description'}.'</a>';
  } split(/\s*\,\s*/,$value));   } split(/\s*\,\s*/,$value));
     }      }
 # No pretty print found      # No pretty print found
     return $value;      return $value;
 }  }
 # ============================================== Pretty input of metadata field  
   # Pretty input of metadata field
   sub direct {
       return shift;
   }
   
 sub selectbox {  sub selectbox {
     my ($name,$value,$functionref,@idlist)=@_;      my ($name,$value,$functionref,@idlist)=@_;
       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 340  sub selectbox { Line 303  sub selectbox {
     return $selout.'</select>';      return $selout.'</select>';
 }  }
   
   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 {  sub prettyinput {
     my ($type,$value,$fieldname,$formname)=@_;      my ($type,$value,$fieldname,$formname,
 # Language   $relatedsearchflag,$relatedsep,$relatedvalue)=@_;
       # 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);
     }      }
 # 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);
     }      }
 # Gradelevels      # 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);
     }      }
 # 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); 
     }      }
 # 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); 
 # 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); 
     }      }
 # 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);
     }      }
 # 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/\"/\&quod\;/gs;
     return '<input type="text" name="'.$fieldname.'" size="80" value="'.$value.'" />';       return 
           '<input type="text" name="'.$fieldname.'" size="80" '.
           '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=~/^\/\~/) {       # Check to see if this server is overloaded
 # =========================================== This is not in construction space      my $loaderror=&Apache::lonnet::overloaderror($r);
       if ($loaderror) { 
           return $loaderror;
       }
       #
       # Check to see if original resource server is overloaded
     my ($resdomain,$resuser)=      my ($resdomain,$resuser)=
            (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);          (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
       $loaderror=&Apache::lonnet::overloaderror
     $loaderror=          ($r,&Apache::lonnet::homeserver($resuser,$resdomain));
        &Apache::lonnet::overloaderror($r,      if ($loaderror) { 
          &Apache::lonnet::homeserver($resuser,$resdomain));          return $loaderror;
     if ($loaderror) { return $loaderror; }      }
       #
   my %content=();      # Set document type
       &Apache::loncommon::content_type($r,'text/html');
 # ----------------------------------------------------------- Set document type      $r->send_http_header;
       return OK if $r->header_only;
   &Apache::loncommon::content_type($r,'text/html');      #
   $r->send_http_header;      $r->print('<html><head><title>'.
                 'Catalog Information'.
                 '</title></head>');
       if ($uri=~m:/adm/bombs/(.*)$:) {
           $r->print(&Apache::loncommon::bodytag('Error Messages'));
           # Looking for all bombs?
           &report_bombs($r,$uri);
       } elsif ($uri=~/^\/\~/) { 
           # Construction space
           $r->print(&Apache::loncommon::bodytag
                     ('Edit Catalog Information','','','',$resdomain));
           &present_editable_metadata($r,$uri);
       } else {
           $r->print(&Apache::loncommon::bodytag
                     ('Catalog Information','','','',$resdomain));
           &present_uneditable_metadata($r,$uri);
       }
       $r->print('</body></html>');
       return OK;
   }
   
   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)) {
           my %brokenurls = 
               &Apache::lonmsg::all_url_author_res_msg($author,$domain);
           foreach (sort(keys(%brokenurls))) {
               if ($_=~/^\Q$uri\E/) {
                   $r->print(&Apache::lonhtmlcommon::crumbs
                             (&Apache::lonnet::clutter($_)).
                             &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$//;
     my $disuri=&Apache::lonnet::clutter($uri);      my $disuri=&Apache::lonnet::clutter($uri);
     $disuri=~s/\.meta$//;      # version
     $disuri=&Apache::lonhtmlcommon::crumbs($disuri);  
 # 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;
     }      }
 # obsolete      # crumbify displayed URL
       $disuri=&Apache::lonhtmlcommon::crumbs($disuri);
       # 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  
             ('Catalog Information','','','',$resdomain);  
     foreach ('title',       foreach ('title', 
      'author',                'author', 
      'subject',                'subject', 
      'keywords',                'keywords', 
      'notes',                'notes', 
      'abstract',                'abstract',
      'mime',                'lowestgradelevel',
      'language',                'highestgradelevel',
      'creationdate',                'standards', 
      'lastrevisiondate',                'mime', 
      'owner',                'language', 
      'copyright',                'creationdate', 
      'customdistributionfile',                'lastrevisiondate', 
      'obsolete',                'owner', 
      'obsoletereplacement') {               'copyright', 
  $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.               'customdistributionfile', 
         '</td><td bgcolor="#CCCCCC">'.               'obsolete', 
                 &prettyprint($_,$content{$_}).'</td></tr>';               'obsoletereplacement') {
  delete $content{$_};          $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.
               '</td><td bgcolor="#CCCCCC">'.
               &prettyprint($_,$content{$_}).'</td></tr>';
           delete $content{$_};
     }      }
       #
   $r->print(<<ENDHEAD);      $r->print(<<ENDHEAD);
 <html><head><title>Catalog Information</title></head>  
 $bodytag  
 <h2>$content{'title'}</h2>  <h2>$content{'title'}</h2>
 <h3><tt>$disuri</tt></h3>  <h3><tt>$disuri</tt></h3>
 $obsoletewarning  $obsoletewarning
Line 489  $versiondisplay<br /> Line 540  $versiondisplay<br />
 $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').' ...<br />');
        '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$/) {      $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.
 # This is an assessment, print assessment data                '<table cellspacing=2 border=0>');
   $r->print(      foreach ('count',
     '<h4>'.&mt('Assessment Statistical Data').'</h4><table cellspacing=2 border=0>');               'sequsage','sequsage_list',
   foreach ('stdno','avetries','difficulty') {               'comefrom','comefrom_list',
       $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td><td bgcolor="#CCCCCC">'.               'goto','goto_list',
  &prettyprint($dynmeta{$_})."</td></tr>\n");               'course','course_list') {
   }          $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
   $r->print('</table>');                        '<td bgcolor="#CCCCCC">'.
       }                    &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
       $r->print('<h4>'.&mt('Evaluation Data').'</h4><table cellspacing=2 border=0>');      }
       foreach ('clear','depth','helpful','correct','technical') {      $r->print('</table>');
   $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td><td bgcolor="#CCCCCC">'.      if ($uri=~/\.(problem|exam|quiz|assess|survey|form)$/) {
     &prettyprint($dynmeta{$_})."</td></tr>\n");          # This is an assessment, print assessment data
      }              $r->print(
       $r->print('</table>');                    '<h4>'.&mt('Assessment Statistical Data').'</h4>'.
       $disuri=~/^(\w+)\/(\w+)\//;                       '<table cellspacing=2 border=0>');
       if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))          foreach ('stdno','avetries','difficulty') {
   || ($ENV{'user.role.ca./'.$1.'/'.$2})) {              $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
   $r->print(                        '<td bgcolor="#CCCCCC">'.
     '<h4>'.&mt('Evaluation Comments').' ('.&mt('visible to author and co-authors only').')</h4>'.                        &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
     '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');          }
   $r->print('<h4>'.&mt('Error Messages').' ('.          $r->print('</table>');    
     &mt('visible to author and co-authors only').')</h4>');      }
   my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$1,$2);      
   foreach (keys %errormsgs) {      $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.
       if ($_=~/^\Q$disuri\E\_\d+$/) {                '<table cellspacing=2 border=0>');
   my %content=&Apache::lonmsg::unpackagemsg($errormsgs{$_});      foreach ('clear','depth','helpful','correct','technical') {
   $r->print('<b>'.$content{'time'}.'</b>: '.$content{'message'}.          $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
     '<br />');                    '<td bgcolor="#CCCCCC">'.
       }                    &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
   }            }
       }      $r->print('</table>');
 # ------------------------------------------------------------- All other stuff      $uri=~/^\/res\/(\w+)\/(\w+)\//; 
       $r->print(      if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))
  '<h3>'.&mt('Additional Metadata (non-standard, parameters, exports)').'</h3>');          || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
       foreach (sort keys %content) {          $r->print('<h4>'.&mt('Evaluation Comments').' ('.
   my $name=$_;                    &mt('visible to author and co-authors only').
   unless ($name=~/\.display$/) {                    ')</h4>'.
       my $display=&Apache::lonnet::metadata($uri,$name.'.display');                    '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
       unless ($display) { $display=$name; };          $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.
       my $otherinfo='';                    &mt('visible to author and co-authors only').')'.
       foreach ('name','part','type','default') {                    '</h4>'.
   if (defined(&Apache::lonnet::metadata($uri,$name.'.'.$_))) {                    &Apache::lonmsg::retrieve_author_res_msg($uri));
       $otherinfo.=' '.$_.'='.      }
   &Apache::lonnet::metadata($uri,$name.'.'.$_).'; ';      # All other stuff
   }      $r->print('<h3>'.
       }                &mt('Additional Metadata (non-standard, parameters, exports)').
       $r->print('<b>'.$display.':</b> '.$content{$name});                '</h3>');
       if ($otherinfo) {      foreach (sort(keys(%content))) {
   $r->print(' ('.$otherinfo.')');          my $name=$_;
       }          if ($name!~/\.display$/) {
       $r->print("<br />\n");              my $display=&Apache::lonnet::metadata($uri,
   }                                                    $name.'.display');
       }              if (! $display) { 
   }                  $display=$name;
 # ===================================================== End Resource Space Call              };
  } else {              my $otherinfo='';
 # ===================================================== Construction Space Call              foreach ('name','part','type','default') {
                   if (defined(&Apache::lonnet::metadata($uri,
 # ----------------------------------------------------------- Set document type                                                        $name.'.'.$_))) {
                       $otherinfo.=' '.$_.'='.
   &Apache::loncommon::content_type($r,'text/html');                          &Apache::lonnet::metadata($uri,
   $r->send_http_header;                                                    $name.'.'.$_).'; ';
                   }
   return OK if $r->header_only;              }
 # ---------------------------------------------------------------------- Header              $r->print('<b>'.$display.':</b> '.$content{$name});
   my $bodytag=&Apache::loncommon::bodytag('Edit Catalog Information');              if ($otherinfo) {
   my $disuri=$uri;                  $r->print(' ('.$otherinfo.')');
   my $fn=&Apache::lonnet::filelocation('',$uri);              }
   $disuri=~s/^\/\~\w+//;              $r->print("<br />\n");
   $disuri=~s/\.meta$//;          }
   my $displayfile='Catalog Information for '.$disuri;      }
   if ($disuri=~/\/default$/) {      return;
       my $dir=$disuri;  }
       $dir=~s/default$//;  
       $displayfile=&mt('Default Cataloging Information for Directory').' '.  #####################################################
   $dir;  #####################################################
   }  ###                                               ###
   %Apache::lonpublisher::metadatafields=();  ###          Editable metadata display            ###
   %Apache::lonpublisher::metadatakeys=();  ###                                               ###
   &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));  #####################################################
   $r->print(<<ENDEDIT);  #####################################################
   sub present_editable_metadata {
       my ($r,$uri) = @_;
       # Construction Space Call
       # Header
       my $disuri=$uri;
       my $fn=&Apache::lonnet::filelocation('',$uri);
       $disuri=~s/^\/\~/\/priv\//;
       $disuri=~s/\.meta$//;
       my $target=$uri;
       $target=~s/^\/\~/\/res\/$ENV{'request.role.domain'}\//;
       $target=~s/\.meta$//;
       my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);
       if ($bombs) {
           if ($ENV{'form.delmsg'}) {
               if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {
                   $bombs=&mt('Messages deleted.');
               } else {
                   $bombs=&mt('Error deleting messages');
               }
           }
           my $del=&mt('Delete Messages');
           $r->print(<<ENDBOMBS);
   <h1>$disuri</h1>
   <form method="post" name="defaultmeta">
   <input type="submit" name="delmsg" value="$del" />
   <br />$bombs
   ENDBOMBS
       } else {
           my $displayfile='Catalog Information for '.$disuri;
           if ($disuri=~/\/default$/) {
               my $dir=$disuri;
               $dir=~s/default$//;
               $displayfile=
                   &mt('Default Cataloging Information for Directory').' '.
                   $dir;
           }
           my $bodytag=
               &Apache::loncommon::bodytag('Edit Catalog Information');
           %Apache::lonpublisher::metadatafields=();
           %Apache::lonpublisher::metadatakeys=();
           &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));
           $r->print(<<ENDEDIT);
 <html><head><title>Edit Catalog Information</title></head>  <html><head><title>Edit Catalog Information</title></head>
 $bodytag  $bodytag
 <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();
    foreach ('author','title','subject','keywords','abstract','notes',          foreach ('author','title','subject','keywords','abstract','notes',
             'copyright','customdistributionfile','language','standards',                   'copyright','customdistributionfile','language',
     'lowestgradelevel','highestgradelevel',                   'standards',
             'obsolete','obsoletereplacement') {                   'lowestgradelevel','highestgradelevel',
        $Apache::lonpublisher::metadatafields{$_}=$ENV{'form.new_'.$_};                   'obsolete','obsoletereplacement') {
        unless ($Apache::lonpublisher::metadatafields{'copyright'}) {              if (defined($ENV{'form.new_'.$_})) {
    $Apache::lonpublisher::metadatafields{'copyright'}='default';                  $Apache::lonpublisher::metadatafields{$_}=
        }                      $ENV{'form.new_'.$_};
        $r->print('<p>'.$lt{$_}.': '.&prettyinput($_,              }
   $Apache::lonpublisher::metadatafields{$_},              if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
   'new_'.$_,'defaultmeta').'</p>');                  $Apache::lonpublisher::metadatafields{'copyright'}=
    }                      'default';
    if ($ENV{'form.store'}) {              }
       my $mfh;              $r->print('<p>'.$lt{$_}.': '.
       unless ($mfh=Apache::File->new('>'.$fn)) {                        &prettyinput
             $r->print(                        ($_,$Apache::lonpublisher::metadatafields{$_},
             '<p><font color=red>'.&mt('Could not write metadata').', '.                         'new_'.$_,'defaultmeta').'</p>');
       &mt('FAIL').'</font>');          }
       } else {          if ($ENV{'form.store'}) {
           foreach (sort keys %Apache::lonpublisher::metadatafields) {              my $mfh;
             unless ($_=~/\./) {              if (!  ($mfh=Apache::File->new('>'.$fn))) {
                 my $unikey=$_;                  $r->print('<p><font color=red>'.
                 $unikey=~/^([A-Za-z]+)/;                            &mt('Could not write metadata').', '.
                 my $tag=$1;                            &mt('FAIL').'</font>');
                 $tag=~tr/A-Z/a-z/;              } else {
                 print $mfh "\n\<$tag";                  foreach (sort keys %Apache::lonpublisher::metadatafields) {
                 foreach                       next if ($_ =~ /\./);
                   (split(/\,/,$Apache::lonpublisher::metadatakeys{$unikey})) {                      my $unikey=$_;
                     my $value=                      $unikey=~/^([A-Za-z]+)/;
                        $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};                      my $tag=$1;
                     $value=~s/\"/\'\'/g;                      $tag=~tr/A-Z/a-z/;
                     print $mfh ' '.$_.'="'.$value.'"';                      print $mfh "\n\<$tag";
                       foreach (split(/\,/,
                                    $Apache::lonpublisher::metadatakeys{$unikey})
                                ) {
                           my $value=
                            $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
                           $value=~s/\"/\'\'/g;
                           print $mfh ' '.$_.'="'.$value.'"';
                       }
                       print $mfh '>'.
                           &HTML::Entities::encode
                           ($Apache::lonpublisher::metadatafields{$unikey},
                            '<>&"').
                            '</'.$tag.'>';
                 }                  }
                 print $mfh '>'.                  $r->print('<p>'.&mt('Wrote Metadata'));
         &HTML::Entities::encode($Apache::lonpublisher::metadatafields{$unikey})  
                         .'</'.$tag.'>';  
             }              }
   }          }
           $r->print('<p>'.&mt('Wrote Metadata'));          $r->print('<br /><input type="submit" name="store" value="'.
       }                    &mt('Store Catalog Information').'">');
     }      }
     $r->print(      $r->print('</form>');
  '<br /><input type="submit" name="store" value="'.      return;
 &mt('Store Catalog Information').'"></form></body></html>');  
     return OK;  
   }  
 }  }
   
 # ================================================================= BEGIN Block  
 BEGIN {  
 # Get columns of MySQL metadata table  
     @columns=&Apache::lonmysql::col_order('metadata');  
 }  
 1;  1;
 __END__  __END__
   
   
   
   
   
   
   
Removed from v.1.48  
changed lines
  Added in v.1.68

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