--- loncom/interface/lonmeta.pm 2004/04/13 16:03:46 1.66 +++ loncom/interface/lonmeta.pm 2004/04/15 18:06:29 1.72 @@ -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.72 2004/04/15 18:06:29 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,9 +40,6 @@ use Apache::lonlocal; use Apache::lonmysql; use Apache::lonmsg; -# MySQL table columns - -my @columns; # Fetch and evaluate dynamic metadata sub dynamicmeta { @@ -60,6 +57,15 @@ sub dynamicmeta { # # 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; } @@ -108,21 +114,21 @@ sub evalgraph { return ''; } my $val=int($value*10.+0.5)-10; - my $output=''; + my $output='
'; if ($val>=20) { - $output.=''; + $output.=''; } else { - $output.=''. - ''; + $output.=''. + ''; } $output.=''; if ($val>20) { - $output.=''. - ''; + $output.=''. + ''; } else { - $output.=''; + $output.=''; } - $output.='
                  ('.$value.')
'; + $output.=' ('.sprintf("%5.2f",$value).') '; return $output; } @@ -134,30 +140,18 @@ sub diffgraph { my $val=int(40.0*$value+0.5); my @colors=('#FF9933','#EEAA33','#DDBB33','#CCCC33', '#BBDD33','#CCCC33','#DDBB33','#EEAA33'); - my $output=''; + my $output='
'; for (my $i=0;$i<8;$i++) { if ($val>$i*5) { - $output.=''; + $output.=''; } else { - $output.=''; + $output.=''; } } - $output.='
     ('.$value.')
'; + $output.=' ('.sprintf("%3.2f",$value).') '; 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 { @@ -258,9 +252,26 @@ sub prettyprint { ($type eq 'comefrom_list') || ($type eq 'sequsage_list')) { return join('
',map { - my $url=&Apache::lonnet::clutter($_); - ''.&Apache::lonnet::gettitle($url).''. - &Apache::lonhtmlcommon::crumbs($url,'preview','',undef,'+0'); + my $url = &Apache::lonnet::clutter($_); + my $title = &Apache::lonnet::gettitle($url); + if ($title eq '') { + $title = 'Untitled'; + if ($url =~ /\.sequence$/) { + $title .= ' Sequence'; + } elsif ($url =~ /\.page$/) { + $title .= ' Page'; + } elsif ($url =~ /\.problem$/) { + $title .= ' Problem'; + } elsif ($url =~ /\.html$/) { + $title .= ' HTML document'; + } elsif ($url =~ m:/syllabus$:) { + $title .= ' Syllabus'; + } + } + $_ = ''.$title.' '. + ''. + ''.$url.''. + '' } split(/\s*\,\s*/,$value)); } # Evaluations @@ -277,12 +288,19 @@ sub prettyprint { } # List of courses if ($type=~/\_list/) { - return join('
',map { - my %courseinfo=&Apache::lonnet::coursedescription($_); - ''. - $courseinfo{'description'}.''; - } split(/\s*\,\s*/,$value)); + my @Courses = split(/\s*\,\s*/,$value); + my $Str; + foreach my $course (@Courses) { + my %courseinfo = &Apache::lonnet::coursedescription($course); + if (! exists($courseinfo{'num'}) || $courseinfo{'num'} eq '') { + next; + } + if ($Str ne '') { $Str .= '
'; } + $Str .= ''. + $courseinfo{'description'}.''; + } + return $Str; } # No pretty print found return $value; @@ -394,69 +412,91 @@ sub prettyinput { 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(''. + 'Catalog Information'. + ''); 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(''); 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('

'.&Apache::lonnet::clutter($uri).'

'); 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($_)). - &Apache::lonmsg::retrieve_author_res_msg($_). - '
'); + $r->print + (''.$_.''. + &Apache::lonmsg::retrieve_author_res_msg($_). + '
'); } } } else { $r->print(&mt('Not authorized')); } - $r->print(''); 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,$_); @@ -478,8 +518,9 @@ sub present_uneditable_metadata { } else { $versiondisplay='Version: '.$currentversion; } - # crumbify displayed URL - $disuri=&Apache::lonhtmlcommon::crumbs($disuri); + # crumbify displayed URL uri target prefix form size + $disuri=&Apache::lonhtmlcommon::crumbs($disuri,undef, undef, undef,'+1'); + $disuri =~ s:
::g; # obsolete my $obsolete=$content{'obsolete'}; my $obsoletewarning=''; @@ -491,8 +532,10 @@ sub present_uneditable_metadata { # my %lt=&fieldnames(); my $table=''; - my $bodytag=&Apache::loncommon::bodytag - ('Catalog Information','','','',$resdomain); + my $title = $content{'title'}; + if (! defined($title)) { + $title = 'Untitled Resource'; + } foreach ('title', 'author', 'subject', @@ -518,26 +561,41 @@ sub present_uneditable_metadata { } # $r->print(<Catalog Information -$bodytag -

$content{'title'}

-

$disuri

+

$title

+

+$disuri
$obsoletewarning -$versiondisplay
+$versiondisplay +

$table
ENDHEAD if ($ENV{'user.adv'}) { - # Dynamic Metadata - $r->print( - '

'.&mt('Dynamic Metadata').' ('. - &mt('updated periodically').')

'.&mt('Processing'). - ' ...
'); - $r->rflush(); - my %items=&fieldnames(); - my %dynmeta=&dynamicmeta($uri); - # General Access and Usage Statistics + &print_dynamic_metadata($r,$uri,\%content); + } + return; +} + +sub print_dynamic_metadata { + my ($r,$uri,$content) = @_; + # + my %content = %$content; + my %lt=&fieldnames(); + # + my $description = 'Dynamic Metadata (updated periodically)'; + $r->print('

'.&mt($description).'

'. + &mt('Processing')); + $r->rflush(); + my %items=&fieldnames(); + my %dynmeta=&dynamicmeta($uri); + # + # General Access and Usage Statistics + if (exists($dynmeta{'count'}) || + exists($dynmeta{'sequsage'}) || + exists($dynmeta{'comefrom'}) || + exists($dynmeta{'goto'}) || + exists($dynmeta{'course'})) { $r->print('

'.&mt('Access and Usage Statistics').'

'. ''); foreach ('count', @@ -550,18 +608,33 @@ ENDHEAD &prettyprint($_,$dynmeta{$_})."\n"); } $r->print('
'); - if ($uri=~/\.(problem|exam|quiz|assess|survey|form)\.meta$/) { - # This is an assessment, print assessment data - $r->print( - '

'.&mt('Assessment Statistical Data').'

'. - ''); - foreach ('stdno','avetries','difficulty') { - $r->print(''. - '\n"); - } - $r->print('
'.$lt{$_}.''. - &prettyprint($_,$dynmeta{$_})."
'); + } else { + $r->print('

'.&mt('No Access or Usages Statistics are available for this resource.').'

'); + } + # + # Assessment statistics + if ($uri=~/\.(problem|exam|quiz|assess|survey|form)$/ && + (exists($dynmeta{'stdno'}) || + exists($dynmeta{'avetries'}) || + exists($dynmeta{'difficulty'}))) { + # This is an assessment, print assessment data + $r->print('

'.&mt('Assessment Statistical Data').'

'. + ''); + foreach ('stdno','avetries','difficulty') { + $r->print(''. + ''. + "\n"); } + $r->print('
'.$lt{$_}.''. + &prettyprint($_,sprintf('%5.2f',$dynmeta{$_})).'
'); + } else { + $r->print('

'.&mt('No Assessment Statistical Data is available for this resource').'

'); + } + if (exists($dynmeta{'clear'}) || + exists($dynmeta{'depth'}) || + exists($dynmeta{'helpful'}) || + exists($dynmeta{'correct'}) || + exists($dynmeta{'technical'})){ $r->print('

'.&mt('Evaluation Data').'

'. ''); foreach ('clear','depth','helpful','correct','technical') { @@ -570,57 +643,71 @@ ENDHEAD &prettyprint($_,$dynmeta{$_})."\n"); } $r->print('
'); - $uri=~/^\/res\/(\w+)\/(\w+)\//; - if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2)) - || ($ENV{'user.role.ca./'.$1.'/'.$2})) { + } else { + $r->print('

'.&mt('No Evaluation Data is available for this resource.').'

'); + } + $uri=~/^\/res\/(\w+)\/(\w+)\//; + if ((($ENV{'user.domain'} eq $1) && ($ENV{'user.name'} eq $2)) + || ($ENV{'user.role.ca./'.$1.'/'.$2})) { + if (exists($dynmeta{'comments'})) { $r->print('

'.&mt('Evaluation Comments').' ('. &mt('visible to author and co-authors only'). ')

'. '
'.$dynmeta{'comments'}.'
'); + } else { + $r->print('

'.&mt('There are no Evaluation Comments on this resource.').'

'); + } + my $bombs = &Apache::lonmsg::retrieve_author_res_msg($uri); + if (defined($bombs) && $bombs ne '') { $r->print('

'.&mt('Error Messages').' ('. &mt('visible to author and co-authors only').')'. - '

'. - &Apache::lonmsg::retrieve_author_res_msg($uri)); + ''.$bombs); + } else { + $r->print('

'.&mt('There are currently no Error Messages for this resource.').'

'); } - # All other stuff - $r->print('

'. - &mt('Additional Metadata (non-standard, parameters, exports)'). - '

'); - 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(''.$display.': '.$content{$name}); - if ($otherinfo) { - $r->print(' ('.$otherinfo.')'); + } + # + # All other stuff + $r->print('

'. + &mt('Additional Metadata (non-standard, parameters, exports)'). + '

'); + 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("
\n"); } + $r->print(''.$display.': '.$content{$name}); + if ($otherinfo) { + $r->print(' ('.$otherinfo.')'); + } + $r->print("
\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 +725,12 @@ sub present_editable_metadata { $bombs=&mt('Error deleting messages'); } } - my $bodytag=&Apache::loncommon::bodytag('Error Messages'); my $del=&mt('Delete Messages'); $r->print(<Edit Catalog Information -$bodytag

$disuri


$bombs -
- - ENDBOMBS } else { my $displayfile='Catalog Information for '.$disuri; @@ -701,42 +782,35 @@ ENDEDIT &mt('FAIL').''); } 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}, - '<>&"'). - ''; + ) { + my $value= + $Apache::lonpublisher::metadatafields{$unikey.'.'.$_}; + $value=~s/\"/\'\'/g; + print $mfh ' '.$_.'="'.$value.'"'; } + print $mfh '>'. + &HTML::Entities::encode + ($Apache::lonpublisher::metadatafields{$unikey}, + '<>&"'). + ''; } $r->print('

'.&mt('Wrote Metadata')); } } $r->print('
'. - ''); + &mt('Store Catalog Information').'">'); } + $r->print(''); return; } -# BEGIN Block -BEGIN { - # Get columns of MySQL metadata table - @columns=&Apache::lonmysql::col_order('metadata'); -} - 1; __END__