--- loncom/publisher/lonpublisher.pm 2002/01/08 21:14:53 1.68
+++ loncom/publisher/lonpublisher.pm 2002/08/09 19:49:30 1.92
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.68 2002/01/08 21:14:53 albertel Exp $
+# $Id: lonpublisher.pm,v 1.92 2002/08/09 19:49:30 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -43,6 +43,9 @@
# 12/06,12/07 Gerd Kortemeyer
# 12/15,12/16 Scott Harrison
# 12/25 Gerd Kortemeyer
+# YEAR=2002
+# 1/16,1/17 Scott Harrison
+# 1/17 Gerd Kortemeyer
#
###
@@ -58,6 +61,43 @@
## ##
###############################################################################
+
+######################################################################
+######################################################################
+
+=pod
+
+=head1 Name
+
+lonpublisher - LON-CAPA publishing handler
+
+=head1 Synopsis
+
+lonpublisher takes the proper steps to add resources to the LON-CAPA
+digital library. This includes updating the metadata table in the
+LON-CAPA database.
+
+=head1 Description
+
+lonpublisher is many things to many people.
+To all people it is woefully documented.
+This documentation conforms to this standard.
+
+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 Internal Functions
+
+=over 4
+
+=cut
+
+######################################################################
+######################################################################
+
+
package Apache::lonpublisher;
# ------------------------------------------------- modules used by this module
@@ -65,13 +105,14 @@ 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::loncommon();
+use Apache::lonmysql;
my %addid;
my %nokey;
@@ -84,11 +125,23 @@ my $docroot;
my $cuname;
my $cudom;
-# ----------------------------------------------- Evaluate string with metadata
+#########################################
+#########################################
+
+=pod
+
+=item metaeval
+
+Evaluate string with metadata
+
+=cut
+
+#########################################
+#########################################
sub metaeval {
my $metastring=shift;
- my $parser=HTML::TokeParser->new(\$metastring);
+ my $parser=HTML::LCParser->new(\$metastring);
my $token;
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
@@ -127,7 +180,19 @@ sub metaeval {
}
}
-# -------------------------------------------------------- Read a metadata file
+#########################################
+#########################################
+
+=pod
+
+=item metaread
+
+Read a metadata file
+
+=cut
+
+#########################################
+#########################################
sub metaread {
my ($logfile,$fn)=@_;
unless (-e $fn) {
@@ -144,16 +209,49 @@ sub metaread {
return ' Processed file:'.$fn.'';
}
-# ---------------------------- convert 'time' format into a datetime sql format
+#########################################
+#########################################
+
+=pod
+
+=item sqltime
+
+Convert 'time' format into a datetime sql format
+
+=cut
+
+#########################################
+#########################################
sub sqltime {
+ my $timef=shift @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
- localtime(@_[0]);
+ localtime($timef);
$mon++; $year+=1900;
return "$year-$mon-$mday $hour:$min:$sec";
}
-# --------------------------------------------------------- Various form fields
+#########################################
+#########################################
+
+=pod
+
+=item Form field generating functions
+
+=over 4
+
+=item textfield
+
+=item hiddenfield
+
+=item selectbox
+
+=back
+
+=cut
+
+#########################################
+#########################################
sub textfield {
my ($title,$name,$value)=@_;
return "\n
$title: ".
@@ -180,13 +278,25 @@ sub selectbox {
return $selout.'';
}
-# -------------------------------------------------------- Publication Step One
+#########################################
+#########################################
+
+=pod
+
+=item urlfixup
+Fix up a url? First step of publication
+
+=cut
+
+#########################################
+#########################################
sub urlfixup {
my ($url,$target)=@_;
unless ($url) { return ''; }
#javascript code needs no fixing
if ($url =~ /^javascript:/i) { return $url; }
+ if ($url =~ /^mailto:/i) { return $url; }
#internal document links need no fixing
if ($url =~ /^\#/) { return $url; }
my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
@@ -198,6 +308,25 @@ sub urlfixup {
}
if ($url=~/^http\:\/\//) { return $url; }
$url=~s/\~$cuname/res\/$cudom\/$cuname/;
+ return $url;
+}
+
+#########################################
+#########################################
+
+=pod
+
+=item absoluteurl
+
+Currently undocumented
+
+=cut
+
+#########################################
+#########################################
+sub absoluteurl {
+ my ($url,$target)=@_;
+ unless ($url) { return ''; }
if ($target) {
$target=~s/\/[^\/]+$//;
$url=&Apache::lonnet::hreflocation($target,$url);
@@ -205,6 +334,390 @@ sub urlfixup {
return $url;
}
+#########################################
+#########################################
+
+=pod
+
+=item set_allow
+
+Currently undocumented
+
+=cut
+
+#########################################
+#########################################
+sub set_allow {
+ my ($allow,$logfile,$target,$tag,$oldurl)=@_;
+ my $newurl=&urlfixup($oldurl,$target);
+ my $return_url=$oldurl;
+ print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
+ if ($newurl ne $oldurl) {
+ $return_url=$newurl;
+ print $logfile 'URL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
+ }
+ if (($newurl !~ /^javascript:/i) &&
+ ($newurl !~ /^mailto:/i) &&
+ ($newurl !~ /^http:/i) &&
+ ($newurl !~ /^\#/)) {
+ $$allow{&absoluteurl($newurl,$target)}=1;
+ }
+ return $return_url
+}
+
+#########################################
+#########################################
+
+=pod
+
+=item get_subscribed_hosts
+
+Currently undocumented
+
+=cut
+
+#########################################
+#########################################
+sub get_subscribed_hosts {
+ my ($target)=@_;
+ my @subscribed;
+ my $filename;
+ $target=~/(.*)\/([^\/]+)$/;
+ my $srcf=$2;
+ opendir(DIR,$1);
+ while ($filename=readdir(DIR)) {
+ if ($filename=~/$srcf\.(\w+)$/) {
+ my $subhost=$1;
+ if ($subhost ne 'meta' && $subhost ne 'subscription') {
+ push(@subscribed,$subhost);
+ }
+ }
+ }
+ closedir(DIR);
+ my $sh;
+ if ( $sh=Apache::File->new("$target.subscription") ) {
+ &Apache::lonnet::logthis("opened $target.subscription");
+ while (my $subline=<$sh>) {
+ &Apache::lonnet::logthis("Trying $subline");
+ if ($subline =~ /(^\w+):/) { push(@subscribed,$1); } else {
+ &Apache::lonnet::logthis("No Match for $subline");
+ }
+ }
+ } else {
+ &Apache::lonnet::logthis("Un able to open $target.subscription");
+ }
+ &Apache::lonnet::logthis("Got list of ".join(':',@subscribed));
+ return @subscribed;
+}
+
+
+#########################################
+#########################################
+
+=pod
+
+=item get_max_ids_indices
+
+Currently undocumented
+
+=cut
+
+#########################################
+#########################################
+sub get_max_ids_indices {
+ my ($content)=@_;
+ my $maxindex=10;
+ my $maxid=10;
+ my $needsfixup=0;
+
+ my $parser=HTML::LCParser->new($content);
+ my $token;
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'S') {
+ my $counter;
+ if ($counter=$addid{$token->[1]}) {
+ if ($counter eq 'id') {
+ if (defined($token->[2]->{'id'})) {
+ $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
+ } else {
+ $needsfixup=1;
+ }
+ } else {
+ if (defined($token->[2]->{'index'})) {
+ $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
+ } else {
+ $needsfixup=1;
+ }
+ }
+ }
+ }
+ }
+ return ($needsfixup,$maxid,$maxindex);
+}
+
+#########################################
+#########################################
+
+=pod
+
+=item get_all_text_unbalanced
+
+Currently undocumented
+
+=cut
+
+#########################################
+#########################################
+sub get_all_text_unbalanced {
+ #there is a copy of this in lonxml.pm
+ my($tag,$pars)= @_;
+ my $token;
+ my $result='';
+ $tag='<'.$tag.'>';
+ while ($token = $$pars[-1]->get_token) {
+ if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
+ $result.=$token->[1];
+ } elsif ($token->[0] eq 'PI') {
+ $result.=$token->[2];
+ } elsif ($token->[0] eq 'S') {
+ $result.=$token->[4];
+ } elsif ($token->[0] eq 'E') {
+ $result.=$token->[2];
+ }
+ if ($result =~ /(.*)$tag(.*)/) {
+ #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
+ #&Apache::lonnet::logthis('Result is :'.$1);
+ $result=$1;
+ my $redo=$tag.$2;
+ push (@$pars,HTML::LCParser->new(\$redo));
+ $$pars[-1]->xml_mode('1');
+ last;
+ }
+ }
+ return $result
+}
+
+#########################################
+#########################################
+
+=pod
+
+=item fix_ids_and_indices
+
+Currently undocumented
+
+=cut
+
+#########################################
+#########################################
+#Arguably this should all be done as a lonnet::ssi instead
+sub fix_ids_and_indices {
+ my ($logfile,$source,$target)=@_;
+
+ my %allow;
+ my $content;
+ {
+ my $org=Apache::File->new($source);
+ $content=join('',<$org>);
+ }
+
+ my ($needsfixup,$maxid,$maxindex)=&get_max_ids_indices(\$content);
+
+ if ($needsfixup) {
+ print $logfile "Needs ID and/or index fixup\n".
+ "Max ID : $maxid (min 10)\n".
+ "Max Index: $maxindex (min 10)\n";
+ }
+ my $outstring='';
+ my @parser;
+ $parser[0]=HTML::LCParser->new(\$content);
+ $parser[-1]->xml_mode(1);
+ my $token;
+ while (@parser) {
+ while ($token=$parser[-1]->get_token) {
+ if ($token->[0] eq 'S') {
+ my $counter;
+ my $tag=$token->[1];
+ my $lctag=lc($tag);
+ if ($lctag eq 'allow') {
+ $allow{$token->[2]->{'src'}}=1;
+ next;
+ }
+ my %parms=%{$token->[2]};
+ $counter=$addid{$tag};
+ if (!$counter) { $counter=$addid{$lctag}; }
+ if ($counter) {
+ if ($counter eq 'id') {
+ unless (defined($parms{'id'})) {
+ $maxid++;
+ $parms{'id'}=$maxid;
+ print $logfile 'ID: '.$tag.':'.$maxid."\n";
+ }
+ } elsif ($counter eq 'index') {
+ unless (defined($parms{'index'})) {
+ $maxindex++;
+ $parms{'index'}=$maxindex;
+ print $logfile 'Index: '.$tag.':'.$maxindex."\n";
+ }
+ }
+ }
+ foreach my $type ('src','href','background','bgimg') {
+ foreach my $key (keys(%parms)) {
+ if ($key =~ /^$type$/i) {
+ $parms{$key}=&set_allow(\%allow,$logfile,
+ $target,$tag,
+ $parms{$key});
+ }
+ }
+ }
+ # probably a image type