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

Diff for /loncom/interface/lonmeta.pm between versions 1.45 and 1.67

version 1.45, 2003/12/29 15:10:54 version 1.67, 2004/04/14 16:14:29
Line 29 Line 29
 package Apache::lonmeta;  package Apache::lonmeta;
   
 use strict;  use strict;
   use LONCAPA::lonmetadata();
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::lonnet();  use Apache::lonnet();
 use Apache::loncommon();  use Apache::loncommon();
   use Apache::lonhtmlcommon();
 use Apache::lonmsg;  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 52  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' seperately      # Deal with 'count' separately
     $returnhash{'count'} = &access_count($url,$aauthor,$adomain);      $Data{'count'} = &access_count($url,$aauthor,$adomain);
       #
     return %returnhash;      # Debugging code I will probably need later
       if (0) {
           &Apache::lonnet::logthis('Dynamic Metadata');
           while(my($k,$v)=each(%Data)){
               &Apache::lonnet::logthis('    "'.$k.'"=>"'.$v.'"');
           }
           &Apache::lonnet::logthis('-------------------');
       }
       return %Data;
 }  }
   
 sub access_count {  sub access_count {
Line 116  sub access_count { Line 74  sub access_count {
     my %countdata=&Apache::lonnet::dump('nohist_accesscount',$adomain,      my %countdata=&Apache::lonnet::dump('nohist_accesscount',$adomain,
                                         $author,$src);                                          $author,$src);
     if (! exists($countdata{$src})) {      if (! exists($countdata{$src})) {
         return 'Not Available';          return &mt('Not Available');
     } else {      } else {
         return $countdata{$src};          return $countdata{$src};
     }      }
 }  }
   
 # ------------------------------------- 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 '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).' <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 166  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 174  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 190  sub diffgraph { Line 152  sub diffgraph {
     return $output;      return $output;
 }  }
   
 # ==================================================== Turn MySQL row into hash  
   
 sub metadata_col_to_hash {  # The field names
     my @cols=@_;  sub fieldnames {
     my %hash=();      return &Apache::lonlocal::texthash
     for (my $i=0; $i<=$#columns; $i++) {          (
  $hash{$columns[$i]}=$cols[$i];           'title' => 'Title',
     }           'author' =>'Author(s)',
     return %hash;           'authorspace' => 'Author Space',
            'modifyinguser' => 'Last Modifying User',
            'subject' => 'Subject',
            'keywords' => 'Keyword(s)',
            'notes' => 'Notes',
            'abstract' => 'Abstract',
            'lowestgradelevel' => 'Lowest Grade Level',
            'highestgradelevel' => 'Highest Grade Level',
            'standards' => 'Standards',
            'mime' => 'MIME Type',
            'language' => 'Language',
            'creationdate' => 'Creation Date',
            'lastrevisiondate' => 'Last Revision Date',
            'owner' => 'Publisher/Owner',
            'copyright' => 'Copyright/Distribution',
            'customdistributionfile' => 'Custom Distribution File',
            'obsolete' => 'Obsolete',
            'obsoletereplacement' => 'Suggested Replacement for Obsolete File',
            'count'      => 'Network-wide number of accesses (hits)',
            'course'     => 'Network-wide number of courses using resource',
            'course_list' => 'Network-wide courses using resource',
            'sequsage'      => 'Number of resources using or importing resource',
            'sequsage_list' => 'Resources using or importing resource',
            'goto'       => 'Number of resources that follow this resource in maps',
            'goto_list'  => 'Resources that follow this resource in maps',
            'comefrom'   => 'Number of resources that lead up to this resource in maps',
            'comefrom_list' => 'Resources that lead up to this resource in maps',
            'clear'      => 'Material presented in clear way',
            'depth'      => 'Material covered with sufficient depth',
            'helpful'    => 'Material is helpful',
            'correct'    => 'Material appears to be correct',
            'technical'  => 'Resource is technically correct', 
            'avetries'   => 'Average number of tries till solved',
            'stdno'      => 'Total number of students who have worked on this problem',
            'difficulty' => 'Degree of difficulty'
            );
 }  }
   
 # ============================================================= The field names  # Pretty printing of metadata field
   
 sub fieldnames {  sub prettyprint {
     return &Apache::lonlocal::texthash(      my ($type,$value)=@_;
    'title' => 'Title',      if (! defined($value)) { 
    'author' =>'Author(s)',          return '&nbsp;'; 
    'subject' => 'Subject',      }
    'keywords' => 'Keyword(s)',      # Title
    'notes' => 'Notes',      if ($type eq 'title') {
    'abstract' => 'Abstract',   return '<font size="+1" face="arial">'.$value.'</font>';
                                    'lowestgradelevel' => 'Lowest Grade Level',      }
                                    'highestgradelevel' => 'Highest Grade Level',      # Dates
                                    'standards' => 'Standards',      if (($type eq 'creationdate') ||
    'mime' => 'MIME Type',   ($type eq 'lastrevisiondate')) {
    'language' => 'Language',   return ($value?&Apache::lonlocal::locallocaltime(
    'creationdate' => 'Creation Date',    &Apache::lonmysql::unsqltime($value)):
    'lastrevisiondate' => 'Last Revision Date',   &mt('not available'));
    'owner' => 'Publisher/Owner',      }
                                    'copyright' => 'Copyright/Distribution',      # Language
    'customdistributionfile' => 'Custom Distribution File',      if ($type eq 'language') {
                                    'obsolete' => 'Obsolete',   return &Apache::loncommon::languagedescription($value);
    'obsoletereplacement' => 'Suggested Replacement for Obsolete File',      }
    'count'      => 'Network-wide number of accesses (hits)',      # Copyright
    'course'     => 'Network-wide number of courses using resource',      if ($type eq 'copyright') {
    'usage'      => 'Number of resources using or importing resource',   return &Apache::loncommon::copyrightdescription($value);
    'goto'       => 'Number of resources that follow this resource in maps',      }
    'comefrom'   => 'Number of resources that lead up to this resource in maps',      # MIME
    'clear'      => 'Material presented in clear way',      if ($type eq 'mime') {
    'depth'      => 'Material covered with sufficient depth',          return '<img src="'.&Apache::loncommon::icon($value).'" />&nbsp;'.
    'helpful'    => 'Material is helpful',              &Apache::loncommon::filedescription($value);
    'correct'    => 'Material appears to be correct',      }
    'technical'  => 'Resource is technically correct',       # Person
    'avetries'   => 'Average number of tries till solved',      if (($type eq 'author') || 
    'stdno'      => 'Total number of students who have worked on this problem',   ($type eq 'owner') ||
    'difficulty' => 'Degree of difficulty'   ($type eq 'modifyinguser') ||
        );   ($type eq 'authorspace')) {
    $value=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;
    return $value;
       }
       # Gradelevel
       if (($type eq 'lowestgradelevel') ||
    ($type eq 'highestgradelevel')) {
    return &Apache::loncommon::gradeleveldescription($value);
       }
       # Only for advance users below
       if (! $ENV{'user.adv'}) { 
           return '<i>- '.&mt('not displayed').' -</i>';
       }
       # File
       if (($type eq 'customdistributionfile') ||
    ($type eq 'obsoletereplacement') ||
    ($type eq 'goto_list') ||
    ($type eq 'comefrom_list') ||
    ($type eq 'sequsage_list')) {
    return join('<br />',map {
               my $url=&Apache::lonnet::clutter($_);
               '<b>'.&Apache::lonnet::gettitle($url).'</b>'.
                   &Apache::lonhtmlcommon::crumbs($url,'preview','',undef,'+0');
           } split(/\s*\,\s*/,$value));
       }
       # Evaluations
       if (($type eq 'clear') ||
    ($type eq 'depth') ||
    ($type eq 'helpful') ||
    ($type eq 'correct') ||
    ($type eq 'technical')) {
    return &evalgraph($value);
       }
       # Difficulty
       if ($type eq 'difficulty') {
    return &diffgraph($value);
       }
       # List of courses
       if ($type=~/\_list/) {
    return join('<br />',map {
       my %courseinfo=&Apache::lonnet::coursedescription($_);  
       '<a href="/public/'.
    $courseinfo{'domain'}.'/'.$courseinfo{'num'}.'/syllabus" target="preview">'.
    $courseinfo{'description'}.'</a>';
    } split(/\s*\,\s*/,$value));
       }
       # No pretty print found
       return $value;
 }  }
 # ================================================================ Main Handler  
   
 sub handler {  # Pretty input of metadata field
   my $r=shift;  sub direct {
       return shift;
   }
   
     my $loaderror=&Apache::lonnet::overloaderror($r);  sub selectbox {
     if ($loaderror) { return $loaderror; }      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>';
   }
   
   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"':'').' />';
   }
   
     my $uri=$r->uri;  sub prettyinput {
       my ($type,$value,$fieldname,$formname,
    $relatedsearchflag,$relatedsep,$relatedvalue)=@_;
       # Language
       if ($type eq 'language') {
    return &selectbox($fieldname,
     $value,
     \&Apache::loncommon::languagedescription,
     (&Apache::loncommon::languageids)).
                                 &relatedfield(0,$relatedsearchflag,$relatedsep);
       }
       # Copyright
       if ($type eq 'copyright') {
    return &selectbox($fieldname,
     $value,
     \&Apache::loncommon::copyrightdescription,
     (&Apache::loncommon::copyrightids)).
                                 &relatedfield(0,$relatedsearchflag,$relatedsep);
       }
       # Gradelevels
       if (($type eq 'lowestgradelevel') ||
    ($type eq 'highestgradelevel')) {
    return &Apache::loncommon::select_level_form($value,$fieldname).
               &relatedfield(0,$relatedsearchflag,$relatedsep);
       }
       # Obsolete
       if ($type eq 'obsolete') {
    return '<input type="checkbox" name="'.$fieldname.'"'.
       ($value?' checked="1"':'').' />'.
               &relatedfield(0,$relatedsearchflag,$relatedsep); 
       }
       # Obsolete replacement file
       if ($type eq 'obsoletereplacement') {
    return '<input type="text" name="'.$fieldname.
       '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
       "('".$formname."','".$fieldname."'".
       ",'')\">".&mt('Select').'</a>'.
               &relatedfield(0,$relatedsearchflag,$relatedsep); 
       }
       # Customdistribution file
       if ($type eq 'customdistributionfile') {
    return '<input type="text" name="'.$fieldname.
       '" size="60" value="'.$value.'" /><a href="javascript:openbrowser'.
       "('".$formname."','".$fieldname."'".
       ",'rights')\">".&mt('Select').'</a>'.
               &relatedfield(0,$relatedsearchflag,$relatedsep); 
       }
       # Dates
       if (($type eq 'creationdate') ||
    ($type eq 'lastrevisiondate')) {
    return 
               &Apache::lonhtmlcommon::date_setter($formname,$fieldname,$value).
               &relatedfield(0,$relatedsearchflag,$relatedsep);
       }
       # No pretty input found
       $value=~s/^\s+//gs;
       $value=~s/\s+$//gs;
       $value=~s/\s+/ /gs;
       $value=~s/\"/\&quod\;/gs;
       return 
           '<input type="text" name="'.$fieldname.'" size="80" '.
           '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;
       #
       # Check to see if this server is overloaded
       my $loaderror=&Apache::lonnet::overloaderror($r);
       if ($loaderror) { 
           return $loaderror;
       }
       #
       # Check to see if original resource server is overloaded
     my ($resdomain,$resuser)=      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'.
   return OK if $r->header_only;                '</title></head>');
       if ($uri=~m:/adm/bombs/(.*)$:) {
 # ------------------------------------------------------------------- Read file          $r->print(&Apache::loncommon::bodytag('Error Messages'));
   foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {          # Looking for all bombs?
       $content{$_}=&Apache::lonnet::metadata($uri,$_);          &report_bombs($r,$uri);
   }      } elsif ($uri=~/^\/\~/) { 
 # ------------------------------------------------------------------ Hide stuff          # 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;
   }
   
   unless ($ENV{'user.adv'}) {  #####################################################
       foreach ('keywords','notes','abstract','subject') {  #####################################################
           $content{$_}='<i>- '.&mt('not displayed').' -</i>';  ###                                               ###
       }  ###                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;
   }
   
 # --------------------------------------------------------------- Render Output  #####################################################
   #####################################################
   ###                                               ###
   ###        Uneditable Metadata Display            ###
   ###                                               ###
   #####################################################
   #####################################################
   sub present_uneditable_metadata {
       my ($r,$uri) = @_;
       #
       my %content=();
       # Read file
       foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
           $content{$_}=&Apache::lonnet::metadata($uri,$_);
       }
       # Render Output
       # displayed url
     my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);      my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
     $content{'creationdate'}=&Apache::lonlocal::locallocaltime(      $uri=~s/\.meta$//;
  &Apache::lonmysql::unsqltime($content{'creationdate'}));      my $disuri=&Apache::lonnet::clutter($uri);
     $content{'lastrevisiondate'}=&Apache::lonlocal::locallocaltime(      # version
  &Apache::lonmysql::unsqltime($content{'lastrevisiondate'}));  
     $content{'language'}=&Apache::loncommon::languagedescription($content{'language'});  
     $content{'mime'}=&Apache::loncommon::filedescription($content{'mime'});   
     my $disuri=&Apache::lonnet::declutter($uri);  
     $disuri=~s/\.meta$//;  
     my $currentversion=&Apache::lonnet::getversion($disuri);      my $currentversion=&Apache::lonnet::getversion($disuri);
     my $author=$content{'author'};  
     $content{'author'}=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;  
     $content{'owner'}=~s/(\w+)(\:|\@)(\w+)/&authordisplay($1,$3)/gse;  
     my $versiondisplay='';      my $versiondisplay='';
     if ($thisversion) {      if ($thisversion) {
  $versiondisplay=&mt('Version').': '.$thisversion.          $versiondisplay=&mt('Version').': '.$thisversion.
     ' ('.&mt('most recent version').': '.$currentversion.')';              ' ('.&mt('most recent version').': '.
     } else {              ($currentversion>0 ? 
  $versiondisplay='Version: '.$currentversion;               $currentversion   :
     }               &mt('information not available')).')';
     if ($content{'customdistributionfile'}) {  
  $content{'customdistributionfile'}='<a href="'.$content{'customdistributionfile'}.  
     '"><tt>'.$content{'customdistributionfile'}.'</tt></a>';  
     } else {      } else {
  $content{'customdistributionfile'}='';          $versiondisplay='Version: '.$currentversion;
     }      }
       # 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', 
                 $content{$_}.'&nbsp;</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 350  $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);
    $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) = @_;
    my %dynmeta=&dynamicmeta($uri);      #
    $r->print(      my $description = 'Dynamic Metadata (updated periodically)';
 '</table><h4>'.&mt('Access and Usage Statistics').'</h4><table cellspacing=2 border=0>');      $r->print('<h3>'.&mt($description).'</h3>'.
    foreach ('count') {                &mt('Processing').' ...<br />');
        $r->print(      $r->rflush();
 '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.      my %items=&fieldnames();
 $dynmeta{$_}."&nbsp;</td></tr>\n");      my %dynmeta=&dynamicmeta($uri);
    }      #
    foreach my $cat ('usage','comefrom','goto') {      # General Access and Usage Statistics
        $r->print(      $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.
 '<tr><td bgcolor="#AAAAAA">'.$items{$cat}.'</td><td bgcolor="#CCCCCC">'.                '<table cellspacing=2 border=0>');
 $dynmeta{$cat}.'<font size="-1"><ul>'.join("\n",      foreach ('count',
       map { my $murl=$_;                'sequsage','sequsage_list',
  '<li><a href="'.&Apache::lonnet::clutter($murl).'" target="preview">'.               'comefrom','comefrom_list',
                         &Apache::lonnet::gettitle($murl).' [<tt>'.$murl               'goto','goto_list',
                         .'</tt>]</a></li>' }               'course','course_list') {
       split(/\,/,$dynmeta{$cat.'_list'}))."</ul></font></td></tr>\n");          $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
    }                    '<td bgcolor="#CCCCCC">'.
    foreach my $cat ('course') {                    &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
        $r->print(      }
 '<tr><td bgcolor="#AAAAAA">'.$items{$cat}.'</td><td bgcolor="#CCCCCC">'.      $r->print('</table>');
 $dynmeta{$cat}.'<font size="-1"><ul>'.join("\n",      if ($uri=~/\.(problem|exam|quiz|assess|survey|form)$/) {
       map { my %courseinfo=&Apache::lonnet::coursedescription($_);            # This is an assessment, print assessment data
  '<li><a href="/public/'.          $r->print(
   $courseinfo{'domain'}.'/'.$courseinfo{'num'}.'/syllabus" target="preview">'.                    '<h4>'.&mt('Assessment Statistical Data').'</h4>'.
   $courseinfo{'description'}.'</a></li>' }                    '<table cellspacing=2 border=0>');
       split(/\,/,$dynmeta{$cat.'_list'}))."</ul></font></td></tr>\n");          foreach ('stdno','avetries','difficulty') {
    }              $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
        $r->print('</table>');                        '<td bgcolor="#CCCCCC">'.
    if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {                        &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
       $r->print(          }
 '<h4>'.&mt('Assessment Statistical Data').'</h4><table cellspacing=2 border=0>');          $r->print('</table>');    
       foreach ('stdno','avetries') {      }
           $r->print(      
 '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.      $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.
 $dynmeta{$_}."&nbsp;</td></tr>\n");                '<table cellspacing=2 border=0>');
       }      foreach ('clear','depth','helpful','correct','technical') {
       foreach ('difficulty') {          $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
          $r->print(                    '<td bgcolor="#CCCCCC">'.
 '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.                    &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
 &diffgraph($dynmeta{$_})."</td></tr>\n");      }
       }      $r->print('</table>');
       $r->print('</table>');          $uri=~/^\/res\/(\w+)\/(\w+)\//; 
    }      if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))
    $r->print('<h4>'.&mt('Evaluation Data').'</h4><table cellspacing=2 border=0>');          || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
    foreach ('clear','depth','helpful','correct','technical') {          $r->print('<h4>'.&mt('Evaluation Comments').' ('.
        $r->print(                    &mt('visible to author and co-authors only').
 '<tr><td bgcolor="#AAAAAA">'.$items{$_}.'</td><td bgcolor="#CCCCCC">'.                    ')</h4>'.
 &evalgraph($dynmeta{$_})."</td></tr>\n");                    '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
    }              $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.
    $r->print('</table>');                    &mt('visible to author and co-authors only').')'.
    $disuri=~/^(\w+)\/(\w+)\//;                       '</h4>'.
    if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))                    &Apache::lonmsg::retrieve_author_res_msg($uri));
        || ($ENV{'user.role.ca./'.$1.'/'.$2})) {      }
       $r->print(      # All other stuff
   '<h4>'.&mt('Evaluation Comments').' ('.&mt('visible to author and co-authors only').')</h4>'.      $r->print('<h3>'.
       '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');                &mt('Additional Metadata (non-standard, parameters, exports)').
       $r->print(                '</h3>');
    '<h4>'.&mt('Error Messages').' ('.      foreach (sort(keys(%content))) {
           &mt('visible to author and co-authors only').')</h4>');          my $name=$_;
       my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$1,$2);          if ($name!~/\.display$/) {
       foreach (keys %errormsgs) {              my $display=&Apache::lonnet::metadata($uri,
  if ($_=~/^\Q$disuri\E\_\d+$/) {                                                    $name.'.display');
           my %content=&Apache::lonmsg::unpackagemsg($errormsgs{$_});              if (! $display) { 
   $r->print('<b>'.$content{'time'}.'</b>: '.$content{'message'}.                  $display=$name;
                     '<br />');              };
               my $otherinfo='';
               foreach ('name','part','type','default') {
                   if (defined(&Apache::lonnet::metadata($uri,
                                                         $name.'.'.$_))) {
                       $otherinfo.=' '.$_.'='.
                           &Apache::lonnet::metadata($uri,
                                                     $name.'.'.$_).'; ';
                   }
               }
               $r->print('<b>'.$display.':</b> '.$content{$name});
               if ($otherinfo) {
                   $r->print(' ('.$otherinfo.')');
               }
               $r->print("<br />\n");
           }
       }
       return;
   }
   
   #####################################################
   #####################################################
   ###                                               ###
   ###          Editable metadata display            ###
   ###                                               ###
   #####################################################
   #####################################################
   sub present_editable_metadata {
       my ($r,$uri) = @_;
       # Construction Space Call
       # Header
       my $disuri=$uri;
       my $fn=&Apache::lonnet::filelocation('',$uri);
       $disuri=~s/^\/\~/\/priv\//;
       $disuri=~s/\.meta$//;
       my $target=$uri;
       $target=~s/^\/\~/\/res\/$ENV{'request.role.domain'}\//;
       $target=~s/\.meta$//;
       my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);
       if ($bombs) {
           if ($ENV{'form.delmsg'}) {
               if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {
                   $bombs=&mt('Messages deleted.');
               } else {
                   $bombs=&mt('Error deleting messages');
               }
           }
           my $del=&mt('Delete Messages');
           $r->print(<<ENDBOMBS);
   <h1>$disuri</h1>
   <form method="post" name="defaultmeta">
   <input type="submit" name="delmsg" value="$del" />
   <br />$bombs
   ENDBOMBS
       } else {
           my $displayfile='Catalog Information for '.$disuri;
           if ($disuri=~/\/default$/) {
               my $dir=$disuri;
               $dir=~s/default$//;
               $displayfile=
                   &mt('Default Cataloging Information for Directory').' '.
                   $dir;
         }          }
       }                my $bodytag=
    }              &Apache::loncommon::bodytag('Edit Catalog Information');
 # ------------------------------------------------------------- All other stuff          %Apache::lonpublisher::metadatafields=();
    $r->print(          %Apache::lonpublisher::metadatakeys=();
  '<h3>'.&mt('Additional Metadata (non-standard, parameters, exports)').'</h3>');          &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));
    foreach (sort keys %content) {          $r->print(<<ENDEDIT);
       my $name=$_;  
       unless ($name=~/\.display$/) {  
   my $display=&Apache::lonnet::metadata($uri,$name.'.display');  
   unless ($display) { $display=$name; };  
   my $otherinfo='';  
   foreach ('name','part','type','default') {  
       if (defined(&Apache::lonnet::metadata($uri,$name.'.'.$_))) {  
   $otherinfo.=' '.$_.'='.  
       &Apache::lonnet::metadata($uri,$name.'.'.$_).'; ';  
       }  
   }  
   $r->print('<b>'.$display.':</b> '.$content{$name});  
   if ($otherinfo) {  
       $r->print(' ('.$otherinfo.')');  
   }  
   $r->print("<br>\n");  
       }  
    }  
   }  
 # ===================================================== End Resource Space Call  
  } else {  
 # ===================================================== Construction Space Call  
   
 # ----------------------------------------------------------- Set document type  
   
   &Apache::loncommon::content_type($r,'text/html');  
   $r->send_http_header;  
   
   return OK if $r->header_only;  
 # ---------------------------------------------------------------------- Header  
   my $bodytag=&Apache::loncommon::bodytag('Edit Catalog Information');  
   my $disuri=$uri;  
   my $fn=&Apache::lonnet::filelocation('',$uri);  
   $disuri=~s/^\/\~\w+//;  
   $disuri=~s/\.meta$//;  
   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=();  
   &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">  <form method="post" name="defaultmeta">
 ENDEDIT  ENDEDIT
    my %lt=&fieldnames();          $r->print('<script language="JavaScript">'.
    foreach ('author','title','subject','keywords','abstract','notes',                    &Apache::loncommon::browser_and_searcher_javascript.
             'copyright','customdistributionfile','language',                    '</script>');
             'obsolete','obsoletereplacement') {          my %lt=&fieldnames();
        if ($ENV{'form.new_'.$_}) {          foreach ('author','title','subject','keywords','abstract','notes',
    $Apache::lonpublisher::metadatafields{$_}=$ENV{'form.new_'.$_};                   'copyright','customdistributionfile','language',
        }                   'standards',
        if (m/copyright/) {                   'lowestgradelevel','highestgradelevel',
    $r->print(&Apache::lonpublisher::selectbox($lt{$_},'new_'.$_,                   'obsolete','obsoletereplacement') {
        ($Apache::lonpublisher::metadatafields{$_}?              if (defined($ENV{'form.new_'.$_})) {
  $Apache::lonpublisher::metadatafields{$_}:'default'),                  $Apache::lonpublisher::metadatafields{$_}=
        \&Apache::loncommon::copyrightdescription,                      $ENV{'form.new_'.$_};
        (&Apache::loncommon::copyrightids)));              }
        } elsif (m/language/) {              if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
    $r->print(&Apache::lonpublisher::selectbox($lt{$_},'new_'.$_,                  $Apache::lonpublisher::metadatafields{'copyright'}=
       $Apache::lonpublisher::metadatafields{$_},                      'default';
       \&Apache::loncommon::languagedescription,              }
       (&Apache::loncommon::languageids)));              $r->print('<p>'.$lt{$_}.': '.
        } else {                        &prettyinput
    $r->print(&Apache::lonpublisher::textfield($lt{$_},'new_'.$_,                        ($_,$Apache::lonpublisher::metadatafields{$_},
      $Apache::lonpublisher::metadatafields{$_}));                         'new_'.$_,'defaultmeta').'</p>');
        }          }
    }          if ($ENV{'form.store'}) {
    if ($ENV{'form.store'}) {              my $mfh;
       my $mfh;              if (!  ($mfh=Apache::File->new('>'.$fn))) {
       unless ($mfh=Apache::File->new('>'.$fn)) {                  $r->print('<p><font color=red>'.
             $r->print(                            &mt('Could not write metadata').', '.
             '<p><font color=red>'.&mt('Could not write metadata').', '.                            &mt('FAIL').'</font>');
       &mt('FAIL').'</font>');              } else {
       } else {                  foreach (sort keys %Apache::lonpublisher::metadatafields) {
           foreach (sort keys %Apache::lonpublisher::metadatafields) {                      next if ($_ =~ /\./);
             unless ($_=~/\./) {                      my $unikey=$_;
                 my $unikey=$_;                      $unikey=~/^([A-Za-z]+)/;
                 $unikey=~/^([A-Za-z]+)/;                      my $tag=$1;
                 my $tag=$1;                      $tag=~tr/A-Z/a-z/;
                 $tag=~tr/A-Z/a-z/;                      print $mfh "\n\<$tag";
                 print $mfh "\n\<$tag";                      foreach (split(/\,/,
                 foreach                                    $Apache::lonpublisher::metadatakeys{$unikey})
                   (split(/\,/,$Apache::lonpublisher::metadatakeys{$unikey})) {                               ) {
                     my $value=                          my $value=
                        $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};                           $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
                     $value=~s/\"/\'\'/g;                          $value=~s/\"/\'\'/g;
                     print $mfh ' '.$_.'="'.$value.'"';                          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  ##############################################################
   ##############################################################
   # MySQL table columns
   
   my @columns;
   
 BEGIN {  BEGIN {
 # Get columns of MySQL metadata table      # Get columns of MySQL metadata table
     @columns=&Apache::lonmysql::col_order('metadata');      @columns=&Apache::lonmysql::col_order('metadata');
 }  }
 1;  
 __END__  
   
   
   
   
   
   #
   # Turn MySQL row into hash
   #     This routine should be moved to lonmetadata
   #     a more generic place since it has nothing to do with metadata
   sub metadata_col_to_hash {
       my @cols=@_;
       my %hash=();
       for (my $i=0; $i<=$#columns; $i++) {
    $hash{$columns[$i]}=$cols[$i];
       }
       return %hash;
   }
   
   
   1;
   __END__
Removed from v.1.45  
changed lines
  Added in v.1.67

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