[LON-CAPA-cvs] cvs: loncom /interface lonmeta.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Wed, 14 Apr 2004 16:14:29 -0000
This is a MIME encoded message
--matthew1081959269
Content-Type: text/plain
matthew Wed Apr 14 12:14:29 2004 EDT
Modified files:
/loncom/interface lonmeta.pm
Log:
Further code consolidation.
Fixed bug which prevented display of dynamic metadata.
Moved display of dynamic metadata to its own subroutine.
Added some debugging code to &dynamicmeta.
--matthew1081959269
Content-Type: text/plain
Content-Disposition: attachment; filename="matthew-20040414121429.txt"
Index: loncom/interface/lonmeta.pm
diff -u loncom/interface/lonmeta.pm:1.66 loncom/interface/lonmeta.pm:1.67
--- loncom/interface/lonmeta.pm:1.66 Tue Apr 13 12:03:46 2004
+++ loncom/interface/lonmeta.pm Wed Apr 14 12:14:29 2004
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Metadata display handler
#
-# $Id: lonmeta.pm,v 1.66 2004/04/13 16:03:46 matthew Exp $
+# $Id: lonmeta.pm,v 1.67 2004/04/14 16:14:29 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -40,9 +40,6 @@
use Apache::lonmysql;
use Apache::lonmsg;
-# MySQL table columns
-
-my @columns;
# Fetch and evaluate dynamic metadata
sub dynamicmeta {
@@ -60,6 +57,15 @@
#
# Deal with 'count' separately
$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;
}
@@ -146,18 +152,6 @@
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
sub fieldnames {
@@ -394,39 +388,67 @@
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; }
+ 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/(.*)$:) {
+ $r->print(&Apache::loncommon::bodytag('Error Messages'));
# Looking for all bombs?
&report_bombs($r,$uri);
} elsif ($uri=~/^\/\~/) {
# Construction space
+ $r->print(&Apache::loncommon::bodytag
+ ('Edit Catalog Information','','','',$resdomain));
&present_editable_metadata($r,$uri);
} else {
+ $r->print(&Apache::loncommon::bodytag
+ ('Catalog Information','','','',$resdomain));
&present_uneditable_metadata($r,$uri);
}
+ $r->print('</body></html>');
return OK;
}
+#####################################################
+#####################################################
+### ###
+### Report Bombs ###
+### ###
+#####################################################
+#####################################################
sub report_bombs {
my ($r,$uri) = @_;
# Set document type
- $uri=~ s:/adm/bombs/::;
- $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'));
+ $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) {
+ 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($_)).
@@ -437,26 +459,20 @@
} else {
$r->print(&mt('Not authorized'));
}
- $r->print('</body></html>');
return;
}
+#####################################################
+#####################################################
+### ###
+### Uneditable Metadata Display ###
+### ###
+#####################################################
+#####################################################
sub present_uneditable_metadata {
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=();
- # Set document type
- &Apache::loncommon::content_type($r,'text/html');
- $r->send_http_header;
- return OK if $r->header_only;
# Read file
foreach (split(/\,/,&Apache::lonnet::metadata($uri,'keys'))) {
$content{$_}=&Apache::lonnet::metadata($uri,$_);
@@ -491,8 +507,6 @@
#
my %lt=&fieldnames();
my $table='';
- my $bodytag=&Apache::loncommon::bodytag
- ('Catalog Information','','','',$resdomain);
foreach ('title',
'author',
'subject',
@@ -518,8 +532,6 @@
}
#
$r->print(<<ENDHEAD);
-<html><head><title>Catalog Information</title></head>
-$bodytag
<h2>$content{'title'}</h2>
<h3><tt>$disuri</tt></h3>
$obsoletewarning
@@ -529,98 +541,108 @@
</table>
ENDHEAD
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(
- '<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>'.
+ '<h4>'.&mt('Assessment Statistical Data').'</h4>'.
'<table cellspacing=2 border=0>');
- foreach ('count',
- 'sequsage','sequsage_list',
- 'comefrom','comefrom_list',
- 'goto','goto_list',
- 'course','course_list') {
+ foreach ('stdno','avetries','difficulty') {
$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(
- '<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('<b>'.$display.':</b> '.$content{$name});
- if ($otherinfo) {
- $r->print(' ('.$otherinfo.')');
+ $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("<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 {
my ($r,$uri) = @_;
# 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 $disuri=$uri;
my $fn=&Apache::lonnet::filelocation('',$uri);
@@ -638,18 +660,12 @@
$bombs=&mt('Error deleting messages');
}
}
- my $bodytag=&Apache::loncommon::bodytag('Error Messages');
my $del=&mt('Delete Messages');
$r->print(<<ENDBOMBS);
-<html><head><title>Edit Catalog Information</title></head>
-$bodytag
<h1>$disuri</h1>
<form method="post" name="defaultmeta">
<input type="submit" name="delmsg" value="$del" />
<br />$bombs
-</form>
-</body>
-</html>
ENDBOMBS
} else {
my $displayfile='Catalog Information for '.$disuri;
@@ -701,42 +717,60 @@
&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(/\,/,
+ 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})
- ) {
- my $value=
- $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
- $value=~s/\"/\'\'/g;
- print $mfh ' '.$_.'="'.$value.'"';
- }
- print $mfh '>'.
- &HTML::Entities::encode
- ($Apache::lonpublisher::metadatafields{$unikey},
- '<>&"').
- '</'.$tag.'>';
+ ) {
+ my $value=
+ $Apache::lonpublisher::metadatafields{$unikey.'.'.$_};
+ $value=~s/\"/\'\'/g;
+ print $mfh ' '.$_.'="'.$value.'"';
}
+ 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>');
+ &mt('Store Catalog Information').'">');
}
+ $r->print('</form>');
return;
}
-# BEGIN Block
+##############################################################
+##############################################################
+# MySQL table columns
+
+my @columns;
+
BEGIN {
# Get columns of MySQL metadata table
@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;
__END__
--matthew1081959269--