--- loncom/publisher/lonpublisher.pm 2001/12/15 18:15:27 1.65
+++ loncom/publisher/lonpublisher.pm 2008/08/14 13:39:02 1.245
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.65 2001/12/15 18:15:27 harris41 Exp $
+# $Id: lonpublisher.pm,v 1.245 2008/08/14 13:39:02 onken 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 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,270 @@ use strict;
use Apache::File;
use File::Copy;
use Apache::Constants qw(:common :http :methods);
-use HTML::TokeParser;
+use HTML::LCParser;
+use HTML::Entities;
+use Encode::Encoder;
use Apache::lonxml;
-use Apache::lonhomework;
use Apache::loncacc;
use DBI;
-use Apache::lonnet();
+use Apache::lonnet;
use Apache::loncommon();
+use Apache::lonhtmlcommon;
+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
';
+ if ($colcount>=10) {
+ $keywordout.=&Apache::loncommon::end_data_table_row()
+ .&Apache::loncommon::start_data_table_row();
+ $colcount=0;
+ }
+ }
+ # Proper end of started table row:
+ if ($colcount != 0) { # has still to be improved: if amount of keywords mod 10 == 0, then do not start another table row
+ while ($colcount<10) {
+ $keywordout.='
';
+ $colcount++;
+ }
+ }
- my $keywordout='
Keywords:
';
- my $colcount=0;
-
- if (length($content)<500000) {
- my $textonly=$content;
- $textonly=~s/\';
+ $r->print(&Apache::loncommon::start_page('Resource Publication',$js));
-}
-# ----------------------------------------------------------- Start page output
+ my $thisfn=$fn;
- $r->content_type('text/html');
- $r->send_http_header;
+ my $thistarget=$thisfn;
+
+ $thistarget=~s/^\/home/$targetdir/;
+ $thistarget=~s/\/public\_html//;
- $r->print('LON-CAPA Publishing');
- $r->print(
- '');
- my $thisfn=$fn;
-
-# ------------------------------------------------------------- Individual file
- {
- $thisfn=~/\.(\w+)$/;
- my $thistype=$1;
- my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
+ my $thisdistarget=$thistarget;
+ $thisdistarget=~s/^\Q$docroot\E//;
- my $thistarget=$thisfn;
-
- $thistarget=~s/^\/home/$targetdir/;
- $thistarget=~s/\/public\_html//;
+ my $thisdisfn=$thisfn;
+ $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;
- my $thisdistarget=$thistarget;
- $thisdistarget=~s/^$docroot//;
+ if ($fn=~/\/$/) {
+# -------------------------------------------------------- This is a directory
+ &publishdirectory($r,$fn,$thisdisfn);
+ $r->print(''.&mt('Return to Directory').'');
- my $thisdisfn=$thisfn;
- $thisdisfn=~s/^\/home\/$cuname\/public_html\///;
- $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
+ } 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('