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

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

version 1.66, 2004/04/13 16:03:46 version 1.67, 2004/04/14 16:14:29
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 146  sub diffgraph { Line 152  sub diffgraph {
     return $output;      return $output;
 }  }
   
 #  
 # 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 {  
     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 394  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;
       }
       #
       # Set document type
       &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
       return OK if $r->header_only;
     #      #
       $r->print('<html><head><title>'.
                 'Catalog Information'.
                 '</title></head>');
     if ($uri=~m:/adm/bombs/(.*)$:) {      if ($uri=~m:/adm/bombs/(.*)$:) {
           $r->print(&Apache::loncommon::bodytag('Error Messages'));
         # Looking for all bombs?          # Looking for all bombs?
         &report_bombs($r,$uri);          &report_bombs($r,$uri);
     } elsif ($uri=~/^\/\~/) {       } elsif ($uri=~/^\/\~/) { 
         # Construction space          # Construction space
           $r->print(&Apache::loncommon::bodytag
                     ('Edit Catalog Information','','','',$resdomain));
         &present_editable_metadata($r,$uri);          &present_editable_metadata($r,$uri);
     } else {      } else {
           $r->print(&Apache::loncommon::bodytag
                     ('Catalog Information','','','',$resdomain));
         &present_uneditable_metadata($r,$uri);          &present_uneditable_metadata($r,$uri);
     }      }
       $r->print('</body></html>');
     return OK;      return OK;
 }  }
   
   #####################################################
   #####################################################
   ###                                               ###
   ###                Report Bombs                   ###
   ###                                               ###
   #####################################################
   #####################################################
 sub report_bombs {  sub report_bombs {
     my ($r,$uri) = @_;      my ($r,$uri) = @_;
     # Set document type      # Set document type
     $uri=~ s:/adm/bombs/::;      $uri =~ s:/adm/bombs/::;
     $uri=&Apache::lonnet::declutter($uri);      $uri = &Apache::lonnet::declutter($uri);
     &Apache::loncommon::content_type($r,'text/html');  
     $r->send_http_header;  
     #  
     return OK if $r->header_only;  
     $r->print(&Apache::loncommon::bodytag('Error Messages'));  
     $r->print('<h1>'.&Apache::lonnet::clutter($uri).'</h1>');      $r->print('<h1>'.&Apache::lonnet::clutter($uri).'</h1>');
     my ($domain,$author)=($uri=~/^(\w+)\/(\w+)\//);      my ($domain,$author)=($uri=~/^(\w+)\/(\w+)\//);
     if (&Apache::loncacc::constructaccess('/~'.$author.'/',$domain)) {      if (&Apache::loncacc::constructaccess('/~'.$author.'/',$domain)) {
         my %brokenurls=&Apache::lonmsg::all_url_author_res_msg($author,          my %brokenurls = 
                                                                $domain);              &Apache::lonmsg::all_url_author_res_msg($author,$domain);
         foreach (sort keys %brokenurls) {          foreach (sort(keys(%brokenurls))) {
             if ($_=~/^\Q$uri\E/) {              if ($_=~/^\Q$uri\E/) {
                 $r->print(&Apache::lonhtmlcommon::crumbs                  $r->print(&Apache::lonhtmlcommon::crumbs
                           (&Apache::lonnet::clutter($_)).                            (&Apache::lonnet::clutter($_)).
Line 437  sub report_bombs { Line 459  sub report_bombs {
     } else {      } else {
         $r->print(&mt('Not authorized'));          $r->print(&mt('Not authorized'));
     }      }
     $r->print('</body></html>');  
     return;      return;
 }  }
   
   #####################################################
   #####################################################
   ###                                               ###
   ###        Uneditable Metadata Display            ###
   ###                                               ###
   #####################################################
   #####################################################
 sub present_uneditable_metadata {  sub present_uneditable_metadata {
     my ($r,$uri) = @_;      my ($r,$uri) = @_;
     my ($resdomain,$resuser)=  
         (&Apache::lonnet::declutter($uri)=~/^(\w+)\/(\w+)\//);  
     my $loaderror=&Apache::lonnet::overloaderror  
         ($r,  
          &Apache::lonnet::homeserver($resuser,$resdomain));  
     if ($loaderror) {   
         return $loaderror;  
     }  
     #      #
     my %content=();      my %content=();
     # Set document type  
     &Apache::loncommon::content_type($r,'text/html');  
     $r->send_http_header;  
     return OK if $r->header_only;  
     # Read file      # Read file
     foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {      foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
         $content{$_}=&Apache::lonnet::metadata($uri,$_);          $content{$_}=&Apache::lonnet::metadata($uri,$_);
Line 491  sub present_uneditable_metadata { Line 507  sub present_uneditable_metadata {
     #      #
     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', 
Line 518  sub present_uneditable_metadata { Line 532  sub present_uneditable_metadata {
     }      }
     #      #
     $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 529  $table Line 541  $table
 </table>  </table>
 ENDHEAD  ENDHEAD
     if ($ENV{'user.adv'}) {      if ($ENV{'user.adv'}) {
         # Dynamic Metadata          &print_dynamic_metadata($r,$uri);
       }
       return;
   }
   
   sub print_dynamic_metadata {
       my ($r,$uri) = @_;
       #
       my $description = 'Dynamic Metadata (updated periodically)';
       $r->print('<h3>'.&mt($description).'</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)$/) {
           # 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(      $r->print('<h4>'.&mt('Evaluation Data').'</h4>'.
                       '<h4>'.&mt('Assessment Statistical Data').'</h4>'.                '<table cellspacing=2 border=0>');
                       '<table cellspacing=2 border=0>');      foreach ('clear','depth','helpful','correct','technical') {
             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>');
             $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>'.          || ($ENV{'user.role.ca./'.$1.'/'.$2})) {
                   '<table cellspacing=2 border=0>');          $r->print('<h4>'.&mt('Evaluation Comments').' ('.
         foreach ('clear','depth','helpful','correct','technical') {                    &mt('visible to author and co-authors only').
             $r->print('<tr><td bgcolor="#AAAAAA">'.$lt{$_}.'</td>'.                    ')</h4>'.
                       '<td bgcolor="#CCCCCC">'.                    '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');
                       &prettyprint($_,$dynmeta{$_})."</td></tr>\n");          $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.
         }                    &mt('visible to author and co-authors only').')'.
         $r->print('</table>');                    '</h4>'.
         $uri=~/^\/res\/(\w+)\/(\w+)\//;                     &Apache::lonmsg::retrieve_author_res_msg($uri));
         if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2))      }
             || ($ENV{'user.role.ca./'.$1.'/'.$2})) {      # All other stuff
             $r->print('<h4>'.&mt('Evaluation Comments').' ('.      $r->print('<h3>'.
                       &mt('visible to author and co-authors only').                &mt('Additional Metadata (non-standard, parameters, exports)').
                       ')</h4>'.                '</h3>');
                       '<blockquote>'.$dynmeta{'comments'}.'</blockquote>');      foreach (sort(keys(%content))) {
             $r->print('<a name="bombs" /><h4>'.&mt('Error Messages').' ('.          my $name=$_;
                       &mt('visible to author and co-authors only').')'.          if ($name!~/\.display$/) {
                       '</h4>'.              my $display=&Apache::lonnet::metadata($uri,
                       &Apache::lonmsg::retrieve_author_res_msg($uri));                                                    $name.'.display');
         }              if (! $display) { 
         # All other stuff                  $display=$name;
         $r->print('<h3>'.              };
                   &mt('Additional Metadata (non-standard, parameters, exports)').              my $otherinfo='';
                   '</h3>');              foreach ('name','part','type','default') {
         foreach (sort keys %content) {                  if (defined(&Apache::lonnet::metadata($uri,
             my $name=$_;                                                        $name.'.'.$_))) {
             if ($name!~/\.display$/) {                      $otherinfo.=' '.$_.'='.
                 my $display=&Apache::lonnet::metadata($uri,                          &Apache::lonnet::metadata($uri,
                                                       $name.'.display');                                                    $name.'.'.$_).'; ';
                 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");
         }          }
     }      }
       return;
 }  }
   
   #####################################################
   #####################################################
   ###                                               ###
   ###          Editable metadata display            ###
   ###                                               ###
   #####################################################
   #####################################################
 sub present_editable_metadata {  sub present_editable_metadata {
     my ($r,$uri) = @_;      my ($r,$uri) = @_;
     # Construction Space Call      # Construction Space Call
     # Set document type  
     &Apache::loncommon::content_type($r,'text/html');  
     $r->send_http_header;  
     #  
     return OK if $r->header_only;  
     # Header      # Header
     my $disuri=$uri;      my $disuri=$uri;
     my $fn=&Apache::lonnet::filelocation('',$uri);      my $fn=&Apache::lonnet::filelocation('',$uri);
Line 638  sub present_editable_metadata { Line 660  sub present_editable_metadata {
                 $bombs=&mt('Error deleting messages');                  $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;
Line 701  ENDEDIT Line 717  ENDEDIT
                           &mt('FAIL').'</font>');                            &mt('FAIL').'</font>');
             } else {              } else {
                 foreach (sort keys %Apache::lonpublisher::metadatafields) {                  foreach (sort keys %Apache::lonpublisher::metadatafields) {
                     if ($_!~/\./) {                      next if ($_ =~ /\./);
                         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 (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="'.          $r->print('<br /><input type="submit" name="store" value="'.
                   &mt('Store Catalog Information').'"></form>'.                    &mt('Store Catalog Information').'">');
                   '</body></html>');  
     }      }
       $r->print('</form>');
     return;      return;
 }  }
   
 # 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');
 }  }
   
   #
   # 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;  1;
 __END__  __END__
Removed from v.1.66  
changed lines
  Added in v.1.67

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