Annotation of loncom/publisher/lonpublisher.pm, revision 1.26
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.15 www 8: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
1.20 www 9: # 03/23 Guy Albertelli
1.23 www 10: # 03/24,03/29,04/03 Gerd Kortemeyer
1.24 harris41 11: # 04/16/2001 Scott Harrison
1.26 ! www 12: # 05/03 Gerd Kortemeyer
1.1 www 13:
14: package Apache::lonpublisher;
15:
16: use strict;
17: use Apache::File;
1.13 www 18: use File::Copy;
1.2 www 19: use Apache::Constants qw(:common :http :methods);
20: use HTML::TokeParser;
1.4 www 21: use Apache::lonxml;
1.17 albertel 22: use Apache::lonhomework;
1.24 harris41 23: use DBI;
1.2 www 24:
1.3 www 25: my %addid;
1.5 www 26: my %nokey;
1.9 www 27: my %language;
1.10 www 28: my %cprtag;
29:
1.7 www 30: my %metadatafields;
31: my %metadatakeys;
32:
1.12 www 33: my $docroot;
34:
35: # ----------------------------------------------- Evaluate string with metadata
36:
1.7 www 37: sub metaeval {
38: my $metastring=shift;
39:
40: my $parser=HTML::TokeParser->new(\$metastring);
41: my $token;
42: while ($token=$parser->get_token) {
43: if ($token->[0] eq 'S') {
44: my $entry=$token->[1];
45: my $unikey=$entry;
46: if (defined($token->[2]->{'part'})) {
47: $unikey.='_'.$token->[2]->{'part'};
48: }
49: if (defined($token->[2]->{'name'})) {
50: $unikey.='_'.$token->[2]->{'name'};
51: }
52: map {
53: $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
54: if ($metadatakeys{$unikey}) {
55: $metadatakeys{$unikey}.=','.$_;
56: } else {
57: $metadatakeys{$unikey}=$_;
58: }
59: } @{$token->[3]};
60: if ($metadatafields{$unikey}) {
1.8 www 61: my $newentry=$parser->get_text('/'.$entry);
62: unless ($metadatafields{$unikey}=~/$newentry/) {
63: $metadatafields{$unikey}.=', '.$newentry;
64: }
1.7 www 65: } else {
66: $metadatafields{$unikey}=$parser->get_text('/'.$entry);
67: }
68: }
69: }
70: }
71:
1.12 www 72: # -------------------------------------------------------- Read a metadata file
73:
1.7 www 74: sub metaread {
75: my ($logfile,$fn)=@_;
76: unless (-e $fn) {
77: print $logfile 'No file '.$fn."\n";
78: return '<br><b>No file:</b> <tt>'.$fn.'</tt>';
79: }
80: print $logfile 'Processing '.$fn."\n";
81: my $metastring;
82: {
83: my $metafh=Apache::File->new($fn);
84: $metastring=join('',<$metafh>);
85: }
86: &metaeval($metastring);
87: return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';
88: }
89:
1.25 harris41 90: # ---------------------------- convert 'time' format into a datetime sql format
91: sub sqltime {
92: my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
93: localtime(@_[0]);
94: $mon++; $year+=1900;
95: return "$year-$mon-$mday $hour:$min:$sec";
96: }
97:
1.12 www 98: # --------------------------------------------------------- Various form fields
99:
1.8 www 100: sub textfield {
1.10 www 101: my ($title,$name,$value)=@_;
1.8 www 102: return "\n<p><b>$title:</b><br>".
1.11 www 103: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
104: }
105:
106: sub hiddenfield {
107: my ($name,$value)=@_;
108: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
1.8 www 109: }
110:
1.9 www 111: sub selectbox {
1.10 www 112: my ($title,$name,$value,%options)=@_;
113: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
114: map {
115: $selout.='<option value="'.$_.'"';
116: if ($_ eq $value) { $selout.=' selected'; }
117: $selout.='>'.$options{$_}.'</option>';
118: } sort keys %options;
119: return $selout.'</select>';
1.9 www 120: }
121:
1.12 www 122: # -------------------------------------------------------- Publication Step One
123:
1.2 www 124: sub publish {
1.4 www 125:
1.2 www 126: my ($source,$target,$style)=@_;
127: my $logfile;
1.4 www 128: my $scrout='';
1.23 www 129: my $allmeta='';
130: my $content='';
1.4 www 131:
1.2 www 132: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
1.7 www 133: return
134: '<font color=red>No write permission to user directory, FAIL</font>';
1.2 www 135: }
136: print $logfile
1.11 www 137: "\n\n================= Publish ".localtime()." Phase One ================\n";
1.2 www 138:
1.3 www 139: if (($style eq 'ssi') || ($style eq 'rat')) {
140: # ------------------------------------------------------- This needs processing
1.4 www 141:
142: # ----------------------------------------------------------------- Backup Copy
1.3 www 143: my $copyfile=$source.'.save';
1.13 www 144: if (copy($source,$copyfile)) {
1.3 www 145: print $logfile "Copied original file to ".$copyfile."\n";
146: } else {
1.13 www 147: print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
148: return "<font color=red>Failed to write backup copy, $!,FAIL</font>";
1.3 www 149: }
1.4 www 150: # ------------------------------------------------------------- IDs and indices
151:
152: my $maxindex=10;
153: my $maxid=10;
1.23 www 154:
1.4 www 155: my $needsfixup=0;
156:
157: {
158: my $org=Apache::File->new($source);
159: $content=join('',<$org>);
160: }
161: {
162: my $parser=HTML::TokeParser->new(\$content);
163: my $token;
164: while ($token=$parser->get_token) {
165: if ($token->[0] eq 'S') {
166: my $counter;
167: if ($counter=$addid{$token->[1]}) {
168: if ($counter eq 'id') {
169: if (defined($token->[2]->{'id'})) {
170: $maxid=
171: ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
172: } else {
173: $needsfixup=1;
174: }
175: } else {
176: if (defined($token->[2]->{'index'})) {
177: $maxindex=
178: ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
179: } else {
180: $needsfixup=1;
181: }
182: }
183: }
184: }
185: }
186: }
187: if ($needsfixup) {
188: print $logfile "Needs ID and/or index fixup\n".
189: "Max ID : $maxid (min 10)\n".
190: "Max Index: $maxindex (min 10)\n";
191:
192: my $outstring='';
193: my $parser=HTML::TokeParser->new(\$content);
194: my $token;
195: while ($token=$parser->get_token) {
196: if ($token->[0] eq 'S') {
197: my $counter;
198: if ($counter=$addid{$token->[1]}) {
199: if ($counter eq 'id') {
200: if (defined($token->[2]->{'id'})) {
201: $outstring.=$token->[4];
202: } else {
203: $maxid++;
204: my $thisid=' id="'.$maxid.'"';
205: my $fixup=$token->[4];
206: $fixup=~s/(\<\w+)/$1$thisid/;
207: $outstring.=$fixup;
208: print $logfile 'ID: '.$fixup."\n";
209: }
210: } else {
211: if (defined($token->[2]->{'index'})) {
212: $outstring.=$token->[4];
213: } else {
214: $maxindex++;
215: my $thisindex=' index="'.$maxindex.'"';
216: my $fixup=$token->[4];
217: $fixup=~s/(\<\w+)/$1$thisindex/;
218: $outstring.=$fixup;
219: print $logfile 'Index: '.$fixup."\n";
220: }
221: }
222: } else {
223: $outstring.=$token->[4];
224: }
225: } elsif ($token->[0] eq 'E') {
226: $outstring.=$token->[2];
227: } else {
228: $outstring.=$token->[1];
229: }
230: }
231: {
232: my $org;
233: unless ($org=Apache::File->new('>'.$source)) {
234: print $logfile "No write permit to $source\n";
1.7 www 235: return
236: "<font color=red>No write permission to $source, FAIL</font>";
1.4 www 237: }
238: print $org $outstring;
239: }
240: $content=$outstring;
241: print $logfile "End of ID and/or index fixup\n".
242: "Max ID : $maxid (min 10)\n".
243: "Max Index: $maxindex (min 10)\n";
244: } else {
245: print $logfile "Does not need ID and/or index fixup\n";
246: }
1.7 www 247:
248: # --------------------------------------------- Initial step done, now metadata
249:
250: # ---------------------------------------- Storage for metadata keys and fields
251:
1.8 www 252: %metadatafields=();
253: %metadatakeys=();
254:
255: my %oldparmstores=();
1.7 www 256:
257: # ------------------------------------------------ First, check out environment
1.8 www 258: unless (-e $source.'.meta') {
1.7 www 259: $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
260: $ENV{'environment.middlename'}.' '.
261: $ENV{'environment.lastname'}.' '.
262: $ENV{'environment.generation'};
1.8 www 263: $metadatafields{'author'}=~s/\s+/ /g;
264: $metadatafields{'author'}=~s/\s+$//;
1.10 www 265: $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
1.7 www 266:
267: # ------------------------------------------------ Check out directory hierachy
268:
269: my $thisdisfn=$source;
270: $thisdisfn=~s/^\/home\/$ENV{'user.name'}\///;
271:
272: my @urlparts=split(/\//,$thisdisfn);
273: $#urlparts--;
274:
275: my $currentpath='/home/'.$ENV{'user.name'}.'/';
276:
277: map {
278: $currentpath.=$_.'/';
279: $scrout.=&metaread($logfile,$currentpath.'default.meta');
280: } @urlparts;
281:
282: # ------------------- Clear out parameters and stores (there should not be any)
283:
284: map {
285: if (($_=~/^parameter/) || ($_=~/^stores/)) {
286: delete $metadatafields{$_};
287: }
288: } keys %metadatafields;
289:
1.8 www 290: } else {
1.7 www 291: # ---------------------- Read previous metafile, remember parameters and stores
292:
293: $scrout.=&metaread($logfile,$source.'.meta');
294:
295: map {
296: if (($_=~/^parameter/) || ($_=~/^stores/)) {
297: $oldparmstores{$_}=1;
298: delete $metadatafields{$_};
299: }
300: } keys %metadatafields;
301:
1.8 www 302: }
1.7 www 303:
1.4 www 304: # -------------------------------------------------- Parse content for metadata
305:
1.23 www 306: $allmeta=Apache::lonxml::xmlparse('meta',$content);
1.19 albertel 307: &metaeval($allmeta);
1.7 www 308:
309: # ---------------- Find and document discrepancies in the parameters and stores
310:
311: my $chparms='';
312: map {
313: if (($_=~/^parameter/) || ($_=~/^stores/)) {
314: unless ($_=~/\.\w+$/) {
315: unless ($oldparmstores{$_}) {
316: print $logfile 'New: '.$_."\n";
317: $chparms.=$_.' ';
318: }
319: }
320: }
321: } sort keys %metadatafields;
322: if ($chparms) {
323: $scrout.='<p><b>New parameters or stored values:</b> '.
324: $chparms;
325: }
326:
327: my $chparms='';
328: map {
329: if (($_=~/^parameter/) || ($_=~/^stores/)) {
1.12 www 330: unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) {
1.7 www 331: print $logfile 'Obsolete: '.$_."\n";
332: $chparms.=$_.' ';
333: }
334: }
335: } sort keys %oldparmstores;
336: if ($chparms) {
337: $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
338: $chparms;
339: }
1.23 www 340: }
1.8 www 341: # ------------------------------------------------------- Now have all metadata
1.5 www 342:
1.8 www 343: $scrout.=
344: '<form action="/adm/publish" method="post">'.
1.11 www 345: &hiddenfield('phase','two').
346: &hiddenfield('filename',$ENV{'form.filename'}).
347: &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
1.10 www 348: &textfield('Title','title',$metadatafields{'title'}).
349: &textfield('Author(s)','author',$metadatafields{'author'}).
350: &textfield('Subject','subject',$metadatafields{'subject'});
1.5 www 351:
352: # --------------------------------------------------- Scan content for keywords
1.7 www 353:
1.8 www 354: my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
1.7 www 355: my $colcount=0;
356:
1.5 www 357: {
358: my $textonly=$content;
359: $textonly=~s/\<script[^\<]+\<\/script\>//g;
360: $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
361: $textonly=~s/\<[^\>]*\>//g;
362: $textonly=~tr/A-Z/a-z/;
363: $textonly=~s/[\$\&][a-z]\w*//g;
364: $textonly=~s/[^a-z\s]//g;
365:
366: my %keywords=();
367: map {
368: unless ($nokey{$_}) {
369: $keywords{$_}=1;
370: }
371: } ($textonly=~m/(\w+)/g);
372:
1.12 www 373: map {
374: $keywords{$_}=1;
375: } split(/\W+/,$metadatafields{'keywords'});
1.5 www 376:
1.7 www 377: map {
1.12 www 378: $keywordout.='<td><input type=checkbox name="key.'.$_.'"';
1.8 www 379: if ($metadatafields{'keywords'}=~/$_/) {
380: $keywordout.=' checked';
381: }
382: $keywordout.='>'.$_.'</td>';
1.7 www 383: if ($colcount>10) {
384: $keywordout.="</tr><tr>\n";
385: $colcount=0;
386: }
387: $colcount++;
388: } sort keys %keywords;
389: $keywordout.='</tr></table>';
1.5 www 390:
391: }
1.4 www 392:
1.7 www 393: $scrout.=$keywordout;
1.9 www 394:
1.12 www 395: $scrout.=&textfield('Additional Keywords','addkey','');
396:
1.10 www 397: $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
1.9 www 398:
399: $scrout.=
400: '<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
401: $metadatafields{'abstract'}.'</textarea>';
402:
1.11 www 403: $source=~/\.(\w+)$/;
404:
405: $scrout.=&hiddenfield('mime',$1);
406:
1.10 www 407: $scrout.=&selectbox('Language','language',
408: $metadatafields{'language'},%language);
1.11 www 409:
410: unless ($metadatafields{'creationdate'}) {
411: $metadatafields{'creationdate'}=time;
412: }
413: $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'});
414:
415: $scrout.=&hiddenfield('lastrevisiondate',time);
416:
1.9 www 417:
1.10 www 418: $scrout.=&textfield('Publisher/Owner','owner',
419: $metadatafields{'owner'});
420:
421: $scrout.=&selectbox('Copyright/Distribution','copyright',
422: $metadatafields{'copyright'},%cprtag);
1.9 www 423:
1.8 www 424: return $scrout.
425: '<p><input type="submit" value="Finalize Publication"></form>';
1.2 www 426: }
1.1 www 427:
1.12 www 428: # -------------------------------------------------------- Publication Step Two
429:
1.11 www 430: sub phasetwo {
431:
1.24 harris41 432: my ($source,$target,$style,$distarget)=@_;
1.11 www 433: my $logfile;
434: my $scrout='';
435:
436: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
437: return
438: '<font color=red>No write permission to user directory, FAIL</font>';
439: }
440: print $logfile
441: "\n================= Publish ".localtime()." Phase Two ================\n";
442:
443: %metadatafields=();
444: %metadatakeys=();
445:
446: &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));
447:
448: $metadatafields{'title'}=$ENV{'form.title'};
449: $metadatafields{'author'}=$ENV{'form.author'};
450: $metadatafields{'subject'}=$ENV{'form.subject'};
451: $metadatafields{'notes'}=$ENV{'form.notes'};
452: $metadatafields{'abstract'}=$ENV{'form.abstract'};
453: $metadatafields{'mime'}=$ENV{'form.mime'};
454: $metadatafields{'language'}=$ENV{'form.language'};
455: $metadatafields{'creationdate'}=$ENV{'form.creationdate'};
456: $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
457: $metadatafields{'owner'}=$ENV{'form.owner'};
458: $metadatafields{'copyright'}=$ENV{'form.copyright'};
1.12 www 459:
460: my $allkeywords=$ENV{'form.addkey'};
1.11 www 461: map {
1.12 www 462: if ($_=~/^form\.key\.(\w+)/) {
463: $allkeywords.=','.$1;
464: }
465: } keys %ENV;
466: $allkeywords=~s/\W+/\,/;
467: $allkeywords=~s/^\,//;
468: $metadatafields{'keywords'}=$allkeywords;
469:
470: {
471: print $logfile "\nWrite metadata file for ".$source;
472: my $mfh;
473: unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
474: return
475: '<font color=red>Could not write metadata, FAIL</font>';
476: }
477: map {
478: unless ($_=~/\./) {
479: my $unikey=$_;
480: $unikey=~/^([A-Za-z]+)/;
481: my $tag=$1;
482: $tag=~tr/A-Z/a-z/;
483: print $mfh "\n\<$tag";
484: map {
485: my $value=$metadatafields{$unikey.'.'.$_};
486: $value=~s/\"/\'\'/g;
487: print $mfh ' '.$_.'="'.$value.'"';
488: } split(/\,/,$metadatakeys{$unikey});
489: print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';
490: }
491: } sort keys %metadatafields;
492: $scrout.='<p>Wrote Metadata';
493: print $logfile "\nWrote metadata";
494: }
495:
1.24 harris41 496: # -------------------------------- Synchronize entry with SQL metadata database
1.25 harris41 497: my %perlvar;
498: open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
499: my $configline;
500: while ($configline=<CONFIG>) {
501: if ($configline =~ /PerlSetVar/) {
502: my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
503: chomp($varvalue);
504: $perlvar{$varname}=$varvalue;
505: }
506: }
507: close(CONFIG);
508:
1.24 harris41 509: my $dbh;
510: {
511: unless (
512: $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
513: ) {
514: return '<font color=red>Cannot connect to database!</font>';
515: }
516: }
517:
518: my %sqldatafields;
519: $sqldatafields{'url'}=$distarget;
1.25 harris41 520: my $sth=$dbh->prepare("delete from metadata where url like binary \"".
1.24 harris41 521: $sqldatafields{'url'}."\"");
522: $sth->execute();
523: map {my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g;
524: $sqldatafields{$_}=$field;}
525: ('title','author','subject','keywords','notes','abstract',
526: 'mime','language','creationdate','lastrevisiondate','owner','copyright');
527:
528: $sth=$dbh->prepare('insert into metadata values ('.
529: '"'.delete($sqldatafields{'title'}).'"'.','.
530: '"'.delete($sqldatafields{'author'}).'"'.','.
531: '"'.delete($sqldatafields{'subject'}).'"'.','.
532: '"'.delete($sqldatafields{'url'}).'"'.','.
533: '"'.delete($sqldatafields{'keywords'}).'"'.','.
534: '"'.'current'.'"'.','.
535: '"'.delete($sqldatafields{'notes'}).'"'.','.
536: '"'.delete($sqldatafields{'abstract'}).'"'.','.
537: '"'.delete($sqldatafields{'mime'}).'"'.','.
538: '"'.delete($sqldatafields{'language'}).'"'.','.
1.25 harris41 539: '"'.sqltime(delete($sqldatafields{'creationdate'})).'"'.','.
540: '"'.sqltime(delete($sqldatafields{'lastrevisiondate'})).'"'.','.
1.24 harris41 541: '"'.delete($sqldatafields{'owner'}).'"'.','.
542: '"'.delete($sqldatafields{'copyright'}).'"'.')');
543: $sth->execute();
544: $dbh->disconnect;
545: $scrout.='<p>Synchronized SQL metadata database';
546: print $logfile "\nSynchronized SQL metadata database";
547:
1.12 www 548: # ----------------------------------------------------------- Copy old versions
549:
550: if (-e $target) {
551: my $filename;
552: my $maxversion=0;
553: $target=~/(.*)\/([^\/]+)\.(\w+)$/;
554: my $srcf=$2;
555: my $srct=$3;
556: my $srcd=$1;
557: unless ($srcd=~/^\/home\/httpd\/html\/res/) {
558: print $logfile "\nPANIC: Target dir is ".$srcd;
559: return "<font color=red>Invalid target directory, FAIL</font>";
560: }
561: opendir(DIR,$srcd);
562: while ($filename=readdir(DIR)) {
563: if ($filename=~/$srcf\.(\d+)\.$srct$/) {
564: $maxversion=($1>$maxversion)?$1:$maxversion;
565: }
566: }
567: closedir(DIR);
568: $maxversion++;
569: $scrout.='<p>Creating old version '.$maxversion;
570: print $logfile "\nCreating old version ".$maxversion;
571:
572: my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
573:
1.13 www 574: if (copy($target,$copyfile)) {
1.12 www 575: print $logfile "Copied old target to ".$copyfile."\n";
576: $scrout.='<p>Copied old target file';
577: } else {
1.13 www 578: print $logfile "Unable to write ".$copyfile.':'.$!."\n";
579: return "<font color=red>Failed to copy old target, $!, FAIL</font>";
1.12 www 580: }
581:
582: # --------------------------------------------------------------- Copy Metadata
583:
584: $copyfile=$copyfile.'.meta';
1.13 www 585:
586: if (copy($target.'.meta',$copyfile)) {
1.14 www 587: print $logfile "Copied old target metadata to ".$copyfile."\n";
1.12 www 588: $scrout.='<p>Copied old metadata';
589: } else {
1.13 www 590: print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
1.14 www 591: if (-e $target.'.meta') {
592: return
1.13 www 593: "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";
1.14 www 594: }
1.12 www 595: }
1.11 www 596:
597:
1.12 www 598: } else {
599: $scrout.='<p>Initial version';
600: print $logfile "\nInitial version";
601: }
602:
603: # ---------------------------------------------------------------- Write Source
604: my $copyfile=$target;
605:
606: my @parts=split(/\//,$copyfile);
607: my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
608:
609: my $count;
610: for ($count=5;$count<$#parts;$count++) {
611: $path.="/$parts[$count]";
612: if ((-e $path)!=1) {
613: print $logfile "\nCreating directory ".$path;
614: $scrout.='<p>Created directory '.$parts[$count];
615: mkdir($path,0777);
616: }
617: }
618:
1.13 www 619: if (copy($source,$copyfile)) {
1.12 www 620: print $logfile "Copied original source to ".$copyfile."\n";
621: $scrout.='<p>Copied source file';
622: } else {
1.13 www 623: print $logfile "Unable to write ".$copyfile.':'.$!."\n";
624: return "<font color=red>Failed to copy source, $!, FAIL</font>";
1.12 www 625: }
626:
627: # --------------------------------------------------------------- Copy Metadata
628:
1.13 www 629: $copyfile=$copyfile.'.meta';
630:
631: if (copy($source.'.meta',$copyfile)) {
1.12 www 632: print $logfile "Copied original metadata to ".$copyfile."\n";
633: $scrout.='<p>Copied metadata';
634: } else {
1.13 www 635: print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
1.12 www 636: return
1.13 www 637: "<font color=red>Failed to write metadata copy, $!, FAIL</font>";
1.12 www 638: }
639:
640: # --------------------------------------------------- Send update notifications
641:
642: {
643:
644: my $filename;
645:
646: $target=~/(.*)\/([^\/]+)$/;
647: my $srcf=$2;
648: opendir(DIR,$1);
649: while ($filename=readdir(DIR)) {
650: if ($filename=~/$srcf\.(\w+)$/) {
651: my $subhost=$1;
652: if ($subhost ne 'meta') {
653: $scrout.='<p>Notifying host '.$subhost.':';
654: print $logfile "\nNotifying host '.$subhost.':'";
655: my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
1.20 www 656: $scrout.=$reply;
657: print $logfile $reply;
658: }
659: }
660: }
661: closedir(DIR);
662:
663: }
664:
665: # ---------------------------------------- Send update notifications, meta only
666:
667: {
668:
669: my $filename;
670:
671: $target=~/(.*)\/([^\/]+)$/;
672: my $srcf=$2.'.meta';
673: opendir(DIR,$1);
674: while ($filename=readdir(DIR)) {
675: if ($filename=~/$srcf\.(\w+)$/) {
676: my $subhost=$1;
677: if ($subhost ne 'meta') {
678: $scrout.=
679: '<p>Notifying host for metadata only '.$subhost.':';
680: print $logfile
681: "\nNotifying host for metadata only '.$subhost.':'";
682: my $reply=&Apache::lonnet::critical(
683: 'update:'.$target.'.meta',$subhost);
1.12 www 684: $scrout.=$reply;
685: print $logfile $reply;
686: }
687: }
688: }
689: closedir(DIR);
690:
691: }
692:
693: # ------------------------------------------------ Provide link to new resource
694:
695: my $thisdistarget=$target;
696: $thisdistarget=~s/^$docroot//;
697:
1.22 www 698: my $thissrc=$source;
699: $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;
700:
701: my $thissrcdir=$thissrc;
702: $thissrcdir=~s/\/[^\/]+$/\//;
703:
704:
1.12 www 705: return $scrout.
1.22 www 706: '<hr><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>'.
707: '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.
708: '<p><a href="'.$thissrcdir.
709: '"><font size=+2>Back to Source Directory</font></a>';
710:
1.11 www 711: }
712:
1.1 www 713: # ================================================================ Main Handler
714:
715: sub handler {
716: my $r=shift;
1.2 www 717:
718: if ($r->header_only) {
719: $r->content_type('text/html');
720: $r->send_http_header;
721: return OK;
722: }
723:
724: # -------------------------------------------------------------- Check filename
725:
726: my $fn=$ENV{'form.filename'};
727:
728: unless ($fn) {
729: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
730: ' trying to publish empty filename', $r->filename);
731: return HTTP_NOT_FOUND;
732: }
1.4 www 733:
734: unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) {
735: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
736: ' trying to publish file '.$ENV{'form.filename'}.
737: ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')',
738: $r->filename);
739: return HTTP_NOT_ACCEPTABLE;
740: }
1.2 www 741:
742: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
743:
744: my $targetdir='';
1.12 www 745: $docroot=$r->dir_config('lonDocRoot');
1.2 www 746: if ($1 ne $ENV{'user.name'}) {
747: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
748: ' trying to publish unowned file '.$ENV{'form.filename'}.
749: ' ('.$fn.')',
750: $r->filename);
751: return HTTP_NOT_ACCEPTABLE;
752: } else {
753: $targetdir=$docroot.'/res/'.$ENV{'user.domain'};
754: }
755:
756:
757: unless (-e $fn) {
758: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
759: ' trying to publish non-existing file '.$ENV{'form.filename'}.
760: ' ('.$fn.')',
761: $r->filename);
762: return HTTP_NOT_FOUND;
763: }
764:
1.11 www 765: unless ($ENV{'form.phase'} eq 'two') {
766:
1.2 www 767: # --------------------------------- File is there and owned, init lookup tables
768:
1.3 www 769: %addid=();
770:
771: {
772: my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
773: while (<$fh>=~/(\w+)\s+(\w+)/) {
774: $addid{$1}=$2;
775: }
1.5 www 776: }
777:
778: %nokey=();
779:
780: {
781: my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
782: map {
783: my $word=$_;
784: chomp($word);
785: $nokey{$word}=1;
1.9 www 786: } <$fh>;
787: }
788:
789: %language=();
790:
791: {
792: my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');
793: map {
1.10 www 794: $_=~/(\w+)\s+([\w\s\-]+)/;
1.9 www 795: $language{$1}=$2;
1.10 www 796: } <$fh>;
797: }
798:
799: %cprtag=();
800:
801: {
802: my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab');
803: map {
804: $_=~/(\w+)\s+([\w\s\-]+)/;
805: $cprtag{$1}=$2;
1.5 www 806: } <$fh>;
1.3 www 807: }
1.11 www 808:
809: }
810:
1.2 www 811: # ----------------------------------------------------------- Start page output
812:
1.1 www 813: $r->content_type('text/html');
814: $r->send_http_header;
815:
816: $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
1.15 www 817: $r->print(
818: '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
1.2 www 819: my $thisfn=$fn;
820:
821: # ------------------------------------------------------------- Individual file
822: {
823: $thisfn=~/\.(\w+)$/;
824: my $thistype=$1;
825: my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);
826:
827: my $thistarget=$thisfn;
828:
829: $thistarget=~s/^\/home/$targetdir/;
830: $thistarget=~s/\/public\_html//;
831:
832: my $thisdistarget=$thistarget;
833: $thisdistarget=~s/^$docroot//;
834:
835: my $thisdisfn=$thisfn;
836: $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
837:
838: $r->print('<h2>Publishing '.
839: &Apache::lonnet::filedescription($thistype).' <tt>'.
840: $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
1.26 ! www 841:
! 842: if (&Apache::lonnet::fileembstyle($thistype) eq 'ssi') {
! 843: $r->print('<br><a href="/adm/diff?filename='.$thisdisfn.
! 844: '&versionone=priv" target=cat>Diffs with Current Version</a><p>');
! 845: }
1.11 www 846:
1.2 www 847: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
848:
1.11 www 849: unless ($ENV{'form.phase'} eq 'two') {
850: $r->print('<hr>'.&publish($thisfn,$thistarget,$thisembstyle));
851: } else {
1.24 harris41 852: $r->print('<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget));
1.11 www 853: }
1.2 www 854:
1.11 www 855: }
1.1 www 856: $r->print('</body></html>');
1.15 www 857:
1.1 www 858: return OK;
859: }
860:
861: 1;
862: __END__
863:
864:
865:
866:
867:
868:
869:
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