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

Diff for /loncom/interface/lonmeta.pm between versions 1.65 and 1.66

version 1.65, 2004/04/13 15:41:19 version 1.66, 2004/04/13 16:03:46
Line 146  sub diffgraph { Line 146  sub diffgraph {
     return $output;      return $output;
 }  }
   
   #
 # Turn MySQL row into hash  # Turn MySQL row into hash
   #     This routine is here for historic reasons.  Probably should be moved to 
   #     a more generic place since it has nothing to do with metadata
 sub metadata_col_to_hash {  sub metadata_col_to_hash {
     my @cols=@_;      my @cols=@_;
     my %hash=();      my %hash=();
Line 396  sub handler { Line 399  sub handler {
     #      #
     my $uri=$r->uri;      my $uri=$r->uri;
     #      #
     # Looking for all bombs?      if ($uri=~m:/adm/bombs/(.*)$:) {
     if ($uri=~/\/adm\/bombs\/(.*)$/) {          # Looking for all bombs?
         # Set document type          &report_bombs($r,$uri);
         $uri=&Apache::lonnet::declutter($1);      } elsif ($uri=~/^\/\~/) { 
         &Apache::loncommon::content_type($r,'text/html');          # Construction space
         $r->send_http_header;          &present_editable_metadata($r,$uri);
         #      } else {
         return OK if $r->header_only;          &present_uneditable_metadata($r,$uri);
         $r->print(&Apache::loncommon::bodytag('Error Messages'));      }
         $r->print('<h1>'.&Apache::lonnet::clutter($uri).'</h1>');      return OK;
         my ($domain,$author)=($uri=~/^(\w+)\/(\w+)\//);  }
         if (&Apache::loncacc::constructaccess('/~'.$author.'/',$domain)) {  
             my %brokenurls=&Apache::lonmsg::all_url_author_res_msg($author,  sub report_bombs {
                                                                    $domain);      my ($r,$uri) = @_;
             foreach (sort keys %brokenurls) {      # Set document type
                 if ($_=~/^\Q$uri\E/) {      $uri=~ s:/adm/bombs/::;
                     $r->print(&Apache::lonhtmlcommon::crumbs      $uri=&Apache::lonnet::declutter($uri);
                               (&Apache::lonnet::clutter($_)).      &Apache::loncommon::content_type($r,'text/html');
                               &Apache::lonmsg::retrieve_author_res_msg($_).      $r->send_http_header;
                               '<hr />');      #
                 }      return OK if $r->header_only;
       $r->print(&Apache::loncommon::bodytag('Error Messages'));
       $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)=      $r->print('</body></html>');
             (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);      return;
         $loaderror=&Apache::lonnet::overloaderror  }
             ($r,  
              &Apache::lonnet::homeserver($resuser,$resdomain));  sub present_uneditable_metadata {
         if ($loaderror) { return $loaderror; }      my ($r,$uri) = @_;
         #      my ($resdomain,$resuser)=
         my %content=();          (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);
         # Set document type      my $loaderror=&Apache::lonnet::overloaderror
         &Apache::loncommon::content_type($r,'text/html');          ($r,
         $r->send_http_header;           &Apache::lonnet::homeserver($resuser,$resdomain));
         return OK if $r->header_only;      if ($loaderror) { 
         # Read file          return $loaderror;
         foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {      }
             $content{$_}=&Apache::lonnet::metadata($uri,$_);      #
         }      my %content=();
         # Render Output      # Set document type
         # displayed url      &Apache::loncommon::content_type($r,'text/html');
         my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);      $r->send_http_header;
         $uri=~s/\.meta$//;      return OK if $r->header_only;
         my $disuri=&Apache::lonnet::clutter($uri);      # Read file
         # version      foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
         my $currentversion=&Apache::lonnet::getversion($disuri);          $content{$_}=&Apache::lonnet::metadata($uri,$_);
         my $versiondisplay='';      }
         if ($thisversion) {      # Render Output
             $versiondisplay=&mt('Version').': '.$thisversion.      # displayed url
                 ' ('.&mt('most recent version').': '.      my ($thisversion)=($uri=~/\.(\d+)\.(\w+)\.meta$/);
                 ($currentversion>0 ?       $uri=~s/\.meta$//;
                  $currentversion   :      my $disuri=&Apache::lonnet::clutter($uri);
                  &mt('information not available')).')';      # version
         } else {      my $currentversion=&Apache::lonnet::getversion($disuri);
             $versiondisplay='Version: '.$currentversion;      my $versiondisplay='';
         }      if ($thisversion) {
         # crumbify displayed URL          $versiondisplay=&mt('Version').': '.$thisversion.
         $disuri=&Apache::lonhtmlcommon::crumbs($disuri);              ' ('.&mt('most recent version').': '.
         # obsolete              ($currentversion>0 ? 
         my $obsolete=$content{'obsolete'};               $currentversion   :
         my $obsoletewarning='';               &mt('information not available')).')';
         if (($obsolete) && ($ENV{'user.adv'})) {      } else {
             $obsoletewarning='<p><font color="red">'.          $versiondisplay='Version: '.$currentversion;
                 &mt('This resource has been marked obsolete by the author(s)').      }
                 '</font></p>';      # crumbify displayed URL
         }      $disuri=&Apache::lonhtmlcommon::crumbs($disuri);
         #      # obsolete
         my %lt=&fieldnames();      my $obsolete=$content{'obsolete'};
         my $table='';      my $obsoletewarning='';
         my $bodytag=&Apache::loncommon::bodytag      if (($obsolete) && ($ENV{'user.adv'})) {
             ('Catalog Information','','','',$resdomain);          $obsoletewarning='<p><font color="red">'.
         foreach ('title',               &mt('This resource has been marked obsolete by the author(s)').
                  'author',               '</font></p>';
                  'subject',       }
                  'keywords',       #
                  'notes',       my %lt=&fieldnames();
                  'abstract',      my $table='';
                  'lowestgradelevel',      my $bodytag=&Apache::loncommon::bodytag
                  'highestgradelevel',          ('Catalog Information','','','',$resdomain);
                  'standards',       foreach ('title', 
                  'mime',                'author', 
                  'language',                'subject', 
                  'creationdate',                'keywords', 
                  'lastrevisiondate',                'notes', 
                  'owner',                'abstract',
                  'copyright',                'lowestgradelevel',
                  'customdistributionfile',                'highestgradelevel',
                  'obsolete',                'standards', 
                  'obsoletereplacement') {               'mime', 
             $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.               'language', 
         '</td><td bgcolor="#CCCCCC">'.               'creationdate', 
                 &prettyprint($_,$content{$_}).'</td></tr>';               'lastrevisiondate', 
             delete $content{$_};               'owner', 
         }               'copyright', 
         #               'customdistributionfile', 
         $r->print(<<ENDHEAD);               'obsolete', 
                'obsoletereplacement') {
           $table.='<tr><td bgcolor="#AAAAAA">'.$lt{$_}.
               '</td><td bgcolor="#CCCCCC">'.
               &prettyprint($_,$content{$_}).'</td></tr>';
           delete $content{$_};
       }
       #
       $r->print(<<ENDHEAD);
 <html><head><title>Catalog Information</title></head>  <html><head><title>Catalog Information</title></head>
 $bodytag  $bodytag
 <h2>$content{'title'}</h2>  <h2>$content{'title'}</h2>
Line 507  $versiondisplay<br /> Line 528  $versiondisplay<br />
 $table  $table
 </table>  </table>
 ENDHEAD  ENDHEAD
         if ($ENV{'user.adv'}) {      if ($ENV{'user.adv'}) {
             # Dynamic Metadata          # Dynamic Metadata
           $r->print(
                     '<h3>'.&mt('Dynamic Metadata').' ('.
                     &mt('updated periodically').')</h3>'.&mt('Processing').
                     ' ...<br />');
           $r->rflush();
           my %items=&fieldnames();
           my %dynmeta=&dynamicmeta($uri);
           # General Access and Usage Statistics
           $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.
                     '<table cellspacing=2 border=0>');
           foreach ('count',
                    'sequsage','sequsage_list',
                    'comefrom','comefrom_list',
                    'goto','goto_list',
                    'course','course_list') {
               $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                         '<td bgcolor="#CCCCCC">'.
                         &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
           }
           $r->print('</table>');
           if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {
               # This is an assessment, print assessment data
             $r->print(              $r->print(
                       '<h3>'.&mt('Dynamic Metadata').' ('.                        '<h4>'.&mt('Assessment Statistical Data').'</h4>'.
                       &mt('updated periodically').')</h3>'.&mt('Processing').  
                       ' ...<br />');  
             $r->rflush();  
             my %items=&fieldnames();  
             my %dynmeta=&dynamicmeta($uri);  
             # General Access and Usage Statistics  
             $r->print('<h4>'.&mt('Access and Usage Statistics').'</h4>'.  
                       '<table cellspacing=2 border=0>');                        '<table cellspacing=2 border=0>');
             foreach ('count',              foreach ('stdno','avetries','difficulty') {
                      'sequsage','sequsage_list',  
                      'comefrom','comefrom_list',  
                      'goto','goto_list',  
                      'course','course_list') {  
                 $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>');              $r->print('</table>');    
             if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) {          }
                 # This is an assessment, print assessment data          $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.
                 $r->print(                    '<table cellspacing=2 border=0>');
                           '<h4>'.&mt('Assessment Statistical Data').'</h4>'.          foreach ('clear','depth','helpful','correct','technical') {
                           '<table cellspacing=2 border=0>');              $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.
                 foreach ('stdno','avetries','difficulty') {                        '<td bgcolor="#CCCCCC">'.
                     $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.                        &prettyprint($_,$dynmeta{$_})."</td></tr>\n");
                               '<td bgcolor="#CCCCCC">'.          }
                               &prettyprint($_,$dynmeta{$_})."</td></tr>\n");          $r->print('</table>');
                 }          $uri=~/^\/res\/(\w+)\/(\w+)\//; 
                 $r->print('</table>');              if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))
             }              || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
             $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.              $r->print('<h4>'.&mt('Evaluation Comments').' ('.
                       '<table cellspacing=2 border=0>');                        &mt('visible to author and co-authors only').
             foreach ('clear','depth','helpful','correct','technical') {                        ')</h4>'.
                 $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.                        '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
                           '<td bgcolor="#CCCCCC">'.              $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.
                           &prettyprint($_,$dynmeta{$_})."</td></tr>\n");                        &mt('visible to author and co-authors only').')'.
             }                        '</h4>'.
             $r->print('</table>');                        &Apache::lonmsg::retrieve_author_res_msg($uri));
             $uri=~/^\/res\/(\w+)\/(\w+)\//;           }
             if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))          # All other stuff
                 || ($ENV{'user.role.ca./'.$1.'/'.$2})) {          $r->print('<h3>'.
                 $r->print('<h4>'.&mt('Evaluation Comments').' ('.                    &mt('Additional Metadata (non-standard, parameters, exports)').
                           &mt('visible to author and co-authors only').                    '</h3>');
                           ')</h4>'.          foreach (sort keys %content) {
                           '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');              my $name=$_;
                 $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.              if ($name!~/\.display$/) {
                           &mt('visible to author and co-authors only').')'.                  my $display=&Apache::lonnet::metadata($uri,
                           '</h4>'.                                                        $name.'.display');
                           &Apache::lonmsg::retrieve_author_res_msg($uri));                  if (! $display) { 
             }                      $display=$name;
             # All other stuff                  };
             $r->print('<h3>'.                  my $otherinfo='';
                 &mt('Additional Metadata (non-standard, parameters, exports)').                  foreach ('name','part','type','default') {
                       '</h3>');                      if (defined(&Apache::lonnet::metadata($uri,
             foreach (sort keys %content) {                                                            $name.'.'.$_))) {
                 my $name=$_;                          $otherinfo.=' '.$_.'='.
                 if ($name!~/\.display$/) {                              &Apache::lonnet::metadata($uri,
                     my $display=&Apache::lonnet::metadata($uri,                                                        $name.'.'.$_).'; ';
                                                           $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('<b>'.$display.':</b> '.$content{$name});  
                     if ($otherinfo) {  
                         $r->print(' ('.$otherinfo.')');  
                     }                      }
                     $r->print("<br />\n");  
                 }                  }
                   $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  sub present_editable_metadata {
         &Apache::loncommon::content_type($r,'text/html');      my ($r,$uri) = @_;
         $r->send_http_header;      # Construction Space Call
         #      # Set document type
         return OK if $r->header_only;      &Apache::loncommon::content_type($r,'text/html');
         # Header      $r->send_http_header;
         my $disuri=$uri;      #
         my $fn=&Apache::lonnet::filelocation('',$uri);      return OK if $r->header_only;
         $disuri=~s/^\/\~/\/priv\//;      # Header
         $disuri=~s/\.meta$//;      my $disuri=$uri;
         my $target=$uri;      my $fn=&Apache::lonnet::filelocation('',$uri);
         $target=~s/^\/\~/\/res\/$ENV{'request.role.domain'}\//;      $disuri=~s/^\/\~/\/priv\//;
         $target=~s/\.meta$//;      $disuri=~s/\.meta$//;
         my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);      my $target=$uri;
         if ($bombs) {      $target=~s/^\/\~/\/res\/$ENV{'request.role.domain'}\//;
             if ($ENV{'form.delmsg'}) {      $target=~s/\.meta$//;
                 if (&Apache::lonmsg::del_url_author_res_msg($target) eq 'ok') {      my $bombs=&Apache::lonmsg::retrieve_author_res_msg($target);
                     $bombs=&mt('Messages deleted.');      if ($bombs) {
                 } else {          if ($ENV{'form.delmsg'}) {
                     $bombs=&mt('Error deleting messages');              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 $bodytag=&Apache::loncommon::bodytag('Error Messages');
             $r->print(<<ENDBOMBS);          my $del=&mt('Delete Messages');
           $r->print(<<ENDBOMBS);
 <html><head><title>Edit Catalog Information</title></head>  <html><head><title>Edit Catalog Information</title></head>
 $bodytag  $bodytag
 <h1>$disuri</h1>  <h1>$disuri</h1>
Line 628  $bodytag Line 651  $bodytag
 </body>  </body>
 </html>  </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_'.$_};
                 }  
                 if (! $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'}=
                 if (!  ($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>');
                         if ($_!~/\./) {          }
                             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) {
                       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.'>';  
                         }                          }
                           print $mfh '>'.
                               &HTML::Entities::encode
                               ($Apache::lonpublisher::metadatafields{$unikey},
                                '<>&"').
                                '</'.$tag.'>';
                     }                      }
                     $r->print('<p>'.&mt('Wrote Metadata'));  
                 }                  }
                   $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').'"></form>'.
                     '</body></html>');
     }      }
     return OK;      return;
 }  }
   
 # BEGIN Block  # BEGIN Block
Removed from v.1.65  
changed lines
  Added in v.1.66

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