--- loncom/publisher/lonpublisher.pm 2000/11/29 19:52:34 1.3 +++ loncom/publisher/lonpublisher.pm 2000/11/30 10:11:47 1.4 @@ -5,7 +5,7 @@ # # 05/29/00,05/30,10/11 Gerd Kortemeyer) # -# 11/28,11/29 Gerd Kortemeyer +# 11/28,11/29,11/30 Gerd Kortemeyer package Apache::lonpublisher; @@ -13,12 +13,16 @@ use strict; use Apache::File; use Apache::Constants qw(:common :http :methods); use HTML::TokeParser; +use Apache::lonxml; my %addid; sub publish { + my ($source,$target,$style)=@_; my $logfile; + my $scrout=''; + unless ($logfile=Apache::File->new('>>'.$source.'.log')) { return 'No write permission to user directory, FAIL'; } @@ -27,6 +31,8 @@ sub publish { if (($style eq 'ssi') || ($style eq 'rat')) { # ------------------------------------------------------- This needs processing + +# ----------------------------------------------------------------- Backup Copy my $copyfile=$source.'.save'; { my $org=Apache::File->new($source); @@ -36,13 +42,113 @@ sub publish { if (-e $copyfile) { print $logfile "Copied original file to ".$copyfile."\n"; } else { + print $logfile "Unable to write backup ".$copyfile."\n"; return "Failed to write backup copy, FAIL"; } +# ------------------------------------------------------------- IDs and indices + + my $maxindex=10; + my $maxid=10; + my $content=''; + my $needsfixup=0; + + { + my $org=Apache::File->new($source); + $content=join('',<$org>); + } + { + my $parser=HTML::TokeParser->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; + } + } + } + } + } + } + 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=HTML::TokeParser->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'})) { + $outstring.=$token->[4]; + } else { + $maxid++; + my $thisid=' id="'.$maxid.'"'; + my $fixup=$token->[4]; + $fixup=~s/(\<\w+)/$1$thisid/; + $outstring.=$fixup; + print $logfile 'ID: '.$fixup."\n"; + } + } else { + if (defined($token->[2]->{'index'})) { + $outstring.=$token->[4]; + } else { + $maxindex++; + my $thisindex=' index="'.$maxindex.'"'; + my $fixup=$token->[4]; + $fixup=~s/(\<\w+)/$1$thisindex/; + $outstring.=$fixup; + print $logfile 'Index: '.$fixup."\n"; + } + } + } else { + $outstring.=$token->[4]; + } + } elsif ($token->[0] eq 'E') { + $outstring.=$token->[2]; + } else { + $outstring.=$token->[1]; + } + } + { + my $org; + unless ($org=Apache::File->new('>'.$source)) { + print $logfile "No write permit to $source\n"; + return "No write permission to $source, FAIL"; + } + print $org $outstring; + } + $content=$outstring; + print $logfile "End of ID and/or index fixup\n". + "Max ID : $maxid (min 10)\n". + "Max Index: $maxindex (min 10)\n"; + } else { + print $logfile "Does not need ID and/or index fixup\n"; + } +# -------------------------------------------------- Parse content for metadata + + my $allmeta=Apache::lonxml::xmlparse('meta',$content); + + $scrout=$allmeta; } - my $version=''; - - return 'Version '.$version.', SUCCESS'; + return $scrout; } # ================================================================ Main Handler @@ -66,6 +172,14 @@ sub handler { return HTTP_NOT_FOUND; } + unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) { + $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + ' trying to publish file '.$ENV{'form.filename'}. + ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')', + $r->filename); + return HTTP_NOT_ACCEPTABLE; + } + $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; my $targetdir='';