--- loncom/publisher/lonpublisher.pm 2001/12/17 01:50:54 1.66
+++ loncom/publisher/lonpublisher.pm 2008/06/30 18:10:24 1.239
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.66 2001/12/17 01:50:54 harris41 Exp $
+# $Id: lonpublisher.pm,v 1.239 2008/06/30 18:10:24 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,24 +25,6 @@
#
# http://www.lon-capa.org/
#
-#
-# (TeX Content Handler
-#
-# 05/29/00,05/30,10/11 Gerd Kortemeyer)
-#
-# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
-# 03/23 Guy Albertelli
-# 03/24,03/29,04/03 Gerd Kortemeyer
-# 04/16/2001 Scott Harrison
-# 05/03,05/05,05/07 Gerd Kortemeyer
-# 05/28/2001 Scott Harrison
-# 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer
-# 12/04,12/05 Guy Albertelli
-# 12/05 Gerd Kortemeyer
-# 12/05 Guy Albertelli
-# 12/06,12/07 Gerd Kortemeyer
-# 12/15,12/16 Scott Harrison
-#
###
###############################################################################
@@ -57,6 +39,77 @@
## ##
###############################################################################
+
+######################################################################
+######################################################################
+
+=pod
+
+=head1 NAME
+
+lonpublisher - LON-CAPA publishing handler
+
+=head1 SYNOPSIS
+
+B is used by B inside B. This is the
+invocation by F:
+
+
+ PerlAccessHandler Apache::lonacc
+ SetHandler perl-script
+ PerlHandler Apache::lonpublisher
+ ErrorDocument 403 /adm/login
+ ErrorDocument 404 /adm/notfound.html
+ ErrorDocument 406 /adm/unauthorized.html
+ ErrorDocument 500 /adm/errorhandler
+
+
+=head1 OVERVIEW
+
+Authors can only write-access the C~authorname/> space. They can
+copy resources into the resource area through the publication step,
+and move them back through a recover step. Authors do not have direct
+write-access to their resource space.
+
+During the publication step, several events will be
+triggered. Metadata is gathered, where a wizard manages default
+entries on a hierarchical per-directory base: The wizard imports the
+metadata (including access privileges and royalty information) from
+the most recent published resource in the current directory, and if
+that is not available, from the next directory above, etc. The Network
+keeps all previous versions of a resource and makes them available by
+an explicit version number, which is inserted between the file name
+and extension, for example C, while the most recent
+version does not carry a version number (C). Servers
+subscribing to a changed resource are notified that a new version is
+available.
+
+=head1 DESCRIPTION
+
+B takes the proper steps to add resources to the LON-CAPA
+digital library. This includes updating the metadata table in the
+LON-CAPA database.
+
+B is many things to many people.
+
+This module publishes a file. This involves gathering metadata,
+versioning the file, copying file from construction space to
+publication space, and copying metadata from construction space
+to publication space.
+
+=head2 SUBROUTINES
+
+Many of the undocumented subroutines implement various magical
+parsing shortcuts.
+
+=over 4
+
+=cut
+
+######################################################################
+######################################################################
+
+
package Apache::lonpublisher;
# ------------------------------------------------- modules used by this module
@@ -64,111 +117,267 @@ use strict;
use Apache::File;
use File::Copy;
use Apache::Constants qw(:common :http :methods);
-use HTML::TokeParser;
+use HTML::LCParser;
use Apache::lonxml;
-use Apache::lonhomework;
use Apache::loncacc;
use DBI;
-use Apache::lonnet();
+use Apache::lonnet;
use Apache::loncommon();
+use Apache::lonmysql;
+use Apache::lonlocal;
+use Apache::loncfile;
+use LONCAPA::lonmetadata;
+use Apache::lonmsg;
+use vars qw(%metadatafields %metadatakeys);
+use LONCAPA qw(:DEFAULT :match);
+
my %addid;
my %nokey;
-my %metadatafields;
-my %metadatakeys;
-
my $docroot;
my $cuname;
my $cudom;
-# ----------------------------------------------- Evaluate string with metadata
+my $registered_cleanup;
+my $modified_urls;
+
+my $lock;
+
+=pod
+
+=item B
+
+Evaluates a string that contains metadata. This subroutine
+stores values inside I<%metadatafields> and I<%metadatakeys>.
+The hash key is a I<$unikey> corresponding to a unique id
+that is descriptive of the parser location inside the XML tree.
+
+Parameters:
+
+=over 4
+
+=item I<$metastring>
+
+A string that contains metadata.
+
+=back
+
+Returns:
+
+nothing
+
+=cut
+
+#########################################
+#########################################
+#
+# Modifies global %metadatafields %metadatakeys
+#
+
sub metaeval {
- my $metastring=shift;
+ my ($metastring,$prefix)=@_;
- my $parser=HTML::TokeParser->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}=~/$newentry/) ||
- ($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;
+ next if ($entry =~ m/^(?:parameter|stores)_/);
+ if (defined($token->[2]->{'package'})) {
+ $unikey.="\0package\0".$token->[2]->{'package'};
+ }
+ if (defined($token->[2]->{'part'})) {
+ $unikey.="\0".$token->[2]->{'part'};
+ }
+ if (defined($token->[2]->{'id'})) {
+ $unikey.="\0".$token->[2]->{'id'};
+ }
+ if (defined($token->[2]->{'name'})) {
+ $unikey.="\0".$token->[2]->{'name'};
+ }
+ foreach (@{$token->[3]}) {
+ $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
+ if ($metadatakeys{$unikey}) {
+ $metadatakeys{$unikey}.=','.$_;
+ } else {
+ $metadatakeys{$unikey}=$_;
+ }
+ }
+ my $newentry=$parser->get_text('/'.$entry);
+ if (($entry eq 'customdistributionfile') ||
+ ($entry eq 'sourcerights')) {
+ $newentry=~s/^\s*//;
+ if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
+ }
+# actually store
+ if ( $entry eq 'rule' && exists($metadatafields{$unikey})) {
+ $metadatafields{$unikey}.=','.$newentry;
+ } else {
+ $metadatafields{$unikey}=$newentry;
+ }
+ }
+ }
}
-# -------------------------------------------------------- Read a metadata file
+#########################################
+#########################################
+
+=pod
+
+=item B
+
+Read a metadata file
+
+Parameters:
+
+=over
+
+=item I<$logfile>
+
+File output stream to output errors and warnings to.
+
+=item I<$fn>
+
+File name (including path).
+
+=back
+
+Returns:
+
+=over 4
+
+=item Scalar string (if successful)
+
+XHTML text that indicates successful reading of the metadata.
+
+=back
+
+=cut
+
+#########################################
+#########################################
sub metaread {
- my ($logfile,$fn)=@_;
+ my ($logfile,$fn,$prefix)=@_;
unless (-e $fn) {
- print $logfile 'No file '.$fn."\n";
- return ' No file:'.$fn.'';
+ print($logfile 'No file '.$fn."\n");
+ return ' '.&mt('No file').':'.
+ &Apache::loncfile::display($fn).'';
}
- print $logfile 'Processing '.$fn."\n";
+ print($logfile 'Processing '.$fn."\n");
my $metastring;
{
- my $metafh=Apache::File->new($fn);
- $metastring=join('',<$metafh>);
+ my $metafh=Apache::File->new($fn);
+ $metastring=join('',<$metafh>);
}
- &metaeval($metastring);
- return ' Processed file:'.$fn.'';
+ &metaeval($metastring,$prefix);
+ return ' '.&mt('Processed file').':'.
+ &Apache::loncfile::display($fn).' ';
}
-# ---------------------------- convert 'time' format into a datetime sql format
-sub sqltime {
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
- localtime(@_[0]);
- $mon++; $year+=1900;
- return "$year-$mon-$mday $hour:$min:$sec";
+#########################################
+#########################################
+
+sub coursedependencies {
+ my $url=&Apache::lonnet::declutter(shift);
+ $url=~s/\.meta$//;
+ my ($adomain,$aauthor)=($url=~ m{^($match_domain)/($match_username)/});
+ my $regexp=quotemeta($url);
+ $regexp='___'.$regexp.'___course';
+ my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
+ $aauthor,$regexp);
+ my %courses=();
+ foreach (keys %evaldata) {
+ if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {
+ $courses{$1}=1;
+ }
+ }
+ return %courses;
}
+#########################################
+#########################################
+
+
+=pod
-# --------------------------------------------------------- Various form fields
+=item Form-field-generating subroutines.
+For input parameters, these subroutines take in values
+such as I<$name>, I<$value> and other form field metadata.
+The output (scalar string that is returned) is an XHTML
+string which presents the form field (foreseeably inside
+ tags).
+
+=over 4
+
+=item B
+
+=item B
+
+=item B
+
+=back
+
+=cut
+
+#########################################
+#########################################
sub textfield {
my ($title,$name,$value)=@_;
- return "\n
');
+ print $logfile "\nRemoving error messages: $delresult";
+# ----------------------------------------------------------- Copy old versions
+
+ if (-e $target) {
+ my $filename;
+ my $maxversion=0;
+ $target=~/(.*)\/([^\/]+)\.(\w+)$/;
+ my $srcf=$2;
+ my $srct=$3;
+ my $srcd=$1;
+ unless ($srcd=~/^\/home\/httpd\/html\/res/) {
+ print $logfile "\nPANIC: Target dir is ".$srcd;
+ $r->print(
+ "".&mt('Invalid target directory, FAIL')."");
+ return 0;
+ }
+ opendir(DIR,$srcd);
+ while ($filename=readdir(DIR)) {
+ if (-l $srcd.'/'.$filename) {
+ unlink($srcd.'/'.$filename);
+ unlink($srcd.'/'.$filename.'.meta');
+ } else {
+ if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {
+ $maxversion=($1>$maxversion)?$1:$maxversion;
+ }
+ }
+ }
+ closedir(DIR);
+ $maxversion++;
+ $r->print('
Creating old version '.$maxversion.'
');
+ print $logfile "\nCreating old version ".$maxversion."\n";
+
+ my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
+
if (copy($target,$copyfile)) {
print $logfile "Copied old target to ".$copyfile."\n";
- $scrout.='
Copied old target file';
+ $r->print('
'.&mt('Copied old target file').'
');
} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";
- return "Failed to copy old target, $!, FAIL";
+ $r->print("".&mt('Failed to copy old target').
+ ", $!, ".&mt('FAIL')."");
+ return 0;
}
-
+
# --------------------------------------------------------------- Copy Metadata
$copyfile=$copyfile.'.meta';
-
+
if (copy($target.'.meta',$copyfile)) {
print $logfile "Copied old target metadata to ".$copyfile."\n";
- $scrout.='
Copied old metadata';
+ $r->print('
'.&mt('Copied old metadata').'
')
} else {
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
if (-e $target.'.meta') {
- return
- "Failed to write old metadata copy, $!, FAIL";
+ $r->print(
+ "".
+&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."");
+ return 0;
}
}
-
-
-} else {
- $scrout.='
Back to Source Directory';
+ my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
+
+ $r->print('
'.&mt('Publishing').' '.$thisdisfn.'
');
+# phase one takes
+# my ($source,$target,$style,$batch)=@_;
+ my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1);
+ $r->print('
'.$outstring.'
');
+# phase two takes
+# my ($source,$target,$style,$distarget,batch)=@_;
+# $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...
+ if (!$error) {
+ $r->print('
');
-
- if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) {
- $r->print('
Co-Author: '.$cuname.' at '.$cudom.
- '
');
- }
-
- if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
- $r->print(' Diffs with Current Version
');
- }
-
-# ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
+A basic outline of the handler subroutine follows.
- unless ($ENV{'form.phase'} eq 'two') {
- $r->print(
- '
'.&publish($thisfn,$thistarget,$thisembstyle));
- } else {
- $r->print(
- ''.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget));
- }
+=over 4
- }
- $r->print('');
+=item *
- return OK;
-}
+Get query string for limited number of parameters.
-1;
-__END__
+=item *
-=head1 NAME
+Check filename.
-Apache::lonpublisher - Publication Handler
+=item *
-=head1 SYNOPSIS
+File is there and owned, init lookup tables.
-Invoked by /etc/httpd/conf/srm.conf:
+=item *
-
- PerlAccessHandler Apache::lonacc
- SetHandler perl-script
- PerlHandler Apache::lonpublisher
- ErrorDocument 403 /adm/login
- ErrorDocument 404 /adm/notfound.html
- ErrorDocument 406 /adm/unauthorized.html
- ErrorDocument 500 /adm/errorhandler
-
+Start page output.
-=head1 INTRODUCTION
+=item *
-This module publishes a file. This involves gathering metadata,
-versioning the file, copying file from construction space to
-publication space, and copying metadata from construction space
-to publication space.
+Evaluate individual file, and then output information.
-This is part of the LearningOnline Network with CAPA project
-described at http://www.lon-capa.org.
+=item *
-=head1 HANDLER SUBROUTINE
+Publishing from $thisfn to $thistarget with $thisembstyle.
-This routine is called by Apache and mod_perl.
+=back
-=over 4
+=cut
-=item *
+#########################################
+#########################################
+sub handler {
+ my $r=shift;
-Get query string for limited number of parameters
+ if ($r->header_only) {
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ return OK;
+ }
-=item *
+# Get query string for limited number of parameters
-Check filename
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['filename']);
-=item *
+# -------------------------------------- Flag and buffer for registered cleanup
+ $registered_cleanup=0;
+ @{$modified_urls}=();
+# -------------------------------------------------------------- Check filename
-File is there and owned, init lookup tables
+ my $fn=&unescape($env{'form.filename'});
-=item *
+ ($cuname,$cudom)=
+ &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
-Start page output
+# special publication: default.meta file
+ if ($fn=~/\/default.meta$/) {
+ return &defaultmetapublish($r,$fn,$cuname,$cudom);
+ }
+ $fn=~s/\.meta$//;
+
+ unless ($fn) {
+ $r->log_reason($cuname.' at '.$cudom.
+ ' trying to publish empty filename', $r->filename);
+ return HTTP_NOT_FOUND;
+ }
+
+ 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;
+ }
-=item *
+ my $home=&Apache::lonnet::homeserver($cuname,$cudom);
+ my $allowed=0;
+ my @ids=&Apache::lonnet::current_machine_ids();
+ foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; } }
+ unless ($allowed) {
+ $r->log_reason($cuname.' at '.$cudom.
+ ' trying to publish file '.$env{'form.filename'}.
+ ' ('.$fn.') - not homeserver ('.$home.')',
+ $r->filename);
+ return HTTP_NOT_ACCEPTABLE;
+ }
-Individual file
+ $fn=~s{^http://[^/]+}{};
+ $fn=~s{^/~($match_username)}{/home/$1/public_html};
-=item *
+ 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;
+ }
-publish from $thisfn to $thistarget with $thisembstyle
+# -------------------------------- File is there and owned, init lookup tables.
-=back
+ %addid=();
+
+ {
+ my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
+ while (<$fh>=~/(\w+)\s+(\w+)/) {
+ $addid{$1}=$2;
+ }
+ }
-=head1 OTHER SUBROUTINES
+ %nokey=();
-=over 4
+ {
+ my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
+ while (<$fh>) {
+ my $word=$_;
+ chomp($word);
+ $nokey{$word}=1;
+ }
+ }
-=item *
+# ---------------------------------------------------------- Start page output.
-metaeval() : Evaluate string with metadata
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+
+ my $js='';
+ $r->print(&Apache::loncommon::start_page('Resource Publication',$js));
-=item *
-metaread() : Read a metadata file
+ my $thisfn=$fn;
-=item *
+ my $thistarget=$thisfn;
+
+ $thistarget=~s/^\/home/$targetdir/;
+ $thistarget=~s/\/public\_html//;
-sqltime() : convert 'time' format into a datetime sql format
+ my $thisdistarget=$thistarget;
+ $thisdistarget=~s/^\Q$docroot\E//;
-=item *
+ my $thisdisfn=$thisfn;
+ $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;
-textfield() : form field
+ if ($fn=~/\/$/) {
+# -------------------------------------------------------- This is a directory
+ &publishdirectory($r,$fn,$thisdisfn);
+ $r->print(''.&mt('Return to Directory').'');
-=item *
-hiddenfield() : form field
+ } else {
+# ---------------------- Evaluate individual file, and then output information.
+ $thisfn=~/\.(\w+)$/;
+ my $thistype=$1;
+ my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
+ if ($thistype eq 'page') { $thisembstyle = 'rat'; }
+
+ $r->print('
'.&mt('Publishing [_1]',''.$thisdisfn.'').'
');
+
+ $r->print('
'.&mt('Resource Details').'
');
+
+ $r->print(&Apache::lonhtmlcommon::start_pick_box());
+
+ $r->print(&Apache::lonhtmlcommon::row_title(&mt('Type'))
+ .&Apache::loncommon::filedescription($thistype)
+ .&Apache::lonhtmlcommon::row_closure()
+ );
+
+ $r->print(&Apache::lonhtmlcommon::row_title(&mt('Link to Resource'))
+ .''
+ );
+ $r->print(<
+$thisdisfn
+ENDCAPTION
+ $r->print(''
+ .&Apache::lonhtmlcommon::row_closure()
+ );
+
+ $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))
+ .''.$thisdistarget.''
+ .&Apache::lonhtmlcommon::row_closure()
+ );
+
+# SB - ToDo:
+ if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {
+# $r->print(&Apache::lonhtmlcommon::row_title(''.&mt('Co-Author').'')
+ $r->print(&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))
+ .''
+ .&mt('[_1] at [_2]',$cuname,$cudom)
+ .''
+ .&Apache::lonhtmlcommon::row_closure()
+ );
+ }
-=item *
+ if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
+ $r->print(&Apache::lonhtmlcommon::row_title(&mt('Diffs')));
+ $r->print(<
+ENDDIFF
+ $r->print(&mt('Diffs with Current Version').''
+ .&Apache::lonhtmlcommon::row_closure()
+ );
-selectbox() : form field
+ }
-=item *
+ $r->print(&Apache::lonhtmlcommon::end_pick_box());
+
+# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.
-urlfixup() : fixup URL (Publication Step One)
+ unless ($env{'form.phase'} eq 'two') {
+# ---------------------------------------------------------- Parse for problems
+ my ($warningcount,$errorcount);
+ if ($thisembstyle eq 'ssi') {
+ ($warningcount,$errorcount)=&checkonthis($r,$thisfn);
+ }
+ unless ($errorcount) {
+ my ($outstring,$error)=
+ &publish($thisfn,$thistarget,$thisembstyle);
+ $r->print(''.$outstring);
+ } else {
+ $r->print('
'.
+ &mt('The document contains errors and cannot be published.').
+ '