Annotation of loncom/publisher/lonpublisher.pm, revision 1.4
1.1 www 1: # The LearningOnline Network with CAPA
2: # Publication Handler
3: #
4: # (TeX Content Handler
5: #
6: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
7: #
1.4 ! www 8: # 11/28,11/29,11/30 Gerd Kortemeyer
1.1 www 9:
10: package Apache::lonpublisher;
11:
12: use strict;
13: use Apache::File;
1.2 www 14: use Apache::Constants qw(:common :http :methods);
15: use HTML::TokeParser;
1.4 ! www 16: use Apache::lonxml;
1.2 www 17:
1.3 www 18: my %addid;
19:
1.2 www 20: sub publish {
1.4 ! www 21:
1.2 www 22: my ($source,$target,$style)=@_;
23: my $logfile;
1.4 ! www 24: my $scrout='';
! 25:
1.2 www 26: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
27: return 'No write permission to user directory, FAIL';
28: }
29: print $logfile
30: "\n\n================== Publish ".localtime()." =================\n";
31:
1.3 www 32: if (($style eq 'ssi') || ($style eq 'rat')) {
33: # ------------------------------------------------------- This needs processing
1.4 ! www 34:
! 35: # ----------------------------------------------------------------- Backup Copy
1.3 www 36: my $copyfile=$source.'.save';
37: {
38: my $org=Apache::File->new($source);
39: my $cop=Apache::File->new('>'.$copyfile);
40: while (my $line=<$org>) { print $cop $line; }
41: }
42: if (-e $copyfile) {
43: print $logfile "Copied original file to ".$copyfile."\n";
44: } else {
1.4 ! www 45: print $logfile "Unable to write backup ".$copyfile."\n";
1.3 www 46: return "Failed to write backup copy, FAIL";
47: }
1.4 ! www 48: # ------------------------------------------------------------- IDs and indices
! 49:
! 50: my $maxindex=10;
! 51: my $maxid=10;
! 52: my $content='';
! 53: my $needsfixup=0;
! 54:
! 55: {
! 56: my $org=Apache::File->new($source);
! 57: $content=join('',<$org>);
! 58: }
! 59: {
! 60: my $parser=HTML::TokeParser->new(\$content);
! 61: my $token;
! 62: while ($token=$parser->get_token) {
! 63: if ($token->[0] eq 'S') {
! 64: my $counter;
! 65: if ($counter=$addid{$token->[1]}) {
! 66: if ($counter eq 'id') {
! 67: if (defined($token->[2]->{'id'})) {
! 68: $maxid=
! 69: ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
! 70: } else {
! 71: $needsfixup=1;
! 72: }
! 73: } else {
! 74: if (defined($token->[2]->{'index'})) {
! 75: $maxindex=
! 76: ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
! 77: } else {
! 78: $needsfixup=1;
! 79: }
! 80: }
! 81: }
! 82: }
! 83: }
! 84: }
! 85: if ($needsfixup) {
! 86: print $logfile "Needs ID and/or index fixup\n".
! 87: "Max ID : $maxid (min 10)\n".
! 88: "Max Index: $maxindex (min 10)\n";
! 89:
! 90: my $outstring='';
! 91: my $parser=HTML::TokeParser->new(\$content);
! 92: my $token;
! 93: while ($token=$parser->get_token) {
! 94: if ($token->[0] eq 'S') {
! 95: my $counter;
! 96: if ($counter=$addid{$token->[1]}) {
! 97: if ($counter eq 'id') {
! 98: if (defined($token->[2]->{'id'})) {
! 99: $outstring.=$token->[4];
! 100: } else {
! 101: $maxid++;
! 102: my $thisid=' id="'.$maxid.'"';
! 103: my $fixup=$token->[4];
! 104: $fixup=~s/(\<\w+)/$1$thisid/;
! 105: $outstring.=$fixup;
! 106: print $logfile 'ID: '.$fixup."\n";
! 107: }
! 108: } else {
! 109: if (defined($token->[2]->{'index'})) {
! 110: $outstring.=$token->[4];
! 111: } else {
! 112: $maxindex++;
! 113: my $thisindex=' index="'.$maxindex.'"';
! 114: my $fixup=$token->[4];
! 115: $fixup=~s/(\<\w+)/$1$thisindex/;
! 116: $outstring.=$fixup;
! 117: print $logfile 'Index: '.$fixup."\n";
! 118: }
! 119: }
! 120: } else {
! 121: $outstring.=$token->[4];
! 122: }
! 123: } elsif ($token->[0] eq 'E') {
! 124: $outstring.=$token->[2];
! 125: } else {
! 126: $outstring.=$token->[1];
! 127: }
! 128: }
! 129: {
! 130: my $org;
! 131: unless ($org=Apache::File->new('>'.$source)) {
! 132: print $logfile "No write permit to $source\n";
! 133: return "No write permission to $source, FAIL";
! 134: }
! 135: print $org $outstring;
! 136: }
! 137: $content=$outstring;
! 138: print $logfile "End of ID and/or index fixup\n".
! 139: "Max ID : $maxid (min 10)\n".
! 140: "Max Index: $maxindex (min 10)\n";
! 141: } else {
! 142: print $logfile "Does not need ID and/or index fixup\n";
! 143: }
! 144: # -------------------------------------------------- Parse content for metadata
! 145:
! 146: my $allmeta=Apache::lonxml::xmlparse('meta',$content);
! 147:
! 148: $scrout=$allmeta;
1.3 www 149:
150: }
1.4 ! www 151: return $scrout;
1.2 www 152: }
1.1 www 153:
154: # ================================================================ Main Handler
155:
156: sub handler {
157: my $r=shift;
1.2 www 158:
159: if ($r->header_only) {
160: $r->content_type('text/html');
161: $r->send_http_header;
162: return OK;
163: }
164:
165: # -------------------------------------------------------------- Check filename
166:
167: my $fn=$ENV{'form.filename'};
168:
169: unless ($fn) {
170: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
171: ' trying to publish empty filename', $r->filename);
172: return HTTP_NOT_FOUND;
173: }
1.4 ! www 174:
! 175: unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) {
! 176: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
! 177: ' trying to publish file '.$ENV{'form.filename'}.
! 178: ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')',
! 179: $r->filename);
! 180: return HTTP_NOT_ACCEPTABLE;
! 181: }
1.2 www 182:
183: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
184:
185: my $targetdir='';
186: my $docroot=$r->dir_config('lonDocRoot');
187: if ($1 ne $ENV{'user.name'}) {
188: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
189: ' trying to publish unowned file '.$ENV{'form.filename'}.
190: ' ('.$fn.')',
191: $r->filename);
192: return HTTP_NOT_ACCEPTABLE;
193: } else {
194: $targetdir=$docroot.'/res/'.$ENV{'user.domain'};
195: }
196:
197:
198: unless (-e $fn) {
199: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
200: ' trying to publish non-existing file '.$ENV{'form.filename'}.
201: ' ('.$fn.')',
202: $r->filename);
203: return HTTP_NOT_FOUND;
204: }
205:
206: # --------------------------------- File is there and owned, init lookup tables
207:
1.3 www 208: %addid=();
209:
210: {
211: my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
212: while (<$fh>=~/(\w+)\s+(\w+)/) {
213: $addid{$1}=$2;
214: }
215: }
1.2 www 216: # ----------------------------------------------------------- Start page output
217:
1.1 www 218: $r->content_type('text/html');
219: $r->send_http_header;
220:
221: $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
222: $r->print('<body bgcolor="#FFFFFF">');
1.2 www 223: my $thisfn=$fn;
224:
225: # ------------------------------------------------------------- Individual file
226: {
227: $thisfn=~/\.(\w+)$/;
228: my $thistype=$1;
229: my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);
230:
231: my $thistarget=$thisfn;
232:
233: $thistarget=~s/^\/home/$targetdir/;
234: $thistarget=~s/\/public\_html//;
235:
236: my $thisdistarget=$thistarget;
237: $thisdistarget=~s/^$docroot//;
238:
239: my $thisdisfn=$thisfn;
240: $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
241:
242: $r->print('<h2>Publishing '.
243: &Apache::lonnet::filedescription($thistype).' <tt>'.
244: $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
245:
246: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
247:
248: $r->print('<b>Result:</b> '.&publish($thisfn,$thistarget,$thisembstyle));
249:
250: }
251:
1.1 www 252: $r->print('</body></html>');
253:
254: return OK;
255: }
256:
257: 1;
258: __END__
259:
260:
261:
262:
263:
264:
265:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonpublisher.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / publisher