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

Diff for /loncom/interface/lonmeta.pm between versions 1.64 and 1.69

version 1.64, 2004/04/13 14:42:24 version 1.69, 2004/04/14 18:56:36
Line 40  use Apache::lonlocal; Line 40  use Apache::lonlocal;
 use Apache::lonmysql;  use Apache::lonmysql;
 use Apache::lonmsg;  use Apache::lonmsg;
   
 # MySQL table columns  
   
 my @columns;  
   
 # Fetch and evaluate dynamic metadata  # Fetch and evaluate dynamic metadata
 sub dynamicmeta {  sub dynamicmeta {
Line 60  sub dynamicmeta { Line 57  sub dynamicmeta {
     #      #
     # Deal with 'count' separately      # Deal with 'count' separately
     $Data{'count'} = &access_count($url,$aauthor,$adomain);      $Data{'count'} = &access_count($url,$aauthor,$adomain);
       #
       # 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;      return %Data;
 }  }
   
Line 104  sub authordisplay { Line 110  sub authordisplay {
 # 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 126  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 142  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 {
Line 200  sub fieldnames { Line 201  sub fieldnames {
   
 sub prettyprint {  sub prettyprint {
     my ($type,$value)=@_;      my ($type,$value)=@_;
     unless (defined($value)) { return '&nbsp;'; }      if (! defined($value)) { 
           return '&nbsp;'; 
       }
     # Title      # 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>';
Line 239  sub prettyprint { Line 242  sub prettyprint {
  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'}) { 
           return '<i>- '.&mt('not displayed').' -</i>';
       }
     # File      # File
     if (($type eq 'customdistributionfile') ||      if (($type eq 'customdistributionfile') ||
  ($type eq 'obsoletereplacement') ||   ($type eq 'obsoletereplacement') ||
Line 284  sub direct { Line 289  sub direct {
   
 sub selectbox {  sub selectbox {
     my ($name,$value,$functionref,@idlist)=@_;      my ($name,$value,$functionref,@idlist)=@_;
     unless (defined($functionref)) { $functionref=\&direct; }      if (! defined($functionref)) {
           $functionref=\&direct;
       }
     my $selout='<select name="'.$name.'">';      my $selout='<select name="'.$name.'">';
     foreach (@idlist) {      foreach (@idlist) {
         $selout.='<option value=\''.$_.'\'';          $selout.='<option value=\''.$_.'\'';
Line 298  sub selectbox { Line 305  sub selectbox {
   
 sub relatedfield {  sub relatedfield {
     my ($show,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue)=@_;      my ($show,$relatedsearchflag,$relatedsep,$fieldname,$relatedvalue)=@_;
     unless ($relatedsearchflag) { return ''; }      if (! $relatedsearchflag) { 
     unless (defined($relatedsep)) { $relatedsep=' '; }          return '';
     unless ($show) { return $relatedsep.'&nbsp;'; }      }
       if (! defined($relatedsep)) {
           $relatedsep=' ';
       }
       if (! $show) {
           return $relatedsep.'&nbsp;';
       }
     return $relatedsep.'<input type="checkbox" name="'.$fieldname.'_related"'.      return $relatedsep.'<input type="checkbox" name="'.$fieldname.'_related"'.
  ($relatedvalue?' checked="1"':'').' />';   ($relatedvalue?' checked="1"':'').' />';
 }  }
Line 375  sub prettyinput { Line 388  sub prettyinput {
 sub handler {  sub handler {
     my $r=shift;      my $r=shift;
     #      #
       my $uri=$r->uri;
       #
       # Check to see if this server is overloaded
     my $loaderror=&Apache::lonnet::overloaderror($r);      my $loaderror=&Apache::lonnet::overloaderror($r);
     if ($loaderror) { return $loaderror; }      if ($loaderror) { 
           return $loaderror;
       }
     #      #
     my $uri=$r->uri;      # Check to see if original resource server is overloaded
       my ($resdomain,$resuser)=
           (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
       $loaderror=&Apache::lonnet::overloaderror
           ($r,&Apache::lonnet::homeserver($resuser,$resdomain));
       if ($loaderror) { 
           return $loaderror;
       }
     #      #
     # Looking for all bombs?      # Set document type
     if ($uri=~/\/adm\/bombs\/(.*)$/) {      &Apache::loncommon::content_type($r,'text/html');
         # Set document type      $r->send_http_header;
         $uri=&Apache::lonnet::declutter($1);      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/(.*)$:) {
         $r->print(&Apache::loncommon::bodytag('Error Messages'));          $r->print(&Apache::loncommon::bodytag('Error Messages'));
         $r->print('<h1>'.&Apache::lonnet::clutter($uri).'</h1>');          # Looking for all bombs?
         my ($domain,$author)=($uri=~/^(\w+)\/(\w+)\//);          &report_bombs($r,$uri);
         if (&Apache::loncacc::constructaccess('/~'.$author.'/',$domain)) {      } elsif ($uri=~/^\/\~/) { 
             my %brokenurls=&Apache::lonmsg::all_url_author_res_msg($author,          # Construction space
                                                                    $domain);          $r->print(&Apache::loncommon::bodytag
             foreach (sort keys %brokenurls) {                    ('Edit Catalog Information','','','',$resdomain));
                 if ($_=~/^\Q$uri\E/) {          &present_editable_metadata($r,$uri);
                     $r->print(&Apache::lonhtmlcommon::crumbs      } else {
                               (&Apache::lonnet::clutter($_)).          $r->print(&Apache::loncommon::bodytag
                               &Apache::lonmsg::retrieve_author_res_msg($_).                    ('Catalog Information','','','',$resdomain));
                               '<hr />');          &present_uneditable_metadata($r,$uri);
                 }      }
       $r->print('</body></html>');
       return OK;
   }
   
   #####################################################
   #####################################################
   ###                                               ###
   ###                Report Bombs                   ###
   ###                                               ###
   #####################################################
   #####################################################
   sub report_bombs {
       my ($r,$uri) = @_;
       # Set document type
       $uri =~ s:/adm/bombs/::;
       $uri = &Apache::lonnet::declutter($uri);
       $r->print('<h1>'.&Apache::lonnet::clutter($uri).'</h1>');
       my ($domain,$author)=($uri=~/^(\w+)\/(\w+)\//);
       if (&Apache::loncacc::constructaccess('/~'.$author.'/',$domain)) {
           my %brokenurls = 
               &Apache::lonmsg::all_url_author_res_msg($author,$domain);
           foreach (sort(keys(%brokenurls))) {
               if ($_=~/^\Q$uri\E/) {
                   $r->print(&Apache::lonhtmlcommon::crumbs
                             (&Apache::lonnet::clutter($_)).
                             &Apache::lonmsg::retrieve_author_res_msg($_).
                             '<hr />');
             }              }
         } else {  
             $r->print(&mt('Not authorized'));  
         }          }
         $r->print('</body></html>');      } else {
     } elsif ($uri!~/^\/\~/) {           $r->print(&mt('Not authorized'));
         # This is not in construction space      }
         my ($resdomain,$resuser)=      return;
             (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);  }
         $loaderror=&Apache::lonnet::overloaderror  
             ($r,  #####################################################
              &Apache::lonnet::homeserver($resuser,$resdomain));  #####################################################
         if ($loaderror) { return $loaderror; }  ###                                               ###
         #  ###        Uneditable Metadata Display            ###
         my %content=();  ###                                               ###
         # Set document type  #####################################################
         &Apache::loncommon::content_type($r,'text/html');  #####################################################
         $r->send_http_header;  sub present_uneditable_metadata {
         return OK if $r->header_only;      my ($r,$uri) = @_;
         # Read file      #
         foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {      my %content=();
             $content{$_}=&Apache::lonnet::metadata($uri,$_);      # Read file
         }      foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
         # Render Output          $content{$_}=&Apache::lonnet::metadata($uri,$_);
         # displayed url      }
         my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);      # Render Output
         $uri=~s/\.meta$//;      # displayed url
         my $disuri=&Apache::lonnet::clutter($uri);      my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
         # version      $uri=~s/\.meta$//;
         my $currentversion=&Apache::lonnet::getversion($disuri);      my $disuri=&Apache::lonnet::clutter($uri);
         my $versiondisplay='';      # version
         if ($thisversion) {      my $currentversion=&Apache::lonnet::getversion($disuri);
             $versiondisplay=&mt('Version').': '.$thisversion.      my $versiondisplay='';
                 ' ('.&mt('most recent version').': '.      if ($thisversion) {
                 ($currentversion>0 ?           $versiondisplay=&mt('Version').': '.$thisversion.
                  $currentversion   :              ' ('.&mt('most recent version').': '.
                  &mt('information not available')).')';              ($currentversion>0 ? 
         } else {               $currentversion   :
             $versiondisplay='Version: '.$currentversion;               &mt('information not available')).')';
         }      } else {
         # crumbify displayed URL          $versiondisplay='Version: '.$currentversion;
         $disuri=&Apache::lonhtmlcommon::crumbs($disuri);      }
         # obsolete      # crumbify displayed URL
         my $obsolete=$content{'obsolete'};      $disuri=&Apache::lonhtmlcommon::crumbs($disuri);
         my $obsoletewarning='';      # obsolete
         if (($obsolete) && ($ENV{'user.adv'})) {      my $obsolete=$content{'obsolete'};
             $obsoletewarning='<p><font color="red">'.      my $obsoletewarning='';
                 &mt('This resource has been marked obsolete by the author(s)').      if (($obsolete) && ($ENV{'user.adv'})) {
                 '</font></p>';          $obsoletewarning='<p><font color="red">'.
         }              &mt('This resource has been marked obsolete by the author(s)').
         #              '</font></p>';
         my %lt=&fieldnames();      }
         my $table='';      #
         my $bodytag=&Apache::loncommon::bodytag      my %lt=&fieldnames();
             ('Catalog Information','','','',$resdomain);      my $table='';
         foreach ('title',       foreach ('title', 
                  'author',                'author', 
                  'subject',                'subject', 
                  'keywords',                'keywords', 
                  'notes',                'notes', 
                  'abstract',               'abstract',
                  'lowestgradelevel',               'lowestgradelevel',
                  'highestgradelevel',               'highestgradelevel',
                  'standards',                'standards', 
                  'mime',                'mime', 
                  'language',                'language', 
                  'creationdate',                'creationdate', 
                  'lastrevisiondate',                'lastrevisiondate', 
                  'owner',                'owner', 
                  'copyright',                'copyright', 
                  'customdistributionfile',                'customdistributionfile', 
                  'obsolete',                'obsolete', 
                  'obsoletereplacement') {               'obsoletereplacement') {
             $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.          $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.
         '</td><td bgcolor="#CCCCCC">'.              '</td><td bgcolor="#CCCCCC">'.
                 &prettyprint($_,$content{$_}).'</td></tr>';              &prettyprint($_,$content{$_}).'</td></tr>';
             delete $content{$_};          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 491  $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>'.      my %lt=&fieldnames();
                       '<table cellspacing=2 border=0>');      #
             foreach ('count',      my $description = 'Dynamic Metadata (updated periodically)';
                      'sequsage','sequsage_list',      $r->print('<h3>'.&mt($description).'</h3>'.
                      'comefrom','comefrom_list',                &mt('Processing').' ...<br />');
                      'goto','goto_list',      $r->rflush();
                      'course','course_list') {      my %items=&fieldnames();
                 $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.      my %dynmeta=&dynamicmeta($uri);
                           '<td bgcolor="#CCCCCC">'.      #
                           &prettyprint($_,$dynmeta{$_})."</td></tr>\n");      # General Access and Usage Statistics
             }      $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.
             $r->print('</table>');                '<table cellspacing=2 border=0>');
             if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {      foreach ('count',
                 # This is an assessment, print assessment data               'sequsage','sequsage_list',
                 $r->print(               'comefrom','comefrom_list',
                           '<h4>'.&mt('Assessment Statistical Data').'</h4>'.               'goto','goto_list',
                           '<table cellspacing=2 border=0>');               'course','course_list') {
                 foreach ('stdno','avetries','difficulty') {          $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                     $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.                    '<td bgcolor="#CCCCCC">'.
                               '<td bgcolor="#CCCCCC">'.                    &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
                               &prettyprint($_,$dynmeta{$_})."</td></tr>\n");      }
       $r->print('</table>');
       #
       # Assessment statistics
       if ($uri=~/\.(problem|exam|quiz|assess|survey|form)$/) {
           # This is an assessment, print assessment data
           $r->print(
                     '<h4>'.&mt('Assessment Statistical Data').'</h4>'.
                     '<table cellspacing=2 border=0>');
           foreach ('stdno','avetries','difficulty') {
               $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                         '<td bgcolor="#CCCCCC">'.
                         &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
           }
           $r->print('</table>');    
       }
       
       $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.
                 '<table cellspacing=2 border=0>');
       foreach ('clear','depth','helpful','correct','technical') {
           $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                     '<td bgcolor="#CCCCCC">'.
                     &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
       }
       $r->print('</table>');
       $uri=~/^\/res\/(\w+)\/(\w+)\//; 
       if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))
           || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
           $r->print('<h4>'.&mt('Evaluation Comments').' ('.
                     &mt('visible to author and co-authors only').
                     ')</h4>'.
                     '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
           $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.
                     &mt('visible to author and co-authors only').')'.
                     '</h4>'.
                     &Apache::lonmsg::retrieve_author_res_msg($uri));
       }
       #
       # All other stuff
       $r->print('<h3>'.
                 &mt('Additional Metadata (non-standard, parameters, exports)').
                 '</h3>');
       foreach (sort(keys(%content))) {
           my $name=$_;
           if ($name!~/\.display$/) {
               my $display=&Apache::lonnet::metadata($uri,
                                                     $name.'.display');
               if (! $display) { 
                   $display=$name;
               };
               my $otherinfo='';
               foreach ('name','part','type','default') {
                   if (defined(&Apache::lonnet::metadata($uri,
                                                         $name.'.'.$_))) {
                       $otherinfo.=' '.$_.'='.
                           &Apache::lonnet::metadata($uri,
                                                     $name.'.'.$_).'; ';
                 }                  }
                 $r->print('</table>');      
             }              }
             $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.              $r->print('<b>'.$display.':</b> '.$content{$name});
                       '<table cellspacing=2 border=0>');              if ($otherinfo) {
             foreach ('clear','depth','helpful','correct','technical') {                  $r->print(' ('.$otherinfo.')');
                 $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.  
                           '<td bgcolor="#CCCCCC">'.  
                           &prettyprint($_,$dynmeta{$_})."</td></tr>\n");  
             }  
             $r->print('</table>');  
             $uri=~/^\/res\/(\w+)\/(\w+)\//;   
             if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))  
                 || ($ENV{'user.role.ca./'.$1.'/'.$2})) {  
                 $r->print('<h4>'.&mt('Evaluation Comments').' ('.  
                           &mt('visible to author and co-authors only').  
                           ')</h4>'.  
                           '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');  
                 $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.  
                           &mt('visible to author and co-authors only').')'.  
                           '</h4>'.  
                           &Apache::lonmsg::retrieve_author_res_msg($uri));  
             }  
             # All other stuff  
             $r->print('<h3>'.  
                 &mt('Additional Metadata (non-standard, parameters, exports)').  
                       '</h3>');  
             foreach (sort keys %content) {  
                 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");  
                 }  
             }              }
               $r->print("<br />\n");
         }          }
         # End Resource Space Call      }
     } else {      return;
         # Construction Space Call  }
         # Set document type  
         &Apache::loncommon::content_type($r,'text/html');  #####################################################
         $r->send_http_header;  #####################################################
         #  ###                                               ###
         return OK if $r->header_only;  ###          Editable metadata display            ###
         # Header  ###                                               ###
         my $disuri=$uri;  #####################################################
         my $fn=&Apache::lonnet::filelocation('',$uri);  #####################################################
         $disuri=~s/^\/\~/\/priv\//;  sub present_editable_metadata {
         $disuri=~s/\.meta$//;      my ($r,$uri) = @_;
         my $target=$uri;      # Construction Space Call
         $target=~s/^\/\~/\/res\/$ENV{'request.role.domain'}\//;      # Header
         $target=~s/\.meta$//;      my $disuri=$uri;
         my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);      my $fn=&Apache::lonnet::filelocation('',$uri);
         if ($bombs) {      $disuri=~s/^\/\~/\/priv\//;
             if ($ENV{'form.delmsg'}) {      $disuri=~s/\.meta$//;
                 if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {      my $target=$uri;
                     $bombs=&mt('Messages deleted.');      $target=~s/^\/\~/\/res\/$ENV{'request.role.domain'}\//;
                 } else {      $target=~s/\.meta$//;
                     $bombs=&mt('Error deleting messages');      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 $bodytag=&Apache::loncommon::bodytag('Error Messages');          }
             my $del=&mt('Delete Messages');          my $del=&mt('Delete Messages');
             $r->print(<<ENDBOMBS);          $r->print(<<ENDBOMBS);
 <html><head><title>Edit Catalog Information</title></head>  
 $bodytag  
 <h1>$disuri</h1>  <h1>$disuri</h1>
 <form method="post" name="defaultmeta">  <form method="post" name="defaultmeta">
 <input type="submit" name="delmsg" value="$del" />  <input type="submit" name="delmsg" value="$del" />
 <br />$bombs  <br />$bombs
 </form>  
 </body>  
 </html>  
 ENDBOMBS  ENDBOMBS
         } else {      } else {
             my $displayfile='Catalog Information for '.$disuri;          my $displayfile='Catalog Information for '.$disuri;
             if ($disuri=~/\/default$/) {          if ($disuri=~/\/default$/) {
                 my $dir=$disuri;              my $dir=$disuri;
                 $dir=~s/default$//;              $dir=~s/default$//;
                 $displayfile=              $displayfile=
                     &mt('Default Cataloging Information for Directory').' '.                  &mt('Default Cataloging Information for Directory').' '.
                     $dir;                  $dir;
             }          }
             my $bodytag=          my $bodytag=
                 &Apache::loncommon::bodytag('Edit Catalog Information');              &Apache::loncommon::bodytag('Edit Catalog Information');
             %Apache::lonpublisher::metadatafields=();          %Apache::lonpublisher::metadatafields=();
             %Apache::lonpublisher::metadatakeys=();          %Apache::lonpublisher::metadatakeys=();
             &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));          &Apache::lonpublisher::metaeval(&Apache::lonnet::getfile($fn));
             $r->print(<<ENDEDIT);          $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',                   'copyright','customdistributionfile','language',
                      'standards',                   'standards',
                      'lowestgradelevel','highestgradelevel',                   'lowestgradelevel','highestgradelevel',
                      'obsolete','obsoletereplacement') {                   'obsolete','obsoletereplacement') {
                 if (defined($ENV{'form.new_'.$_})) {              if (defined($ENV{'form.new_'.$_})) {
                     $Apache::lonpublisher::metadatafields{$_}=                  $Apache::lonpublisher::metadatafields{$_}=
                         $ENV{'form.new_'.$_};                      $ENV{'form.new_'.$_};
                 }  
                 unless ($Apache::lonpublisher::metadatafields{'copyright'}) {  
                     $Apache::lonpublisher::metadatafields{'copyright'}=  
                         'default';  
                 }  
                 $r->print('<p>'.$lt{$_}.': '.  
                           &prettyinput  
                           ($_,$Apache::lonpublisher::metadatafields{$_},  
                            'new_'.$_,'defaultmeta').'</p>');  
             }              }
             if ($ENV{'form.store'}) {              if (! $Apache::lonpublisher::metadatafields{'copyright'}) {
                 my $mfh;                  $Apache::lonpublisher::metadatafields{'copyright'}=
                 unless ($mfh=Apache::File->new('>'.$fn)) {                      'default';
                     $r->print('<p><font color=red>'.              }
                               &mt('Could not write metadata').', '.              $r->print('<p>'.$lt{$_}.': '.
                               &mt('FAIL').'</font>');                        &prettyinput
                 } else {                        ($_,$Apache::lonpublisher::metadatafields{$_},
                     foreach (sort keys %Apache::lonpublisher::metadatafields) {                         'new_'.$_,'defaultmeta').'</p>');
                         unless ($_=~/\./) {          }
                             my $unikey=$_;          if ($ENV{'form.store'}) {
                             $unikey=~/^([A-Za-z]+)/;              my $mfh;
                             my $tag=$1;              if (!  ($mfh=Apache::File->new('>'.$fn))) {
                             $tag=~tr/A-Z/a-z/;                  $r->print('<p><font color=red>'.
                             print $mfh "\n\<$tag";                            &mt('Could not write metadata').', '.
                             foreach (split(/\,/,                            &mt('FAIL').'</font>');
               } else {
                   foreach (sort keys %Apache::lonpublisher::metadatafields) {
                       next if ($_ =~ /\./);
                       my $unikey=$_;
                       $unikey=~/^([A-Za-z]+)/;
                       my $tag=$1;
                       $tag=~tr/A-Z/a-z/;
                       print $mfh "\n\<$tag";
                       foreach (split(/\,/,
                                  $Apache::lonpublisher::metadatakeys{$unikey})                                   $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.'>';  
                         }  
                     }                      }
                     $r->print('<p>'.&mt('Wrote Metadata'));                      print $mfh '>'.
                           &HTML::Entities::encode
                           ($Apache::lonpublisher::metadatafields{$unikey},
                            '<>&"').
                            '</'.$tag.'>';
                 }                  }
                   $r->print('<p>'.&mt('Wrote Metadata'));
             }              }
             $r->print('<br /><input type="submit" name="store" value="'.  
                       &mt('Store Catalog Information').'"></form>'.  
                       '</body></html>');  
         }          }
           $r->print('<br /><input type="submit" name="store" value="'.
                     &mt('Store Catalog Information').'">');
     }      }
     return OK;      $r->print('</form>');
 }      return;
   
 # BEGIN Block  
 BEGIN {  
     # Get columns of MySQL metadata table  
     @columns=&Apache::lonmysql::col_order('metadata');  
 }  }
   
 1;  1;
Removed from v.1.64  
changed lines
  Added in v.1.69

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