[LON-CAPA-cvs] cvs: loncom /publisher lonpublisher.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Tue, 21 Oct 2003 19:50:15 -0000
This is a MIME encoded message
--albertel1066765815
Content-Type: text/plain
albertel Tue Oct 21 15:50:15 2003 EDT
Modified files:
/loncom/publisher lonpublisher.pm
Log:
- retabinate
--albertel1066765815
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20031021155015.txt"
Index: loncom/publisher/lonpublisher.pm
diff -u loncom/publisher/lonpublisher.pm:1.138 loncom/publisher/lonpublisher.pm:1.139
--- loncom/publisher/lonpublisher.pm:1.138 Thu Sep 25 18:30:06 2003
+++ loncom/publisher/lonpublisher.pm Tue Oct 21 15:50:15 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.138 2003/09/25 22:30:06 www Exp $
+# $Id: lonpublisher.pm,v 1.139 2003/10/21 19:50:15 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -183,43 +183,43 @@
sub metaeval {
my $metastring=shift;
- my $parser=HTML::LCParser->new(\$metastring);
- my $token;
- while ($token=$parser->get_token) {
- if ($token->[0] eq 'S') {
- my $entry=$token->[1];
- my $unikey=$entry;
- if (defined($token->[2]->{'package'})) {
- $unikey.='_package_'.$token->[2]->{'package'};
- }
- if (defined($token->[2]->{'part'})) {
- $unikey.='_'.$token->[2]->{'part'};
- }
- if (defined($token->[2]->{'id'})) {
- $unikey.='_'.$token->[2]->{'id'};
- }
- if (defined($token->[2]->{'name'})) {
- $unikey.='_'.$token->[2]->{'name'};
- }
- foreach (@{$token->[3]}) {
- $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
- if ($metadatakeys{$unikey}) {
- $metadatakeys{$unikey}.=','.$_;
- } else {
- $metadatakeys{$unikey}=$_;
- }
- }
- if ($metadatafields{$unikey}) {
- my $newentry=$parser->get_text('/'.$entry);
- unless (($metadatafields{$unikey}=~/\Q$newentry\E/) ||
- ($newentry eq '')) {
- $metadatafields{$unikey}.=', '.$newentry;
- }
- } else {
- $metadatafields{$unikey}=$parser->get_text('/'.$entry);
- }
- }
- }
+ my $parser=HTML::LCParser->new(\$metastring);
+ my $token;
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'S') {
+ my $entry=$token->[1];
+ my $unikey=$entry;
+ if (defined($token->[2]->{'package'})) {
+ $unikey.='_package_'.$token->[2]->{'package'};
+ }
+ if (defined($token->[2]->{'part'})) {
+ $unikey.='_'.$token->[2]->{'part'};
+ }
+ if (defined($token->[2]->{'id'})) {
+ $unikey.='_'.$token->[2]->{'id'};
+ }
+ if (defined($token->[2]->{'name'})) {
+ $unikey.='_'.$token->[2]->{'name'};
+ }
+ foreach (@{$token->[3]}) {
+ $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
+ if ($metadatakeys{$unikey}) {
+ $metadatakeys{$unikey}.=','.$_;
+ } else {
+ $metadatakeys{$unikey}=$_;
+ }
+ }
+ if ($metadatafields{$unikey}) {
+ my $newentry=$parser->get_text('/'.$entry);
+ unless (($metadatafields{$unikey}=~/\Q$newentry\E/) ||
+ ($newentry eq '')) {
+ $metadatafields{$unikey}.=', '.$newentry;
+ }
+ } else {
+ $metadatafields{$unikey}=$parser->get_text('/'.$entry);
+ }
+ }
+ }
}
#########################################
@@ -1542,15 +1542,13 @@
$thisdistarget=~s/^\Q$docroot\E//;
- undef %metadatafields;
- undef %metadatakeys;
- %metadatafields=();
- %metadatakeys=();
- $srcfile=~/\.(\w+)$/;
- my $thistype=$1;
+ %metadatafields=();
+ %metadatakeys=();
+ $srcfile=~/\.(\w+)$/;
+ my $thistype=$1;
- my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
+ my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
$r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');
@@ -1577,53 +1575,53 @@
$fn=~s/\/+/\//g;
$thisdisfn=~s/\/+/\//g;
my $resdir=
- $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.
- $thisdisfn;
- $r->print('<h1>Directory <tt>'.$thisdisfn.'</tt></h1>'.
- 'Target: <tt>'.$resdir.'</tt><br />');
-
- my $dirptr=16384; # Mask indicating a directory in stat.cmode.
-
- opendir(DIR,$fn);
- my @files=sort(readdir(DIR));
- foreach my $filename (@files) {
- my ($cdev,$cino,$cmode,$cnlink,
+ $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.
+ $thisdisfn;
+ $r->print('<h1>Directory <tt>'.$thisdisfn.'</tt></h1>'.
+ 'Target: <tt>'.$resdir.'</tt><br />');
+
+ my $dirptr=16384; # Mask indicating a directory in stat.cmode.
+
+ opendir(DIR,$fn);
+ my @files=sort(readdir(DIR));
+ foreach my $filename (@files) {
+ my ($cdev,$cino,$cmode,$cnlink,
$cuid,$cgid,$crdev,$csize,
$catime,$cmtime,$cctime,
$cblksize,$cblocks)=stat($fn.'/'.$filename);
- my $extension='';
- if ($filename=~/\.(\w+)$/) { $extension=$1; }
- if ($cmode&$dirptr) {
- if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {
- &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
- }
- } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
- ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
+ my $extension='';
+ if ($filename=~/\.(\w+)$/) { $extension=$1; }
+ if ($cmode&$dirptr) {
+ if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {
+ &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
+ }
+ } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
+ ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
# find out publication status and/or exiting metadata
- my $publishthis=0;
- if (-e $resdir.'/'.$filename) {
+ my $publishthis=0;
+ if (-e $resdir.'/'.$filename) {
my ($rdev,$rino,$rmode,$rnlink,
- $ruid,$rgid,$rrdev,$rsize,
- $ratime,$rmtime,$rctime,
- $rblksize,$rblocks)=stat($resdir.'/'.$filename);
+ $ruid,$rgid,$rrdev,$rsize,
+ $ratime,$rmtime,$rctime,
+ $rblksize,$rblocks)=stat($resdir.'/'.$filename);
if (($rmtime<$cmtime) || ($ENV{'form.forcerepub'})) {
# previously published, modified now
$publishthis=1;
}
- } else {
+ } else {
# never published
- $publishthis=1;
- }
- if ($publishthis) {
+ $publishthis=1;
+ }
+ if ($publishthis) {
&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
- } else {
- $r->print('<br />Skipping '.$filename.'<br />');
- }
- $r->rflush();
- }
- }
- closedir(DIR);
+ } else {
+ $r->print('<br />Skipping '.$filename.'<br />');
+ }
+ $r->rflush();
+ }
+ }
+ closedir(DIR);
}
#########################################
@@ -1666,13 +1664,13 @@
#########################################
#########################################
sub handler {
- my $r=shift;
+ my $r=shift;
- if ($r->header_only) {
- &Apache::loncommon::content_type($r,'text/html');
- $r->send_http_header;
- return OK;
- }
+ if ($r->header_only) {
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ return OK;
+ }
# Get query string for limited number of parameters
@@ -1681,156 +1679,156 @@
# -------------------------------------------------------------- Check filename
- my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
+ my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
- unless ($fn) {
- $r->log_reason($cuname.' at '.$cudom.
- ' trying to publish empty filename', $r->filename);
- return HTTP_NOT_FOUND;
- }
-
- ($cuname,$cudom)=
- &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
- unless (($cuname) && ($cudom)) {
- $r->log_reason($cuname.' at '.$cudom.
- ' trying to publish file '.$ENV{'form.filename'}.
- ' ('.$fn.') - not authorized',
- $r->filename);
- return HTTP_NOT_ACCEPTABLE;
- }
-
- unless (&Apache::lonnet::homeserver($cuname,$cudom)
- eq $r->dir_config('lonHostID')) {
- $r->log_reason($cuname.' at '.$cudom.
- ' trying to publish file '.$ENV{'form.filename'}.
- ' ('.$fn.') - not homeserver ('.
- &Apache::lonnet::homeserver($cuname,$cudom).')',
- $r->filename);
- return HTTP_NOT_ACCEPTABLE;
- }
-
- $fn=~s/^http\:\/\/[^\/]+//;
- $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;
-
- my $targetdir='';
- $docroot=$r->dir_config('lonDocRoot');
- if ($1 ne $cuname) {
- $r->log_reason($cuname.' at '.$cudom.
- ' trying to publish unowned file '.$ENV{'form.filename'}.
- ' ('.$fn.')',
- $r->filename);
- return HTTP_NOT_ACCEPTABLE;
- } else {
- $targetdir=$docroot.'/res/'.$cudom;
- }
+ unless ($fn) {
+ $r->log_reason($cuname.' at '.$cudom.
+ ' trying to publish empty filename', $r->filename);
+ return HTTP_NOT_FOUND;
+ }
+
+ ($cuname,$cudom)=
+ &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
+ unless (($cuname) && ($cudom)) {
+ $r->log_reason($cuname.' at '.$cudom.
+ ' trying to publish file '.$ENV{'form.filename'}.
+ ' ('.$fn.') - not authorized',
+ $r->filename);
+ return HTTP_NOT_ACCEPTABLE;
+ }
+
+ unless (&Apache::lonnet::homeserver($cuname,$cudom)
+ eq $r->dir_config('lonHostID')) {
+ $r->log_reason($cuname.' at '.$cudom.
+ ' trying to publish file '.$ENV{'form.filename'}.
+ ' ('.$fn.') - not homeserver ('.
+ &Apache::lonnet::homeserver($cuname,$cudom).')',
+ $r->filename);
+ return HTTP_NOT_ACCEPTABLE;
+ }
+
+ $fn=~s/^http\:\/\/[^\/]+//;
+ $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;
+
+ my $targetdir='';
+ $docroot=$r->dir_config('lonDocRoot');
+ if ($1 ne $cuname) {
+ $r->log_reason($cuname.' at '.$cudom.
+ ' trying to publish unowned file '.
+ $ENV{'form.filename'}.' ('.$fn.')',
+ $r->filename);
+ return HTTP_NOT_ACCEPTABLE;
+ } else {
+ $targetdir=$docroot.'/res/'.$cudom;
+ }
- unless (-e $fn) {
- $r->log_reason($cuname.' at '.$cudom.
- ' trying to publish non-existing file '.$ENV{'form.filename'}.
- ' ('.$fn.')',
- $r->filename);
- return HTTP_NOT_FOUND;
- }
+ unless (-e $fn) {
+ $r->log_reason($cuname.' at '.$cudom.
+ ' trying to publish non-existing file '.
+ $ENV{'form.filename'}.' ('.$fn.')',
+ $r->filename);
+ return HTTP_NOT_FOUND;
+ }
-unless ($ENV{'form.phase'} eq 'two') {
+ unless ($ENV{'form.phase'} eq 'two') {
# -------------------------------- File is there and owned, init lookup tables.
- %addid=();
+ %addid=();
- {
- my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
- while (<$fh>=~/(\w+)\s+(\w+)/) {
- $addid{$1}=$2;
- }
- }
-
- %nokey=();
-
- {
- my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
- while (<$fh>) {
- my $word=$_;
- chomp($word);
- $nokey{$word}=1;
- }
- }
+ {
+ my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
+ while (<$fh>=~/(\w+)\s+(\w+)/) {
+ $addid{$1}=$2;
+ }
+ }
-}
+ %nokey=();
+
+ {
+ my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
+ while (<$fh>) {
+ my $word=$_;
+ chomp($word);
+ $nokey{$word}=1;
+ }
+ }
+
+ }
# ---------------------------------------------------------- Start page output.
- &Apache::loncommon::content_type($r,'text/html');
- $r->send_http_header;
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
- $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
- $r->print(&Apache::loncommon::bodytag('Resource Publication'));
+ $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
+ $r->print(&Apache::loncommon::bodytag('Resource Publication'));
- my $thisfn=$fn;
+ my $thisfn=$fn;
- my $thistarget=$thisfn;
+ my $thistarget=$thisfn;
- $thistarget=~s/^\/home/$targetdir/;
- $thistarget=~s/\/public\_html//;
+ $thistarget=~s/^\/home/$targetdir/;
+ $thistarget=~s/\/public\_html//;
- my $thisdistarget=$thistarget;
- $thisdistarget=~s/^\Q$docroot\E//;
+ my $thisdistarget=$thistarget;
+ $thisdistarget=~s/^\Q$docroot\E//;
- my $thisdisfn=$thisfn;
- $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;
+ my $thisdisfn=$thisfn;
+ $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;
- if ($fn=~/\/$/) {
+ if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory
- &publishdirectory($r,$fn,$thisdisfn);
- $r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'
- .$cuname.'/'.$thisdisfn
- .'">'.&mt('Return to Directory').'</a>');
+ &publishdirectory($r,$fn,$thisdisfn);
+ $r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'
+ .$cuname.'/'.$thisdisfn
+ .'">'.&mt('Return to Directory').'</a>');
- } else {
+ } else {
# ---------------------- Evaluate individual file, and then output information.
- $thisfn=~/\.(\w+)$/;
- my $thistype=$1;
- my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
- $r->print('<h2>'.&mt('Publishing').' '.
- &Apache::loncommon::filedescription($thistype).' <tt>');
+ $thisfn=~/\.(\w+)$/;
+ my $thistype=$1;
+ my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
+ $r->print('<h2>'.&mt('Publishing').' '.
+ &Apache::loncommon::filedescription($thistype).' <tt>');
- $r->print(<<ENDCAPTION);
+ $r->print(<<ENDCAPTION);
<a href='javascript:void(window.open("/~$cuname/$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
$thisdisfn</a>
ENDCAPTION
- $r->print(
- '</tt></h2><b>'.&mt('Target').':</b> <tt>'.$thisdistarget.'</tt><br />');
+ $r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.
+ $thisdistarget.'</tt><br />');
- if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) {
- $r->print('<h3><font color="red">'.&mt('Co-Author').': '.$cuname.&mt(' at ').$cudom.
- '</font></h3>');
- }
+ if (($cuname ne $ENV{'user.name'})||($cudom ne $ENV{'user.domain'})) {
+ $r->print('<h3><font color="red">'.&mt('Co-Author').': '.
+ $cuname.&mt(' at ').$cudom.'</font></h3>');
+ }
- if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
- $r->print(<<ENDDIFF);
+ if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
+ $r->print(<<ENDDIFF);
<br />
<a href='javascript:void(window.open("/adm/diff?filename=/~$cuname/$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
ENDDIFF
- $r->print(&mt('Diffs with Current Version').'</a><br />');
- }
+ $r->print(&mt('Diffs with Current Version').'</a><br />');
+ }
# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.
- unless ($ENV{'form.phase'} eq 'two') {
- my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);
- $r->print('<hr />'.$outstring);
- } else {
- $r->print('<hr />');
- &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);
- }
- }
- $r->print('</body></html>');
+ unless ($ENV{'form.phase'} eq 'two') {
+ my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);
+ $r->print('<hr />'.$outstring);
+ } else {
+ $r->print('<hr />');
+ &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);
+ }
+ }
+ $r->print('</body></html>');
- return OK;
+ return OK;
}
1;
--albertel1066765815--