1: # The LearningOnline Network with CAPA
2: # Publication Handler
3: #
4: # $Id: lonpublisher.pm,v 1.303 2023/07/14 22:19:22 raeburn Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: ###
29:
30: ###############################################################################
31: ## ##
32: ## ORGANIZATION OF THIS PERL MODULE ##
33: ## ##
34: ## 1. Modules used by this module ##
35: ## 2. Various subroutines ##
36: ## 3. Publication Step One ##
37: ## 4. Phase Two ##
38: ## 5. Main Handler ##
39: ## ##
40: ###############################################################################
41:
42:
43: ######################################################################
44: ######################################################################
45:
46: =pod
47:
48: =head1 NAME
49:
50: lonpublisher - LON-CAPA publishing handler
51:
52: =head1 SYNOPSIS
53:
54: B<lonpublisher> is used by B<mod_perl> inside B<Apache>. This is the
55: invocation by F<loncapa_apache.conf>:
56:
57: <Location /adm/publish>
58: PerlAccessHandler Apache::lonacc
59: SetHandler perl-script
60: PerlHandler Apache::lonpublisher
61: ErrorDocument 403 /adm/login
62: ErrorDocument 404 /adm/notfound.html
63: ErrorDocument 406 /adm/unauthorized.html
64: ErrorDocument 500 /adm/errorhandler
65: </Location>
66:
67: =head1 OVERVIEW
68:
69: Authors can only write-access the C</priv/domain/authorname/> space.
70: They can copy resources into the resource area through the
71: publication step, and move them back through a recover step.
72: Authors do not have direct write-access to their resource space.
73:
74: During the publication step, several events will be
75: triggered. Metadata is gathered, where a wizard manages default
76: entries on a hierarchical per-directory base: The wizard imports the
77: metadata (including access privileges and royalty information) from
78: the most recent published resource in the current directory, and if
79: that is not available, from the next directory above, etc. The Network
80: keeps all previous versions of a resource and makes them available by
81: an explicit version number, which is inserted between the file name
82: and extension, for example C<foo.2.html>, while the most recent
83: version does not carry a version number (C<foo.html>). Servers
84: subscribing to a changed resource are notified that a new version is
85: available.
86:
87: =head1 DESCRIPTION
88:
89: B<lonpublisher> takes the proper steps to add resources to the LON-CAPA
90: digital library. This includes updating the metadata table in the
91: LON-CAPA database.
92:
93: B<lonpublisher> is many things to many people.
94:
95: This module publishes a file. This involves gathering metadata,
96: versioning the file, copying file from construction space to
97: publication space, and copying metadata from construction space
98: to publication space.
99:
100: =head2 SUBROUTINES
101:
102: Many of the undocumented subroutines implement various magical
103: parsing shortcuts.
104:
105: =cut
106:
107: ######################################################################
108: ######################################################################
109:
110:
111: package Apache::lonpublisher;
112:
113: # ------------------------------------------------- modules used by this module
114: use strict;
115: use Apache::File;
116: use File::Copy;
117: use Apache::Constants qw(:common :http :methods);
118: use HTML::LCParser;
119: use HTML::Entities;
120: use Encode::Encoder;
121: use Apache::lonxml;
122: use DBI;
123: use Apache::lonnet;
124: use Apache::loncommon();
125: use Apache::lonhtmlcommon;
126: use Apache::lonmysql;
127: use Apache::lonlocal;
128: use Apache::loncfile;
129: use LONCAPA::lonmetadata;
130: use Apache::lonmsg;
131: use vars qw(%metadatafields %metadatakeys %addid $readit);
132: use LONCAPA qw(:DEFAULT :match);
133:
134: my $docroot;
135:
136: my $cuname;
137: my $cudom;
138:
139: my $registered_cleanup;
140: my $modified_urls;
141:
142: my $lock;
143:
144: =pod
145:
146: =over 4
147:
148: =item B<metaeval>
149:
150: Evaluates a string that contains metadata. This subroutine
151: stores values inside I<%metadatafields> and I<%metadatakeys>.
152: The hash key is a I<$unikey> corresponding to a unique id
153: that is descriptive of the parser location inside the XML tree.
154:
155: Parameters:
156:
157: =over 4
158:
159: =item I<$metastring>
160:
161: A string that contains metadata.
162:
163: =back
164:
165: Returns:
166:
167: nothing
168:
169: =cut
170:
171: #########################################
172: #########################################
173: #
174: # Modifies global %metadatafields %metadatakeys
175: #
176:
177: sub metaeval {
178: my ($metastring,$prefix)=@_;
179:
180: my $parser=HTML::LCParser->new(\$metastring);
181: my $token;
182: while ($token=$parser->get_token) {
183: if ($token->[0] eq 'S') {
184: my $entry=$token->[1];
185: my $unikey=$entry;
186: next if ($entry =~ m/^(?:parameter|stores)_/);
187: if (defined($token->[2]->{'package'})) {
188: $unikey.="\0package\0".$token->[2]->{'package'};
189: }
190: if (defined($token->[2]->{'part'})) {
191: $unikey.="\0".$token->[2]->{'part'};
192: }
193: if (defined($token->[2]->{'id'})) {
194: $unikey.="\0".$token->[2]->{'id'};
195: }
196: if (defined($token->[2]->{'name'})) {
197: $unikey.="\0".$token->[2]->{'name'};
198: }
199: foreach my $item (@{$token->[3]}) {
200: $metadatafields{$unikey.'.'.$item}=$token->[2]->{$item};
201: if ($metadatakeys{$unikey}) {
202: $metadatakeys{$unikey}.=','.$item;
203: } else {
204: $metadatakeys{$unikey}=$item;
205: }
206: }
207: my $newentry=$parser->get_text('/'.$entry);
208: if (($entry eq 'customdistributionfile') ||
209: ($entry eq 'sourcerights')) {
210: $newentry=~s/^\s*//;
211: if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
212: }
213: # actually store
214: if ( $entry eq 'rule' && exists($metadatafields{$unikey})) {
215: $metadatafields{$unikey}.=','.$newentry;
216: } else {
217: $metadatafields{$unikey}=$newentry;
218: }
219: }
220: }
221: }
222:
223: #########################################
224: #########################################
225:
226: =pod
227:
228: =item B<metaread>
229:
230: Read a metadata file
231:
232: Parameters:
233:
234: =over
235:
236: =item I<$logfile>
237:
238: File output stream to output errors and warnings to.
239:
240: =item I<$fn>
241:
242: File name (including path).
243:
244: =back
245:
246: Returns:
247:
248: =over 4
249:
250: =item Scalar string (if successful)
251:
252: XHTML text that indicates successful reading of the metadata.
253:
254: =back
255:
256: =cut
257:
258: #########################################
259: #########################################
260: sub metaread {
261: my ($logfile,$fn,$prefix)=@_;
262: unless (-e $fn) {
263: print($logfile 'No file '.$fn."\n");
264: return '<p class="LC_warning">'
265: .&mt('No file: [_1]',&Apache::loncfile::display($fn))
266: .'</p>';
267: }
268: print($logfile 'Processing '.$fn."\n");
269: my $metastring;
270: {
271: my $metafh=Apache::File->new($fn);
272: $metastring=join('',<$metafh>);
273: }
274: &metaeval($metastring,$prefix);
275: return '<p class="LC_info">'
276: .&mt('Processed file: [_1]',&Apache::loncfile::display($fn))
277: .'</p>';
278: }
279:
280: #########################################
281: #########################################
282:
283: sub coursedependencies {
284: my $url=&Apache::lonnet::declutter(shift);
285: $url=~s/\.meta$//;
286: my ($adomain,$aauthor)=($url=~ m{^($match_domain)/($match_username)/});
287: my $regexp=quotemeta($url);
288: $regexp='___'.$regexp.'___course';
289: my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
290: $aauthor,$regexp);
291: my %courses=();
292: foreach my $item (keys(%evaldata)) {
293: if ($item=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {
294: $courses{$1}=1;
295: }
296: }
297: return %courses;
298: }
299: #########################################
300: #########################################
301:
302:
303: =pod
304:
305: =item Form-field-generating subroutines.
306:
307: For input parameters, these subroutines take in values
308: such as I<$name>, I<$value> and other form field metadata.
309: The output (scalar string that is returned) is an XHTML
310: string which presents the form field (foreseeably inside
311: <form></form> tags).
312:
313: =over 4
314:
315: =item B<textfield>
316:
317: =item B<text_with_browse_field>
318:
319: =item B<hiddenfield>
320:
321: =item B<checkbox>
322:
323: =item B<selectbox>
324:
325: =back
326:
327: =cut
328:
329: #########################################
330: #########################################
331: sub textfield {
332: my ($title,$name,$value,$noline,$readonly)=@_;
333: $value=~s/^\s+//gs;
334: $value=~s/\s+$//gs;
335: $value=~s/\s+/ /gs;
336: $title=&mt($title);
337: $env{'form.'.$name}=$value;
338: return "\n".&Apache::lonhtmlcommon::row_title($title)
339: .'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'
340: .&Apache::lonhtmlcommon::row_closure($noline);
341: }
342:
343: sub text_with_browse_field {
344: my ($title,$name,$value,$restriction,$noline,$readonly)=@_;
345: $value=~s/^\s+//gs;
346: $value=~s/\s+$//gs;
347: $value=~s/\s+/ /gs;
348: $title=&mt($title);
349: $env{'form.'.$name}=$value;
350: my $disabled;
351: if ($readonly) {
352: $disabled = ' disabled="disabled"';
353: }
354: my $output =
355: "\n".&Apache::lonhtmlcommon::row_title($title)
356: .'<input type="text" name="'.$name.'" size="80" value="'.$value.'"'.$disabled.' />';
357: unless ($readonly) {
358: $output .=
359: '<br />'
360: .'<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">'
361: .&mt('Select')
362: .'</a> '
363: .'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'
364: .&mt('Search')
365: .'</a>';
366: }
367: $output .= &Apache::lonhtmlcommon::row_closure($noline);
368: return $output;
369: }
370:
371: sub hiddenfield {
372: my ($name,$value)=@_;
373: $env{'form.'.$name}=$value;
374: return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';
375: }
376:
377: sub checkbox {
378: my ($name,$text)=@_;
379: return "\n<label><input type='checkbox' name='$name' /> ".
380: &mt($text)."</label>";
381: }
382:
383: sub selectbox {
384: my ($title,$name,$value,$readonly,$functionref,@idlist)=@_;
385: $title=&mt($title);
386: $value=(split(/\s*,\s*/,$value))[-1];
387: if (defined($value)) {
388: $env{'form.'.$name}=$value;
389: } else {
390: $env{'form.'.$name}=$idlist[0];
391: }
392: my $selout="\n".&Apache::lonhtmlcommon::row_title($title)
393: .'<select name="'.$name.'">';
394: foreach my $id (@idlist) {
395: $selout.='<option value="'.$id.'"';
396: if ($id eq $value) {
397: $selout.=' selected="selected"';
398: }
399: if ($readonly) {
400: $selout .= ' disabled="disabled"';
401: }
402: $selout.='>'.&{$functionref}($id).'</option>';
403: }
404: $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
405: return $selout;
406: }
407:
408: sub select_level_form {
409: my ($value,$name)=@_;
410: $env{'form.'.$name}=$value;
411: if (!defined($value)) { $env{'form.'.$name}=0; }
412: return &Apache::loncommon::select_level_form($value,$name);
413: }
414:
415: sub common_access {
416: my ($name,$text,$options)=@_;
417: return unless (ref($options) eq 'ARRAY');
418: my $formname = 'pubdirpref';
419: my $chkname = 'common'.$name;
420: my $chkid = 'LC_'.$chkname;
421: my $divid = $chkid.'div';
422: my $customdivid = 'LC_customfile';
423: my $selname = $chkname.'select';
424: my $selid = $chkid.'select';
425: my $selonchange;
426: if ($name eq 'dist') {
427: $selonchange = ' onchange="showHideCustom(this,'."'$customdivid'".');"';
428: }
429: my %lt = &Apache::lonlocal::texthash(
430: 'default' => 'System wide - can be used for any courses system wide',
431: 'domain' => 'Domain only - use limited to courses in the domai',
432: 'custom' => 'Customized right of use ...',
433: 'public' => 'Public - no authentication or authorization required for use',
434: 'closed' => 'Closed - XML source is closed to everyone',
435: 'open' => 'Open - XML source is open to people who want to use it',
436: 'sel' => 'Select',
437: );
438: my $output = <<"END";
439: <span class="LC_nobreak">
440: <label>
441: <input type="checkbox" name="commonaccess" value="$name" id="$chkid"
442: onclick="showHideAccess(this,'$divid');" />
443: $text</label></span>
444: <div id="$divid" style="padding:0;clear:both;margin:0;border:0;display:none">
445: <select name="$selname" id="$selid" $selonchange>
446: <option value="" selected="selected">$lt{'sel'}</option>
447: END
448: foreach my $val (@{$options}) {
449: $output .= '<option value="'.$val.'">'.$lt{$val}.'</option>'."\n";
450: }
451: $output .= '
452: </select>';
453: if ($name eq 'dist') {
454: $output .= <<"END";
455: <div id="$customdivid" style="padding:0;clear:both;margin:0;border:0;display:none">
456: <input type="text" name="commoncustomrights" size="60" value="" />
457: <a href="javascript:openbrowser('$formname','commoncustomrights','rights');">
458: $lt{'sel'}</a></div>
459: END
460: }
461: $output .= '
462: </div>
463: ';
464: }
465:
466: #########################################
467: #########################################
468:
469: =pod
470:
471: =item B<urlfixup>
472:
473: Fix up a url? First step of publication
474:
475: =cut
476:
477: #########################################
478: #########################################
479: sub urlfixup {
480: my ($url,$target)=@_;
481: unless ($url) { return ''; }
482: #javascript code needs no fixing
483: if ($url =~ /^javascript:/i) { return $url; }
484: if ($url =~ /^mailto:/i) { return $url; }
485: #internal document links need no fixing
486: if ($url =~ /^\#/) { return $url; }
487: my ($host)=($url=~m{(?:(?:http|https|ftp)://)*([^/]+)});
488: my @lonids = &Apache::lonnet::machine_ids($host);
489: if (@lonids) {
490: $url=~s{^(?:http|https|ftp)://}{};
491: $url=~s/^\Q$host\E//;
492: }
493: if ($url=~m{^(?:http|https|ftp)://}) { return $url; }
494: $url=~s{\Q~$cuname\E}{res/$cudom/$cuname};
495: return $url;
496: }
497:
498: #########################################
499: #########################################
500:
501: =pod
502:
503: =item B<absoluteurl>
504:
505: Currently undocumented.
506:
507: =cut
508:
509: #########################################
510: #########################################
511: sub absoluteurl {
512: my ($url,$target)=@_;
513: unless ($url) { return ''; }
514: if ($target) {
515: $target=~s/\/[^\/]+$//;
516: $url=&Apache::lonnet::hreflocation($target,$url);
517: }
518: return $url;
519: }
520:
521: #########################################
522: #########################################
523:
524: =pod
525:
526: =item B<set_allow>
527:
528: Currently undocumented
529:
530: =cut
531:
532: #########################################
533: #########################################
534: sub set_allow {
535: my ($allow,$logfile,$target,$tag,$oldurl,$type)=@_;
536: my $newurl=&urlfixup($oldurl,$target);
537: my $return_url=$oldurl;
538: print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
539: if ($newurl ne $oldurl) {
540: $return_url=$newurl;
541: print $logfile 'URL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
542: }
543: if (($newurl !~ /^javascript:/i) &&
544: ($newurl !~ /^mailto:/i) &&
545: ($newurl !~ /^(?:http|https|ftp):/i) &&
546: ($newurl !~ /^\#/)) {
547: if (($type eq 'src') || ($type eq 'href')) {
548: if ($newurl =~ /^([^?]+)\?[^?]*$/) {
549: $newurl = $1;
550: }
551: }
552: $$allow{&absoluteurl($newurl,$target)}=1;
553: }
554: return $return_url;
555: }
556:
557: #########################################
558: #########################################
559:
560: =pod
561:
562: =item B<get_subscribed_hosts>
563:
564: Currently undocumented
565:
566: =cut
567:
568: #########################################
569: #########################################
570: sub get_subscribed_hosts {
571: my ($target)=@_;
572: my @subscribed;
573: my $filename;
574: $target=~/(.*)\/([^\/]+)$/;
575: my $srcf=$2;
576: opendir(DIR,$1);
577: # cycle through listed files, subscriptions used to exist
578: # as "filename.lonid"
579: while ($filename=readdir(DIR)) {
580: if ($filename=~/\Q$srcf\E\.($match_lonid)$/) {
581: my $subhost=$1;
582: if (($subhost ne 'meta'
583: && $subhost ne 'subscription'
584: && $subhost ne 'meta.subscription'
585: && $subhost ne 'tmp') &&
586: ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
587: push(@subscribed,$subhost);
588: }
589: }
590: }
591: closedir(DIR);
592: my $sh;
593: if ( $sh=Apache::File->new("$target.subscription") ) {
594: while (my $subline=<$sh>) {
595: if ($subline =~ /^($match_lonid):/) {
596: if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) {
597: push(@subscribed,$1);
598: }
599: }
600: }
601: }
602: return @subscribed;
603: }
604:
605:
606: #########################################
607: #########################################
608:
609: =pod
610:
611: =item B<get_max_ids_indices>
612:
613: Currently undocumented
614:
615: =cut
616:
617: #########################################
618: #########################################
619: sub get_max_ids_indices {
620: my ($content)=@_;
621: my $maxindex=10;
622: my $maxid=10;
623: my $needsfixup=0;
624: my $duplicateids=0;
625:
626: my %allids;
627: my %duplicatedids;
628:
629: my $parser=HTML::LCParser->new($content);
630: $parser->xml_mode(1);
631: my $token;
632: while ($token=$parser->get_token) {
633: if ($token->[0] eq 'S') {
634: my $counter;
635: if ($counter=$addid{$token->[1]}) {
636: if ($counter eq 'id') {
637: if (defined($token->[2]->{'id'}) &&
638: $token->[2]->{'id'} !~ /^\s*$/) {
639: $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
640: if (exists($allids{$token->[2]->{'id'}})) {
641: $duplicateids=1;
642: $duplicatedids{$token->[2]->{'id'}}=1;
643: } else {
644: $allids{$token->[2]->{'id'}}=1;
645: }
646: } else {
647: $needsfixup=1;
648: }
649: } else {
650: if (defined($token->[2]->{'index'}) &&
651: $token->[2]->{'index'} !~ /^\s*$/) {
652: $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
653: } else {
654: $needsfixup=1;
655: }
656: }
657: }
658: }
659: }
660: return ($needsfixup,$maxid,$maxindex,$duplicateids,
661: (keys(%duplicatedids)));
662: }
663:
664: #########################################
665: #########################################
666:
667: =pod
668:
669: =item B<get_all_text_unbalanced>
670:
671: Currently undocumented
672:
673: =cut
674:
675: #########################################
676: #########################################
677: sub get_all_text_unbalanced {
678: #there is a copy of this in lonxml.pm
679: my($tag,$pars)= @_;
680: my $token;
681: my $result='';
682: $tag='<'.$tag.'>';
683: while ($token = $$pars[-1]->get_token) {
684: if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
685: $result.=$token->[1];
686: } elsif ($token->[0] eq 'PI') {
687: $result.=$token->[2];
688: } elsif ($token->[0] eq 'S') {
689: $result.=$token->[4];
690: } elsif ($token->[0] eq 'E') {
691: $result.=$token->[2];
692: }
693: if ($result =~ /\Q$tag\E/s) {
694: ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
695: #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
696: #&Apache::lonnet::logthis('Result is :'.$1);
697: $redo=$tag.$redo;
698: push (@$pars,HTML::LCParser->new(\$redo));
699: $$pars[-1]->xml_mode('1');
700: last;
701: }
702: }
703: return $result
704: }
705:
706: #########################################
707: #########################################
708:
709: =pod
710:
711: =item B<fix_ids_and_indices>
712:
713: Currently undocumented
714:
715: =cut
716:
717: #########################################
718: #########################################
719: #Arguably this should all be done as a lonnet::ssi instead
720: sub fix_ids_and_indices {
721: my ($logfile,$source,$target)=@_;
722:
723: my %allow;
724: my $content;
725: {
726: my $org=Apache::File->new($source);
727: $content=join('',<$org>);
728: }
729:
730: my ($needsfixup,$maxid,$maxindex,$duplicateids,@duplicatedids)=
731: &get_max_ids_indices(\$content);
732:
733: print $logfile ("Got $needsfixup,$maxid,$maxindex,$duplicateids--".
734: join(', ',@duplicatedids));
735: if ($duplicateids) {
736: print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";
737: my $outstring='<span class="LC_error">'.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).'</span>';
738: return ($outstring,1);
739: }
740: if ($needsfixup) {
741: print $logfile "Needs ID and/or index fixup\n".
742: "Max ID : $maxid (min 10)\n".
743: "Max Index: $maxindex (min 10)\n";
744: }
745: my $outstring='';
746: my $responsecounter=1;
747: my @parser;
748: $parser[0]=HTML::LCParser->new(\$content);
749: $parser[-1]->xml_mode(1);
750: my $token;
751: while (@parser) {
752: while ($token=$parser[-1]->get_token) {
753: if ($token->[0] eq 'S') {
754: my $counter;
755: my $tag=$token->[1];
756: my $lctag=lc($tag);
757: if ($lctag eq 'allow') {
758: $allow{$token->[2]->{'src'}}=1;
759: next;
760: }
761: if ($lctag eq 'base') { next; }
762: if (($lctag eq 'part') || ($lctag eq 'problem')) {
763: $responsecounter=0;
764: }
765: if ($lctag=~/response$/) { $responsecounter++; }
766: if ($lctag eq 'import') { $responsecounter++; }
767: my %parms=%{$token->[2]};
768: $counter=$addid{$tag};
769: if (!$counter) { $counter=$addid{$lctag}; }
770: if ($counter) {
771: if ($counter eq 'id') {
772: unless (defined($parms{'id'}) &&
773: $parms{'id'}!~/^\s*$/) {
774: $maxid++;
775: $parms{'id'}=$maxid;
776: print $logfile 'ID(new) : '.$tag.':'.$maxid."\n";
777: } else {
778: print $logfile 'ID(kept): '.$tag.':'.$parms{'id'}."\n";
779: }
780: } elsif ($counter eq 'index') {
781: unless (defined($parms{'index'}) &&
782: $parms{'index'}!~/^\s*$/) {
783: $maxindex++;
784: $parms{'index'}=$maxindex;
785: print $logfile 'Index: '.$tag.':'.$maxindex."\n";
786: }
787: }
788: }
789: unless ($parms{'type'} eq 'zombie') {
790: foreach my $type ('src','href','background','bgimg') {
791: foreach my $key (keys(%parms)) {
792: if ($key =~ /^$type$/i) {
793: next if (($lctag eq 'img') && ($type eq 'src') &&
794: ($parms{$key} =~ m{^data\:image/gif;base64,}));
795: $parms{$key}=&set_allow(\%allow,$logfile,
796: $target,$tag,
797: $parms{$key},$type);
798: }
799: }
800: }
801: }
802: # probably a <randomlabel> image type <label>
803: # or a <image> tag inside <imageresponse>
804: if (($lctag eq 'label' && defined($parms{'description'}))
805: ||
806: ($lctag eq 'image')) {
807: my $next_token=$parser[-1]->get_token();
808: if ($next_token->[0] eq 'T') {
809: $next_token->[1] =~ s/[\n\r\f]+//g;
810: $next_token->[1]=&set_allow(\%allow,$logfile,
811: $target,$tag,
812: $next_token->[1]);
813: }
814: $parser[-1]->unget_token($next_token);
815: }
816: if ($lctag eq 'applet') {
817: my $codebase='';
818: my $havecodebase=0;
819: foreach my $key (keys(%parms)) {
820: if (lc($key) eq 'codebase') {
821: $codebase=$parms{$key};
822: $havecodebase=1;
823: }
824: }
825: if ($havecodebase) {
826: my $oldcodebase=$codebase;
827: unless ($oldcodebase=~/\/$/) {
828: $oldcodebase.='/';
829: }
830: $codebase=&urlfixup($oldcodebase,$target);
831: $codebase=~s/\/$//;
832: if ($codebase ne $oldcodebase) {
833: $parms{'codebase'}=$codebase;
834: print $logfile 'URL codebase: '.$tag.':'.
835: $oldcodebase.' - '.
836: $codebase."\n";
837: }
838: $allow{&absoluteurl($codebase,$target).'/*'}=1;
839: } else {
840: foreach my $key (keys(%parms)) {
841: if ($key =~ /(archive|code|object)/i) {
842: my $oldurl=$parms{$key};
843: my $newurl=&urlfixup($oldurl,$target);
844: $newurl=~s/\/[^\/]+$/\/\*/;
845: print $logfile 'Allow: applet '.lc($key).':'.
846: $oldurl.' allows '.$newurl."\n";
847: $allow{&absoluteurl($newurl,$target)}=1;
848: }
849: }
850: }
851: }
852: my $newparmstring='';
853: my $endtag='';
854: foreach my $parkey (keys(%parms)) {
855: if ($parkey eq '/') {
856: $endtag=' /';
857: } else {
858: my $quote=($parms{$parkey}=~/\"/?"'":'"');
859: $newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote;
860: }
861: }
862: if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
863: $outstring.='<'.$tag.$newparmstring.$endtag.'>';
864: if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' ||
865: $lctag eq 'tex') {
866: $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
867: } elsif ($lctag eq 'script') {
868: if ($parms{'type'} eq 'loncapa/perl') {
869: $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
870: } else {
871: my $script = &get_all_text_unbalanced('/'.$lctag,\@parser);
872: if ($script =~ m{\.set\w+(Src|Swf)\(["']}i) {
873: my @srcs = split(/\.set/i,$script);
874: if (scalar(@srcs) > 1) {
875: foreach my $item (@srcs) {
876: if ($item =~ m{^(FlashPlayerSwf|MediaSrc|XMPSrc|ConfigurationSrc|PosterImageSrc)\((['"])(?:(?!\2).)+\2\)}is) {
877: my $srctype = $1;
878: my $quote = $2;
879: my ($url) = ($item =~ m{^\Q$srctype($quote\E([^$quote]+)\Q$quote)\E});
880: $url = &urlfixup($url);
881: unless ($url=~m{^(?:http|https|ftp)://}) {
882: $allow{&absoluteurl($url,$target)}=1;
883: if ($srctype eq 'ConfigurationSrc') {
884: if ($url =~ m{^(.+/)configuration_express\.xml$}) {
885: #
886: # Camtasia 8.1: express_show/spritesheet.png needed, and included in zip archive.
887: # Not referenced directly in <main>.html or <main>_player.html files,
888: # so add this file to %allow (where <main> is name user gave to file/archive).
889: #
890: my $spritesheet = $1.'express_show/spritesheet.png';
891: $allow{&absoluteurl($spritesheet,$target)}=1;
892:
893: #
894: # Camtasia 8.4: skins/express_show/spritesheet.min.css needed, and included in zip archive.
895: # Not referenced directly in <main>.html or <main>_player.html files,
896: # so add this file to %allow (where <main> is name user gave to file/archive).
897: #
898: my $spritecss = $1.'express_show/spritesheet.min.css';
899: $allow{&absoluteurl($spritecss,$target)}=1;
900: }
901: } elsif ($srctype eq 'PosterImageSrc') {
902: if ($url =~ m{^(.+)_First_Frame\.png$}) {
903: my $prefix = $1;
904: #
905: # Camtasia 8.1: <main>_Thumbnails.png needed, and included in zip archive.
906: # Not referenced directly in <main>.html or <main>_player.html files,
907: # so add this file to %allow (where <main> is name user gave to file/archive).
908: #
909: my $thumbnail = $prefix.'_Thumbnails.png';
910: $allow{&absoluteurl($thumbnail,$target)}=1;
911: }
912: }
913: }
914: }
915: }
916: }
917: }
918: if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) {
919: my $src = $2;
920: if ($src) {
921: my $url = &urlfixup($src);
922: unless ($url=~m{^(?:http|https|ftp)://}) {
923: $allow{&absoluteurl($url,$target)}=1;
924: }
925: }
926: }
927: if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) {
928: my $scriptslist = $2;
929: my @srcs = split(/\s*,\s*/,$scriptslist);
930: foreach my $src (@srcs) {
931: if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) {
932: my $quote = $1;
933: my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/);
934: $url = &urlfixup($url);
935: unless ($url=~m{^(?:http|https|ftp)://}) {
936: $allow{&absoluteurl($url,$target)}=1;
937: }
938: }
939: }
940: }
941: if ($script =~ m{loadScript\(\s*(['"])((?:(?!\1).)+\.js)\1,\s*function}is) {
942: my $src = $2;
943: if ($src) {
944: my $url = &urlfixup($src);
945: unless ($url=~m{^(?:http|https|ftp)://}) {
946: $allow{&absoluteurl($url,$target)}=1;
947: }
948: }
949: }
950: $outstring .= $script;
951: }
952: }
953: } elsif ($token->[0] eq 'E') {
954: if ($token->[2]) {
955: unless ($token->[1] eq 'allow') {
956: $outstring.='</'.$token->[1].'>';
957: }
958: }
959: if ((($token->[1] eq 'part') || ($token->[1] eq 'problem'))
960: && (!$responsecounter)) {
961: my $outstring='<span class="LC_error">'.&mt('Found [_1] without responses. This resource cannot be published.',$token->[1]).'</span>';
962: return ($outstring,1);
963: }
964: } else {
965: $outstring.=$token->[1];
966: }
967: }
968: pop(@parser);
969: }
970:
971: if ($needsfixup) {
972: print $logfile "End of ID and/or index fixup\n".
973: "Max ID : $maxid (min 10)\n".
974: "Max Index: $maxindex (min 10)\n";
975: } else {
976: print $logfile "Does not need ID and/or index fixup\n";
977: }
978:
979: return ($outstring,0,%allow);
980: }
981:
982: #########################################
983: #########################################
984:
985: =pod
986:
987: =item B<store_metadata>
988:
989: Store the metadata in the metadata table in the loncapa database.
990: Uses lonmysql to access the database.
991:
992: Inputs: \%metadata
993:
994: Returns: (error,status). error is undef on success, status is undef on error.
995:
996: =cut
997:
998: #########################################
999: #########################################
1000: sub store_metadata {
1001: my %metadata = @_;
1002: my $error;
1003: # Determine if the table exists
1004: my $status = &Apache::lonmysql::check_table('metadata');
1005: if (! defined($status)) {
1006: $error='<span class="LC_error">'
1007: .&mt('WARNING: Cannot connect to database!')
1008: .'</span>';
1009: &Apache::lonnet::logthis($error);
1010: return ($error,undef);
1011: }
1012: if ($status == 0) {
1013: # It would be nice to actually create the table....
1014: $error ='<span class="LC_error">'
1015: .&mt('WARNING: The metadata table does not exist in the LON-CAPA database!')
1016: .'</span>';
1017: &Apache::lonnet::logthis($error);
1018: return ($error,undef);
1019: }
1020: my $dbh = &Apache::lonmysql::get_dbh();
1021: if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv')) {
1022: # remove this entry
1023: my $delitem = 'url = '.$dbh->quote($metadata{'url'});
1024: $status = &LONCAPA::lonmetadata::delete_metadata($dbh,undef,$delitem);
1025:
1026: } else {
1027: $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef,
1028: \%metadata);
1029: }
1030: if (defined($status) && $status ne '') {
1031: $error='<span class="LC_error">'
1032: .&mt('Error occurred saving new values in metadata table in LON-CAPA database!')
1033: .'</span>';
1034: &Apache::lonnet::logthis($error);
1035: &Apache::lonnet::logthis($status);
1036: return ($error,undef);
1037: }
1038: return (undef,'success');
1039: }
1040:
1041:
1042: # ========================================== Parse file for errors and warnings
1043:
1044: sub checkonthis {
1045: my ($r,$source)=@_;
1046: my $uri=&Apache::lonnet::hreflocation($source);
1047: $uri=~s/\/$//;
1048: my $result=&Apache::lonnet::ssi_body($uri,
1049: ('grade_target'=>'web',
1050: 'return_only_error_and_warning_counts' => 1));
1051: my ($errorcount,$warningcount)=split(':',$result);
1052: if (($errorcount) || ($warningcount)) {
1053: $r->print('<h3>'.&mt('Warnings and Errors').'</h3>');
1054: $r->print('<tt>'.$uri.'</tt>:');
1055: $r->print('<ul>');
1056: if ($warningcount) {
1057: $r->print('<li><div class="LC_warning">'
1058: .&mt('[quant,_1,warning]',$warningcount)
1059: .'</div></li>');
1060: }
1061: if ($errorcount) {
1062: $r->print('<li><div class="LC_error">'
1063: .&mt('[quant,_1,error]',$errorcount)
1064: .' <img src="/adm/lonMisc/bomb.gif" />'
1065: .'</div></li>');
1066: }
1067: $r->print('</ul>');
1068: } else {
1069: #$r->print('<font color="green">'.&mt('ok').'</font>');
1070: }
1071: $r->rflush();
1072: return ($warningcount,$errorcount);
1073: }
1074:
1075: # ============================================== Parse file itself for metadata
1076: #
1077: # parses a file with target meta, sets global %metadatafields %metadatakeys
1078:
1079: sub parseformeta {
1080: my ($source,$style)=@_;
1081: my $allmeta='';
1082: if (($style eq 'ssi') || ($style eq 'prv')) {
1083: my $dir=$source;
1084: $dir=~s-/[^/]*$--;
1085: my $file=$source;
1086: $file=(split('/',$file))[-1];
1087: $source=&Apache::lonnet::hreflocation($dir,$file);
1088: $allmeta=&Apache::lonnet::ssi_body($source,('grade_target' => 'meta'));
1089: &metaeval($allmeta);
1090: }
1091: return $allmeta;
1092: }
1093:
1094: #########################################
1095: #########################################
1096:
1097: =pod
1098:
1099: =item B<publish>
1100:
1101: This is the workhorse function of this module. This subroutine generates
1102: backup copies, performs any automatic processing (prior to publication,
1103: especially for rat and ssi files),
1104:
1105: Returns a 2 element array, the first is the string to be shown to the
1106: user, the second is an error code, either 1 (an error occurred) or 0
1107: (no error occurred)
1108:
1109: I<Additional documentation needed.>
1110:
1111: =cut
1112:
1113: #########################################
1114: #########################################
1115: sub publish {
1116:
1117: my ($source,$target,$style,$batch,$nokeyref)=@_;
1118: my $logfile;
1119: my $scrout='';
1120: my $allmeta='';
1121: my $content='';
1122: my %allow=();
1123:
1124: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
1125: return ('<span class="LC_error">'.&mt('No write permission to user directory, FAIL').'</span>',1);
1126: }
1127: print $logfile
1128: "\n\n================= Publish ".localtime()." Phase One ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n";
1129:
1130: if (($style eq 'ssi') || ($style eq 'rat') || ($style eq 'prv')) {
1131: # ------------------------------------------------------- This needs processing
1132:
1133: # ----------------------------------------------------------------- Backup Copy
1134: my $copyfile=$source.'.save';
1135: if (copy($source,$copyfile)) {
1136: print $logfile "Copied original file to ".$copyfile."\n";
1137: } else {
1138: print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
1139: return ("<span class=\"LC_error\">".&mt("Failed to write backup copy, [_1], FAIL",$1)."</span>",1);
1140: }
1141: # ------------------------------------------------------------- IDs and indices
1142:
1143: my ($outstring,$error);
1144: ($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source,
1145: $target);
1146: if ($error) { return ($outstring,$error); }
1147: # ------------------------------------------------------------ Construct Allows
1148:
1149: my $outdep=''; # Collect dependencies output data
1150: my $allowstr='';
1151: foreach my $thisdep (sort(keys(%allow))) {
1152: if ($thisdep !~ /[^\s]/) { next; }
1153: if ($thisdep =~/\$/) {
1154: $outdep.='<div class="LC_warning">'
1155: .&mt('The resource depends on another resource with variable filename, i.e., [_1].','<tt>'.$thisdep.'</tt>').'<br />'
1156: .&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<tt><allow></tt>')
1157: ."</div>\n";
1158: }
1159: unless ($style eq 'rat') {
1160: $allowstr.="\n".'<allow src="'.$thisdep.'" />';
1161: }
1162: $outdep.='<div>';
1163: if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
1164: $outdep.='<a href="'.$thisdep.'">';
1165: }
1166: $outdep.='<tt>'.$thisdep.'</tt>';
1167: if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
1168: $outdep.='</a>';
1169: if (
1170: &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
1171: $thisdep.'.meta') eq '-1') {
1172: $outdep.= ' - <span class="LC_error">'.&mt('Currently not available').
1173: '</span>';
1174: } else {
1175: #
1176: # Store the fact that the dependency has been used by the target file
1177: # Unfortunately, usage is erroneously named sequsage in lonmeta.pm
1178: # The translation happens in lonmetadata.pm
1179: #
1180: my %temphash=(&Apache::lonnet::declutter($target).'___'.
1181: &Apache::lonnet::declutter($thisdep).'___usage'
1182: => time);
1183: $thisdep=~m{^/res/($match_domain)/($match_username)/};
1184: if ((defined($1)) && (defined($2))) {
1185: &Apache::lonnet::put('nohist_resevaldata',\%temphash,
1186: $1,$2);
1187: }
1188: }
1189: }
1190: $outdep.='</div><br />';
1191: }
1192:
1193: if ($outdep) {
1194: $scrout.='<h3>'.&mt('Dependencies').'</h3>'
1195: .$outdep
1196: }
1197: $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;
1198:
1199: # ------------------------------------------------------------- Write modified.
1200:
1201: {
1202: my $org;
1203: unless ($org=Apache::File->new('>'.$source)) {
1204: print $logfile "No write permit to $source\n";
1205: return ('<span class="LC_error">'.&mt('No write permission to').
1206: ' '.$source.
1207: ', '.&mt('FAIL').'</span>',1);
1208: }
1209: print($org $outstring);
1210: }
1211: $content=$outstring;
1212:
1213: }
1214:
1215: # ----------------------------------------------------- Course Authoring Space.
1216: my ($courseauthor,$crsaurights,$readonly);
1217: if ($env{'request.course.id'}) {
1218: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1219: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1220: my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1221: if ($source =~ m{^\Q$docroot/priv/$cdom/$cnum/\E}) {
1222: $courseauthor = $cnum.':'.$cdom;
1223: $crsaurights = "/res/$cdom/$cnum/default.rights";
1224: $readonly = 1;
1225: }
1226: }
1227:
1228: # -------------------------------------------- Initial step done, now metadata.
1229:
1230: # --------------------------------------- Storage for metadata keys and fields.
1231: # these are globals
1232: #
1233: %metadatafields=();
1234: %metadatakeys=();
1235:
1236: my %oldparmstores=();
1237:
1238: unless ($batch) {
1239: $scrout.='<h3>'.&mt('Metadata').' ' .
1240: &Apache::loncommon::help_open_topic("Metadata_Description")
1241: . '</h3>';
1242: }
1243:
1244: # ------------------------------------------------ First, check out environment
1245: if ((!(-e $source.'.meta')) || ($env{'form.forceoverride'})) {
1246: $metadatafields{'author'}=$env{'environment.firstname'}.' '.
1247: $env{'environment.middlename'}.' '.
1248: $env{'environment.lastname'}.' '.
1249: $env{'environment.generation'};
1250: $metadatafields{'author'}=~s/\s+/ /g;
1251: $metadatafields{'author'}=~s/\s+$//;
1252: $metadatafields{'owner'}=$cuname.':'.$cudom;
1253:
1254: # ------------------------------------------------ Check out directory hierachy
1255:
1256: my $thisdisfn=$source;
1257:
1258: $thisdisfn=~s/^\Q$docroot\E\/priv\/\Q$cudom\E\/\Q$cuname\E\///;
1259: my @urlparts=('.',split(/\//,$thisdisfn));
1260: $#urlparts--;
1261:
1262: my $currentpath=$docroot.'/priv/'.$cudom.'/'.$cuname.'/';
1263:
1264: my $prefix='../'x($#urlparts);
1265: foreach my $subdir (@urlparts) {
1266: $currentpath.=$subdir.'/';
1267: $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
1268: $prefix=~s|^\.\./||;
1269: }
1270:
1271: # ----------------------------------------------------------- Parse file itself
1272: # read %metadatafields from file itself
1273:
1274: $allmeta=&parseformeta($source,$style);
1275:
1276: # ------------------- Clear out parameters and stores (there should not be any)
1277:
1278: foreach my $field (keys(%metadatafields)) {
1279: if (($field=~/^parameter/) || ($field=~/^stores/)) {
1280: delete $metadatafields{$field};
1281: }
1282: }
1283:
1284: } else {
1285: # ---------------------- Read previous metafile, remember parameters and stores
1286:
1287: $scrout.=&metaread($logfile,$source.'.meta');
1288:
1289: foreach my $field (keys(%metadatafields)) {
1290: if (($field=~/^parameter/) || ($field=~/^stores/)) {
1291: $oldparmstores{$field}=1;
1292: delete $metadatafields{$field};
1293: }
1294: }
1295: # ------------------------------------------------------------- Save some stuff
1296: my %savemeta=();
1297: if ($metadatafields{'title'}) { $savemeta{'title'}=$metadatafields{'title'}; }
1298: # ------------------------------------------ See if anything new in file itself
1299:
1300: $allmeta=&parseformeta($source,$style);
1301: # ----------------------------------------------------------- Restore the stuff
1302: foreach my $item (keys(%savemeta)) {
1303: $metadatafields{$item}=$savemeta{$item};
1304: }
1305: }
1306:
1307:
1308: # ---------------- Find and document discrepancies in the parameters and stores
1309:
1310: my $chparms='';
1311: foreach my $field (sort(keys(%metadatafields))) {
1312: if (($field=~/^parameter/) || ($field=~/^stores/)) {
1313: unless ($field=~/\.\w+$/) {
1314: unless ($oldparmstores{$field}) {
1315: my $disp_key = $field;
1316: $disp_key =~ tr/\0/_/;
1317: print $logfile ('New: '.$disp_key."\n");
1318: $chparms .= $disp_key.' ';
1319: }
1320: }
1321: }
1322: }
1323: if ($chparms) {
1324: $scrout.='<p><b>'.&mt('New parameters or saved values').
1325: ':</b> '.$chparms.'</p>';
1326: }
1327:
1328: $chparms='';
1329: foreach my $olditem (sort(keys(%oldparmstores))) {
1330: if (($olditem=~/^parameter/) || ($olditem=~/^stores/)) {
1331: unless (($metadatafields{$olditem.'.name'}) ||
1332: ($metadatafields{$olditem.'.package'}) || ($olditem=~/\.\w+$/)) {
1333: my $disp_key = $olditem;
1334: $disp_key =~ tr/\0/_/;
1335: print $logfile ('Obsolete: '.$disp_key."\n");
1336: $chparms.=$disp_key.' ';
1337: }
1338: }
1339: }
1340: if ($chparms) {
1341: $scrout.='<p><b>'.&mt('Obsolete parameters or saved values').':</b> '
1342: .$chparms.'</p>'
1343: .'<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />'
1344: .&mt('If this resource is in active use, student performance data from the previous version may become inaccessible.')
1345: .'</p><hr />';
1346: }
1347: if ($metadatafields{'copyright'} eq 'priv') {
1348: $scrout.='<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />'
1349: .&mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.')
1350: .'</p><hr />';
1351: }
1352:
1353: # ------------------------------------------------------- Now have all metadata
1354:
1355: my %keywords=();
1356:
1357: if (length($content)<500000) {
1358: my $textonly=$content;
1359: $textonly=~s/\<script[^\<]+\<\/script\>//g;
1360: $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
1361: $textonly=~s/\<[^\>]*\>//g;
1362:
1363: #this is a work simplification for german authors for present
1364: $textonly=HTML::Entities::decode($textonly); #decode HTML-character
1365: $textonly=Encode::Encoder::encode('utf8', $textonly); #encode to perl internal unicode
1366: $textonly=~tr/A-ZÜÄÖ/a-züäö/; #add lowercase rule for german "Umlaute"
1367: $textonly=~s/[\$\&][a-z]\w*//g;
1368: $textonly=~s/[^a-z^ü^ä^ö^ß\s]//g; #dont delete german "Umlaute"
1369:
1370: foreach ($textonly=~m/[^\s]+/g) { #match all but whitespaces
1371: unless ($nokeyref->{$_}) {
1372: $keywords{$_}=1;
1373: }
1374: }
1375:
1376:
1377: }
1378:
1379: foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
1380: $addkey=~s/\s+/ /g;
1381: $addkey=~s/^\s//;
1382: $addkey=~s/\s$//;
1383: if ($addkey=~/\w/) {
1384: $keywords{$addkey}=1;
1385: }
1386: }
1387: # --------------------------------------------------- Now we also have keywords
1388: # =============================================================================
1389: # interactive mode html goes into $intr_scrout
1390: # batch mode throws away this HTML
1391: # additionally all of the field functions have a by product of setting
1392: # $env{'from.'..} so that it can be used by the phase two handler in
1393: # batch mode
1394:
1395: my $intr_scrout.='<br />'
1396: .'<form name="pubform" action="/adm/publish" method="post">';
1397: unless ($env{'form.makeobsolete'}) {
1398: $intr_scrout.='<p class="LC_warning">'
1399: .&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.')
1400: .'</p>'
1401: .'<p><input type="submit" value="'
1402: .&mt('Finalize Publication')
1403: .'" /> <a href="'.&Apache::loncfile::url($source).'">'.&mt('Cancel').'</a></p>';
1404: }
1405: $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();
1406: $intr_scrout.=
1407: &hiddenfield('phase','two').
1408: &hiddenfield('filename',$env{'form.filename'}).
1409: &hiddenfield('allmeta',&escape($allmeta)).
1410: &hiddenfield('dependencies',join(',',keys(%allow)));
1411: unless ($env{'form.makeobsolete'}) {
1412: $intr_scrout.=
1413: &textfield('Title','title',$metadatafields{'title'}).
1414: &textfield('Author(s)','author',$metadatafields{'author'}).
1415: &textfield('Subject','subject',$metadatafields{'subject'});
1416: # --------------------------------------------------- Scan content for keywords
1417:
1418: my $keywords_help = &Apache::loncommon::help_open_topic("Publishing_Keywords");
1419: my $keywordout=<<"END";
1420: <script>
1421: function checkAll(field) {
1422: for (i = 0; i < field.length; i++)
1423: field[i].checked = true ;
1424: }
1425:
1426: function uncheckAll(field) {
1427: for (i = 0; i < field.length; i++)
1428: field[i].checked = false ;
1429: }
1430: </script>
1431: END
1432: $keywordout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Keywords'))
1433: .$keywords_help
1434: .'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />'
1435: .'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />'
1436: .'</p><br />'
1437: .&Apache::loncommon::start_data_table();
1438: my $cols_per_row = 10;
1439: my $colcount=0;
1440: my $wordcount=0;
1441: my $numkeywords = scalar(keys(%keywords));
1442:
1443: foreach my $word (sort(keys(%keywords))) {
1444: if ($colcount == 0) {
1445: $keywordout .= &Apache::loncommon::start_data_table_row();
1446: }
1447: $colcount++;
1448: $wordcount++;
1449: if (($wordcount == $numkeywords) && ($colcount < $cols_per_row)) {
1450: my $colspan = 1+$cols_per_row-$colcount;
1451: $keywordout .= '<td colspan="'.$colspan.'">';
1452: } else {
1453: $keywordout .= '<td>';
1454: }
1455: $keywordout.='<label><input type="checkbox" name="keywords" value="'.$word.'"';
1456: if ($metadatafields{'keywords'}) {
1457: if ($metadatafields{'keywords'}=~/\Q$word\E/) {
1458: $keywordout.=' checked="checked"';
1459: $env{'form.keywords'}.=$word.',';
1460: }
1461: } elsif (&Apache::loncommon::keyword($word)) {
1462: $keywordout.=' checked="checked"';
1463: $env{'form.keywords'}.=$word.',';
1464: }
1465: $keywordout.=' />'.$word.'</label></td>';
1466: if ($colcount == $cols_per_row) {
1467: $keywordout.=&Apache::loncommon::end_data_table_row();
1468: $colcount=0;
1469: }
1470: }
1471: if ($colcount > 0) {
1472: $keywordout .= &Apache::loncommon::end_data_table_row();
1473: }
1474:
1475: $env{'form.keywords'}=~s/\,$//;
1476:
1477: $keywordout.=&Apache::loncommon::end_data_table_row()
1478: .&Apache::loncommon::end_data_table()
1479: .&Apache::lonhtmlcommon::row_closure();
1480:
1481: $intr_scrout.=$keywordout;
1482:
1483: $intr_scrout.=&textfield('Additional Keywords','addkey','');
1484:
1485: $intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
1486:
1487: $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Abstract'))
1488: .'<textarea cols="80" rows="5" name="abstract">'
1489: .$metadatafields{'abstract'}
1490: .'</textarea>'
1491: .&Apache::lonhtmlcommon::row_closure();
1492:
1493: $source=~/\.(\w+)$/;
1494:
1495: $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Grade Levels'))
1496: .&mt('Lowest Grade Level:').' '
1497: .&select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel')
1498: # .&Apache::lonhtmlcommon::row_closure();
1499: # $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Highest Grade Level'))
1500: .' '.&mt('Highest Grade Level:').' '
1501: .&select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel')
1502: .&Apache::lonhtmlcommon::row_closure();
1503:
1504: $intr_scrout.=&textfield('Standards','standards',$metadatafields{'standards'});
1505:
1506: $intr_scrout.=&hiddenfield('mime',$1);
1507:
1508: my $defaultlanguage=$metadatafields{'language'};
1509: $defaultlanguage =~ s/\s*notset\s*//g;
1510: $defaultlanguage =~ s/^,\s*//g;
1511: $defaultlanguage =~ s/,\s*$//g;
1512:
1513: $intr_scrout.=&selectbox('Language','language',
1514: $defaultlanguage,'',
1515: \&Apache::loncommon::languagedescription,
1516: (&Apache::loncommon::languageids),
1517: );
1518:
1519: unless ($metadatafields{'creationdate'}) {
1520: $metadatafields{'creationdate'}=time;
1521: }
1522: $intr_scrout.=&hiddenfield('creationdate',
1523: &Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));
1524:
1525: $intr_scrout.=&hiddenfield('lastrevisiondate',time);
1526:
1527: my $pubowner_last;
1528: if ($style eq 'prv') {
1529: $pubowner_last = 1;
1530: }
1531: if ($courseauthor) {
1532: $metadatafields{'owner'} = $courseauthor;
1533: }
1534: $intr_scrout.=&textfield('Publisher/Owner','owner',
1535: $metadatafields{'owner'},$pubowner_last,$readonly);
1536:
1537: # ---------------------------------------------- Retrofix for unused copyright
1538: if ($metadatafields{'copyright'} eq 'free') {
1539: $metadatafields{'copyright'}='default';
1540: $metadatafields{'sourceavail'}='open';
1541: }
1542: if ($metadatafields{'copyright'} eq 'priv') {
1543: $metadatafields{'copyright'}='domain';
1544: }
1545: # ------------------------------------------------ Dial in reasonable defaults
1546: my $defaultoption=$metadatafields{'copyright'};
1547: unless ($defaultoption) { $defaultoption='default'; }
1548: if ($courseauthor) {
1549: $defaultoption='custom';
1550: $metadatafields{'customdistributionfile'}=$crsaurights;
1551: }
1552: my $defaultsourceoption=$metadatafields{'sourceavail'};
1553: unless ($defaultsourceoption) { $defaultsourceoption='closed'; }
1554: unless ($style eq 'prv') {
1555: # -------------------------------------------------- Correct copyright for rat.
1556: if ($style eq 'rat') {
1557: # -------------------------------------- Retrofix for non-applicable copyright
1558: if ($metadatafields{'copyright'} eq 'public') {
1559: delete $metadatafields{'copyright'};
1560: $defaultoption='default';
1561: }
1562: $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
1563: $defaultoption,$readonly,
1564: \&Apache::loncommon::copyrightdescription,
1565: (grep !/^(public|priv)$/,(&Apache::loncommon::copyrightids)));
1566: } else {
1567: $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
1568: $defaultoption,$readonly,
1569: \&Apache::loncommon::copyrightdescription,
1570: (grep !/^priv$/,(&Apache::loncommon::copyrightids)));
1571: }
1572: my $copyright_help =
1573: &Apache::loncommon::help_open_topic('Publishing_Copyright');
1574: my $replace=&mt('Copyright/Distribution:');
1575: $intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge;
1576:
1577: $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights','',$readonly);
1578: $intr_scrout.=&selectbox('Source Distribution','sourceavail',
1579: $defaultsourceoption,'',
1580: \&Apache::loncommon::source_copyrightdescription,
1581: (&Apache::loncommon::source_copyrightids));
1582: # $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
1583: my $uctitle=&mt('Obsolete');
1584: my $obsolete_checked=($metadatafields{'obsolete'})?' checked="checked"':'';
1585: $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)
1586: .'<input type="checkbox" name="obsolete"'.$obsolete_checked.' />'
1587: .&Apache::lonhtmlcommon::row_closure(1);
1588: $intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File',
1589: 'obsoletereplacement',
1590: $metadatafields{'obsoletereplacement'},'',1);
1591: } else {
1592: $intr_scrout.=&hiddenfield('copyright','private');
1593: }
1594: } else {
1595: $intr_scrout.=
1596: &hiddenfield('title',$metadatafields{'title'}).
1597: &hiddenfield('author',$metadatafields{'author'}).
1598: &hiddenfield('subject',$metadatafields{'subject'}).
1599: &hiddenfield('keywords',$metadatafields{'keywords'}).
1600: &hiddenfield('abstract',$metadatafields{'abstract'}).
1601: &hiddenfield('notes',$metadatafields{'notes'}).
1602: &hiddenfield('mime',$metadatafields{'mime'}).
1603: &hiddenfield('creationdate',$metadatafields{'creationdate'}).
1604: &hiddenfield('lastrevisiondate',time).
1605: &hiddenfield('owner',$metadatafields{'owner'}).
1606: &hiddenfield('lowestgradelevel',$metadatafields{'lowestgradelevel'}).
1607: &hiddenfield('standards',$metadatafields{'standards'}).
1608: &hiddenfield('highestgradelevel',$metadatafields{'highestgradelevel'}).
1609: &hiddenfield('language',$metadatafields{'language'}).
1610: &hiddenfield('copyright',$metadatafields{'copyright'}).
1611: &hiddenfield('sourceavail',$metadatafields{'sourceavail'}).
1612: &hiddenfield('customdistributionfile',$metadatafields{'customdistributionfile'}).
1613: &hiddenfield('obsolete',1).
1614: &text_with_browse_field('Suggested Replacement for Obsolete File',
1615: 'obsoletereplacement',
1616: $metadatafields{'obsoletereplacement'},'',1);
1617: }
1618: if (!$batch) {
1619: $scrout.=$intr_scrout
1620: .&Apache::lonhtmlcommon::end_pick_box()
1621: .'<p><input type="submit" value="'
1622: .&mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication')
1623: .'" /></p>'
1624: .'</form>';
1625: }
1626: return($scrout,0);
1627: }
1628:
1629: sub getnokey {
1630: my ($includedir) = @_;
1631: my $nokey={};
1632: my $fh=Apache::File->new($includedir.'/un_keyword.tab');
1633: while (<$fh>) {
1634: my $word=$_;
1635: chomp($word);
1636: $nokey->{$word}=1;
1637: }
1638: return $nokey;
1639: }
1640:
1641: #########################################
1642: #########################################
1643:
1644: =pod
1645:
1646: =item B<phasetwo>
1647:
1648: Render second interface showing status of publication steps.
1649: This is publication step two.
1650:
1651: Parameters:
1652:
1653: =over 4
1654:
1655: =item I<$source>
1656:
1657: =item I<$target>
1658:
1659: =item I<$style>
1660:
1661: =item I<$distarget>
1662:
1663: =item I<$batch>
1664:
1665: =item I<$usebuffer>
1666:
1667: =back
1668:
1669: Returns:
1670:
1671: =over 4
1672:
1673: =item integer or array
1674:
1675: if $userbuffer arg is true, and if caller wants an array
1676: then the array ($output,$rtncode) will be returned, otherwise
1677: just the $rtncode will be returned. $rtncode is an integer:
1678:
1679: 0: fail
1680: 1: success
1681:
1682: =back
1683:
1684: =cut
1685:
1686: #'stupid emacs
1687: #########################################
1688: #########################################
1689: sub phasetwo {
1690:
1691: my ($r,$source,$target,$style,$distarget,$batch,$usebuffer)=@_;
1692: $source=~s/\/+/\//g;
1693: $target=~s/\/+/\//g;
1694: #
1695: # Unless trying to get rid of something, check name validity
1696: #
1697: my $output;
1698: unless ($env{'form.obsolete'}) {
1699: if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {
1700: $output = '<span class="LC_error">'.
1701: &mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").
1702: '</span>';
1703: if ($usebuffer) {
1704: if (wantarray) {
1705: return ($output,0);
1706: } else {
1707: return 0;
1708: }
1709: } else {
1710: $r->print($output);
1711: return 0;
1712: }
1713: }
1714: unless ($target=~/\.(\w+)$/) {
1715: $output = '<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>';
1716: if ($usebuffer) {
1717: if (wantarray) {
1718: return ($output,0);
1719: } else {
1720: return 0;
1721: }
1722: } else {
1723: $r->print($output);
1724: return 0;
1725: }
1726: }
1727: if ($target=~/\.(\d+)\.(\w+)$/) {
1728: $output = '<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>';
1729: if ($usebuffer) {
1730: if (wantarray) {
1731: return ($output,0);
1732: } else {
1733: return 0;
1734: }
1735: } else {
1736: $r->print($output);
1737: return 0;
1738: }
1739: }
1740: }
1741:
1742: #
1743: # End name check
1744: #
1745: $distarget=~s/\/+/\//g;
1746: my $logfile;
1747: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
1748: $output = '<span class="LC_error">'.
1749: &mt('No write permission to user directory, FAIL').'</span>';
1750: if ($usebuffer) {
1751: if (wantarray) {
1752: return ($output,0);
1753: } else {
1754: return 0;
1755: }
1756: } else {
1757: return 0;
1758: }
1759: }
1760:
1761: if ($source =~ /\.rights$/) {
1762: $output = '<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>';
1763: unless ($usebuffer) {
1764: $r->print($output);
1765: $output = '';
1766: }
1767: }
1768:
1769: print $logfile
1770: "\n================= Publish ".localtime()." Phase Two ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n";
1771:
1772: %metadatafields=();
1773: %metadatakeys=();
1774:
1775: &metaeval(&unescape($env{'form.allmeta'}));
1776:
1777: if ($batch) {
1778: my %commonaccess;
1779: map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess');
1780: if ($commonaccess{'dist'}) {
1781: unless ($style eq 'prv') {
1782: if ($env{'form.commondistselect'} eq 'custom') {
1783: unless ($source =~ /\.rights$/) {
1784: if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) {
1785: $env{'form.customdistributionfile'} = $env{'form.commoncustomrights'};
1786: $env{'form.copyright'} = $env{'form.commondistselect'};
1787: }
1788: }
1789: } elsif ($env{'form.commondistselect'} =~ /^default|domain|public$/) {
1790: $env{'form.copyright'} = $env{'form.commondistselect'};
1791: }
1792: }
1793: }
1794: unless ($style eq 'prv') {
1795: if ($commonaccess{'source'}) {
1796: if (($env{'form.commonsourceselect'} eq 'open') || ($env{'form.commonsourceselect'} eq 'closed')) {
1797: $env{'form.sourceavail'} = $env{'form.commonsourceselect'};
1798: }
1799: }
1800: }
1801: }
1802:
1803: $metadatafields{'title'}=$env{'form.title'};
1804: $metadatafields{'author'}=$env{'form.author'};
1805: $metadatafields{'subject'}=$env{'form.subject'};
1806: $metadatafields{'notes'}=$env{'form.notes'};
1807: $metadatafields{'abstract'}=$env{'form.abstract'};
1808: $metadatafields{'mime'}=$env{'form.mime'};
1809: $metadatafields{'language'}=$env{'form.language'};
1810: $metadatafields{'creationdate'}=$env{'form.creationdate'};
1811: $metadatafields{'lastrevisiondate'}=$env{'form.lastrevisiondate'};
1812: $metadatafields{'owner'}=$env{'form.owner'};
1813: $metadatafields{'copyright'}=$env{'form.copyright'};
1814: $metadatafields{'standards'}=$env{'form.standards'};
1815: $metadatafields{'lowestgradelevel'}=$env{'form.lowestgradelevel'};
1816: $metadatafields{'highestgradelevel'}=$env{'form.highestgradelevel'};
1817: $metadatafields{'customdistributionfile'}=
1818: $env{'form.customdistributionfile'};
1819: $metadatafields{'sourceavail'}=$env{'form.sourceavail'};
1820: $metadatafields{'obsolete'}=$env{'form.obsolete'};
1821: $metadatafields{'obsoletereplacement'}=
1822: $env{'form.obsoletereplacement'};
1823: $metadatafields{'dependencies'}=$env{'form.dependencies'};
1824: $metadatafields{'modifyinguser'}=$env{'user.name'}.':'.
1825: $env{'user.domain'};
1826: $metadatafields{'authorspace'}=$cuname.':'.$cudom;
1827: $metadatafields{'domain'}=$cudom;
1828:
1829: my $crsauthor;
1830: if ($env{'request.course.id'}) {
1831: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1832: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1833: if ($distarget =~ m{^/res/$cdom/$cnum}) {
1834: $crsauthor = 1;
1835: my $default_rights = "/res/$cdom/$cnum/default.rights";
1836: unless ($distarget eq $default_rights) {
1837: $metadatafields{'copyright'} = 'custom';
1838: $metadatafields{'customdistributionfile'} = $default_rights;
1839: }
1840: }
1841: }
1842:
1843: my $allkeywords=$env{'form.addkey'};
1844: if (exists($env{'form.keywords'})) {
1845: if (ref($env{'form.keywords'})) {
1846: $allkeywords .= ','.join(',',@{$env{'form.keywords'}});
1847: } else {
1848: $allkeywords .= ','.$env{'form.keywords'};
1849: }
1850: }
1851: $allkeywords=~s/[\"\']//g;
1852: $allkeywords=~s/\s*[\;\,]\s*/\,/g;
1853: $allkeywords=~s/\s+/ /g;
1854: $allkeywords=~s/^[ \,]//;
1855: $allkeywords=~s/[ \,]$//;
1856: $metadatafields{'keywords'}=$allkeywords;
1857:
1858: # check if custom distribution file is specified
1859: if ($metadatafields{'copyright'} eq 'custom') {
1860: my $file=$metadatafields{'customdistributionfile'};
1861: unless ($file=~/\.rights$/) {
1862: $output .= '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').
1863: '</span>';
1864: if ($usebuffer) {
1865: if (wantarray) {
1866: return ($output,0);
1867: } else {
1868: return 0;
1869: }
1870: } else {
1871: $r->print($output);
1872: return 0;
1873: }
1874: }
1875: }
1876: {
1877: print $logfile "\nWrite metadata file for ".$source;
1878: my $mfh;
1879: unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
1880: $output .= '<span class="LC_error">'.&mt('Could not write metadata, FAIL').
1881: '</span>';
1882: if ($usebuffer) {
1883: if (wantarray) {
1884: return ($output,0);
1885: } else {
1886: return 0;
1887: }
1888: } else {
1889: $r->print($output);
1890: return 0;
1891: }
1892: }
1893: foreach my $field (sort(keys(%metadatafields))) {
1894: unless ($field=~/\./) {
1895: my $unikey=$field;
1896: $unikey=~/^([A-Za-z]+)/;
1897: my $tag=$1;
1898: $tag=~tr/A-Z/a-z/;
1899: print $mfh "\n\<$tag";
1900: foreach my $item (split(/\,/,$metadatakeys{$unikey})) {
1901: my $value=$metadatafields{$unikey.'.'.$item};
1902: $value=~s/\"/\'\'/g;
1903: print $mfh ' '.$item.'="'.$value.'"';
1904: }
1905: print $mfh '>'.
1906: &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
1907: .'</'.$tag.'>';
1908: }
1909: }
1910:
1911: $output .= '<p>'.&mt('Wrote Metadata').'</p>';
1912: unless ($usebuffer) {
1913: $r->print($output);
1914: $output = '';
1915: }
1916: print $logfile "\nWrote metadata";
1917: }
1918:
1919: # -------------------------------- Synchronize entry with SQL metadata database
1920:
1921: $metadatafields{'url'} = $distarget;
1922: $metadatafields{'version'} = 'current';
1923:
1924: unless ($crsauthor) {
1925: my ($error,$success) = &store_metadata(%metadatafields);
1926: if ($success) {
1927: $output .= '<p>'.&mt('Synchronized SQL metadata database').'</p>';
1928: print $logfile "\nSynchronized SQL metadata database";
1929: } else {
1930: $output .= $error;
1931: print $logfile "\n".$error;
1932: }
1933: unless ($usebuffer) {
1934: $r->print($output);
1935: $output = '';
1936: }
1937: }
1938: # --------------------------------------------- Delete author resource messages
1939: my $delresult=&Apache::lonmsg::del_url_author_res_msg($target);
1940: $output .= '<p>'.&mt('Removing error messages:').' '.$delresult.'</p>';
1941: unless ($usebuffer) {
1942: $r->print($output);
1943: $output = '';
1944: }
1945: print $logfile "\nRemoving error messages: $delresult";
1946: # ----------------------------------------------------------- Copy old versions
1947:
1948: if (-e $target) {
1949: my $filename;
1950: my $maxversion=0;
1951: $target=~/(.*)\/([^\/]+)\.(\w+)$/;
1952: my $srcf=$2;
1953: my $srct=$3;
1954: my $srcd=$1;
1955: my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1956: unless ($srcd=~/^\Q$docroot\E\/res/) {
1957: print $logfile "\nPANIC: Target dir is ".$srcd;
1958: $output .=
1959: "<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>";
1960: if ($usebuffer) {
1961: if (wantarray) {
1962: return ($output,0);
1963: } else {
1964: return 0;
1965: }
1966: } else {
1967: $r->print($output);
1968: return 0;
1969: }
1970: }
1971: opendir(DIR,$srcd);
1972: while ($filename=readdir(DIR)) {
1973: if (-l $srcd.'/'.$filename) {
1974: unlink($srcd.'/'.$filename);
1975: unlink($srcd.'/'.$filename.'.meta');
1976: } else {
1977: if ($filename=~/^\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {
1978: $maxversion=($1>$maxversion)?$1:$maxversion;
1979: }
1980: }
1981: }
1982: closedir(DIR);
1983: $maxversion++;
1984: $output .= '<p>'.&mt('Creating old version [_1]',$maxversion).'</p>';
1985: unless ($usebuffer) {
1986: $r->print($output);
1987: $output = '';
1988: }
1989: print $logfile "\nCreating old version ".$maxversion."\n";
1990:
1991: my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
1992:
1993: if (copy($target,$copyfile)) {
1994: print $logfile "Copied old target to ".$copyfile."\n";
1995: $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file'));
1996: unless ($usebuffer) {
1997: $r->print($output);
1998: $output = '';
1999: }
2000: } else {
2001: print $logfile "Unable to write ".$copyfile.':'.$!."\n";
2002: $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1);
2003: if ($usebuffer) {
2004: if (wantarray) {
2005: return ($output,0);
2006: } else {
2007: return 0;
2008: }
2009: } else {
2010: $r->print($output);
2011: return 0;
2012: }
2013: }
2014:
2015: # --------------------------------------------------------------- Copy Metadata
2016:
2017: $copyfile=$copyfile.'.meta';
2018:
2019: if (copy($target.'.meta',$copyfile)) {
2020: print $logfile "Copied old target metadata to ".$copyfile."\n";
2021: $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata'));
2022: unless ($usebuffer) {
2023: $r->print($output);
2024: $output = '';
2025: }
2026: } else {
2027: print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
2028: if (-e $target.'.meta') {
2029: $output .= &Apache::lonhtmlcommon::confirm_success(
2030: &mt('Failed to write old metadata copy').", $!",1);
2031: if ($usebuffer) {
2032: if (wantarray) {
2033: return ($output,0);
2034: } else {
2035: return 0;
2036: }
2037: } else {
2038: $r->print($output);
2039: return 0;
2040: }
2041: }
2042: }
2043: } else {
2044: $output .= '<p>'.&mt('Initial version').'</p>';
2045: unless ($usebuffer) {
2046: $r->print($output);
2047: $output = '';
2048: }
2049: print $logfile "\nInitial version";
2050: }
2051:
2052: # ---------------------------------------------------------------- Write Source
2053: my $copyfile=$target;
2054:
2055: my @parts=split(/\//,$copyfile);
2056: my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
2057:
2058: my $count;
2059: for ($count=5;$count<$#parts;$count++) {
2060: $path.="/$parts[$count]";
2061: if ((-e $path)!=1) {
2062: print $logfile "\nCreating directory ".$path;
2063: mkdir($path,0777);
2064: $output .= '<p>'
2065: .&mt('Created directory [_1]'
2066: ,'<span class="LC_filename">'.$parts[$count].'</span>')
2067: .'</p>';
2068: unless ($usebuffer) {
2069: $r->print($output);
2070: $output = '';
2071: }
2072: }
2073: }
2074:
2075: if (copy($source,$copyfile)) {
2076: print $logfile "\nCopied original source to ".$copyfile."\n";
2077: $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied source file'));
2078: unless ($usebuffer) {
2079: $r->print($output);
2080: $output = '';
2081: }
2082: } else {
2083: print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
2084: $output .= &Apache::lonhtmlcommon::confirm_success(
2085: &mt('Failed to copy source').", $!",1);
2086: if ($usebuffer) {
2087: if (wantarray) {
2088: return ($output,0);
2089: } else {
2090: return 0;
2091: }
2092: } else {
2093: $r->print($output);
2094: return 0;
2095: }
2096: }
2097:
2098: # ---------------------------------------------- Delete local tmp-preview files
2099: unlink($copyfile.'.tmp');
2100: # --------------------------------------------------------------- Copy Metadata
2101:
2102: $copyfile=$copyfile.'.meta';
2103:
2104: if (copy($source.'.meta',$copyfile)) {
2105: print $logfile "\nCopied original metadata to ".$copyfile."\n";
2106: $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata'));
2107: unless ($usebuffer) {
2108: $r->print($output);
2109: $output = '';
2110: }
2111: } else {
2112: print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
2113: $output .= &Apache::lonhtmlcommon::confirm_success(
2114: &mt('Failed to write metadata copy').", $!",1);
2115: if ($usebuffer) {
2116: if (wantarray) {
2117: return ($output,0);
2118: } else {
2119: return 0;
2120: }
2121: } else {
2122: $r->print($output);
2123: return 0;
2124: }
2125: }
2126: unless ($usebuffer) {
2127: $r->rflush;
2128: }
2129:
2130: # ------------------------------------------------------------- Trigger updates
2131: push(@{$modified_urls},[$target,$source]);
2132: unless ($registered_cleanup) {
2133: my $handlers = $r->get_handlers('PerlCleanupHandler');
2134: $r->set_handlers('PerlCleanupHandler' => [\¬ify,@{$handlers}]);
2135: $registered_cleanup=1;
2136: }
2137:
2138: # ---------------------------------------------------------- Clear local caches
2139: my $thisdistarget=$target;
2140: $thisdistarget=~s/^\Q$docroot\E//;
2141: &Apache::lonnet::devalidate_cache_new('resversion',$target);
2142: &Apache::lonnet::devalidate_cache_new('meta',
2143: &Apache::lonnet::declutter($thisdistarget));
2144:
2145: # ------------------------------------------------------------- Everything done
2146: $logfile->close();
2147: $output .= '<p class="LC_success">'.&mt('Done').'</p>';
2148: unless ($usebuffer) {
2149: $r->print($output);
2150: $output = '';
2151: }
2152:
2153: # ------------------------------------------------ Provide link to new resource
2154: unless ($batch) {
2155:
2156: my $thissrc=&Apache::loncfile::url($source);
2157: my $thissrcdir=$thissrc;
2158: $thissrcdir=~s/\/[^\/]+$/\//;
2159:
2160: $output .=
2161: &Apache::lonhtmlcommon::actionbox([
2162: '<a href="'.$thisdistarget.'">'.
2163: &mt('View Published Version').
2164: '</a>',
2165: '<a href="'.$thissrc.'">'.
2166: &mt('Back to Source').
2167: '</a>',
2168: '<a href="'.$thissrcdir.'">'.
2169: &mt('Back to Source Directory').
2170: '</a>']);
2171: unless ($usebuffer) {
2172: $r->print($output);
2173: $output = '';
2174: }
2175: }
2176:
2177: if ($usebuffer) {
2178: if (wantarray) {
2179: return ($output,1);
2180: } else {
2181: return 1;
2182: }
2183: } else {
2184: if (wantarray) {
2185: return ('',1);
2186: } else {
2187: return 1;
2188: }
2189: }
2190: }
2191:
2192: # =============================================================== Notifications
2193: sub notify {
2194: # --------------------------------------------------- Send update notifications
2195: foreach my $targetsource (@{$modified_urls}){
2196: my ($target,$source)=@{$targetsource};
2197: my $logfile=Apache::File->new('>>'.$source.'.log');
2198: print $logfile "\nCleanup phase: Notifications\n";
2199: my @subscribed=&get_subscribed_hosts($target);
2200: foreach my $subhost (@subscribed) {
2201: print $logfile "\nNotifying host ".$subhost.':';
2202: my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
2203: print $logfile $reply;
2204: }
2205: # ---------------------------------------- Send update notifications, meta only
2206: my @subscribedmeta=&get_subscribed_hosts("$target.meta");
2207: foreach my $subhost (@subscribedmeta) {
2208: print $logfile "\nNotifying host for metadata only ".$subhost.':';
2209: my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
2210: $subhost);
2211: print $logfile $reply;
2212: }
2213: # --------------------------------------------------- Notify subscribed courses
2214: my %courses=&coursedependencies($target);
2215: my $now=time;
2216: foreach my $course (keys(%courses)) {
2217: print $logfile "\nNotifying course ".$course.':';
2218: my ($cdom,$cname)=split(/\_/,$course);
2219: my $reply=&Apache::lonnet::cput
2220: ('versionupdate',{$target => $now},$cdom,$cname);
2221: print $logfile $reply;
2222: }
2223: print $logfile "\n============ Done ============\n";
2224: $logfile->close();
2225: }
2226: if ($lock) { &Apache::lonnet::remove_lock($lock); }
2227: return OK;
2228: }
2229:
2230: #########################################
2231:
2232: sub batchpublish {
2233: my ($r,$srcfile,$targetfile,$nokeyref,$usebuffer)=@_;
2234: #publication pollutes %env with form.* values
2235: my %oldenv=%env;
2236: $srcfile=~s/\/+/\//g;
2237: $targetfile=~s/\/+/\//g;
2238:
2239: my $docroot=$r->dir_config('lonDocRoot');
2240: my $thisdistarget=$targetfile;
2241: $thisdistarget=~s/^\Q$docroot\E//;
2242:
2243:
2244: %metadatafields=();
2245: %metadatakeys=();
2246: $srcfile=~/\.(\w+)$/;
2247: my $thistype=$1;
2248:
2249:
2250: my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
2251:
2252: my $output = '<h2>'
2253: .&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
2254: .'</h2>';
2255: unless ($usebuffer) {
2256: $r->print($output);
2257: $output = '';
2258: }
2259:
2260: # phase one takes
2261: # my ($source,$target,$style,$batch)=@_;
2262: my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1,$nokeyref);
2263:
2264: if ($usebuffer) {
2265: $output .= '<p>'.$outstring.'</p>';
2266: } else {
2267: $r->print('<p>'.$outstring.'</p>');
2268: }
2269: # phase two takes
2270: # my ($source,$target,$style,$distarget,batch)=@_;
2271: # $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...
2272: if (!$error) {
2273: if ($usebuffer) {
2274: my ($result,$error) = &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1,$usebuffer);
2275: $output .= '<p>'.$result.'</p>';
2276: } else {
2277: &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
2278: }
2279: }
2280: %env=%oldenv;
2281: if ($usebuffer) {
2282: return $output;
2283: } else {
2284: return '';
2285: }
2286: }
2287:
2288: #########################################
2289:
2290: sub publishdirectory {
2291: my ($r,$fn,$thisdisfn,$nokeyref,$crsauthor)=@_;
2292: $fn=~s/\/+/\//g;
2293: $thisdisfn=~s/\/+/\//g;
2294: my $thisdisresdir=$thisdisfn;
2295: $thisdisresdir=~s/^\/priv\//\/res\//;
2296: my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir;
2297: $r->print('<form name="pubdirpref" method="post" action="">'
2298: .&Apache::lonhtmlcommon::start_pick_box()
2299: .&Apache::lonhtmlcommon::row_title(&mt('Directory'))
2300: .'<span class="LC_filename">'.$thisdisfn.'</span>'
2301: .&Apache::lonhtmlcommon::row_closure()
2302: .&Apache::lonhtmlcommon::row_title(&mt('Target'))
2303: .'<span class="LC_filename">'.$thisdisresdir.'</span>'
2304: );
2305: my %reasons = &Apache::lonlocal::texthash(
2306: mod => 'Authoring Space file postdates published file',
2307: modmeta => 'Authoring Space metadata file postdates published file',
2308: unpub => 'Resource is unpublished',
2309: );
2310:
2311: my $dirptr=16384; # Mask indicating a directory in stat.cmode.
2312: unless ($env{'form.phase'} eq 'two') {
2313: # ask user what they want
2314: $r->print(&Apache::lonhtmlcommon::row_closure()
2315: .&Apache::lonhtmlcommon::row_title(&mt('Options')
2316: .&Apache::loncommon::help_open_topic('Publishing_Directory_Options')));
2317: $r->print(&hiddenfield('phase','two').
2318: &hiddenfield('filename',$env{'form.filename'}).
2319: '<fieldset><legend>'.&mt('Recurse').'</legend>'.
2320: &checkbox('pubrec','include subdirectories').
2321: '</fieldset>'.
2322: '<fieldset><legend>'.&mt('Force').'</legend>'.
2323: &checkbox('forcerepub','force republication of previously published files').'<br />'.
2324: &checkbox('forceoverride','force directory level metadata over existing').
2325: '</fieldset>'.
2326: '<fieldset><legend>'.&mt('Exclude').'</legend>'.
2327: &checkbox('excludeunpub','exclude currently unpublished files').'<br />'.
2328: &checkbox('excludemod','exclude modified files').'<br />'.
2329: &checkbox('excludemodmeta','exclude files with modified metadata').
2330: '</fieldset>'.
2331: '<fieldset><legend>'.&mt('Actions').'</legend>'.
2332: &checkbox('obsolete','make file(s) obsolete').'<br />');
2333: unless ($crsauthor) {
2334: $r->print(&common_access('dist',&mt('apply common copyright/distribution'),
2335: ['default','domain','public','custom']).'<br />');
2336: }
2337: $r->print(&common_access('source',&mt('apply common source availability'),
2338: ['closed','open']).
2339: '</fieldset>'
2340: );
2341: $r->print(&Apache::lonhtmlcommon::row_closure(1)
2342: .&Apache::lonhtmlcommon::end_pick_box()
2343: .'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>'
2344: );
2345: $lock=0;
2346: } else {
2347: $r->print(&Apache::lonhtmlcommon::row_closure(1)
2348: .&Apache::lonhtmlcommon::end_pick_box()
2349: );
2350: my %commonaccess;
2351: map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess');
2352: unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
2353: # actually publish things
2354: opendir(DIR,$fn);
2355: my @files=sort(readdir(DIR));
2356: foreach my $filename (@files) {
2357: my ($cdev,$cino,$cmode,$cnlink,
2358: $cuid,$cgid,$crdev,$csize,
2359: $catime,$cmtime,$cctime,
2360: $cblksize,$cblocks)=stat($fn.'/'.$filename);
2361:
2362: my $extension='';
2363: if ($filename=~/\.(\w+)$/) { $extension=$1; }
2364: if ($cmode&$dirptr) {
2365: if (($filename!~/^\./) && ($env{'form.pubrec'})) {
2366: &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename,$nokeyref,$crsauthor);
2367: }
2368: } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
2369: ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
2370: # find out publication status and/or existing metadata
2371: my $publishthis=0;
2372: my $skipthis;
2373: if (-e $resdir.'/'.$filename) {
2374: my ($rdev,$rino,$rmode,$rnlink,
2375: $ruid,$rgid,$rrdev,$rsize,
2376: $ratime,$rmtime,$rctime,
2377: $rblksize,$rblocks)=stat($resdir.'/'.$filename);
2378: if (($rmtime<$cmtime) || ($env{'form.forcerepub'})) {
2379: # previously published, modified now
2380: if ($env{'form.excludemod'}) {
2381: $skipthis='mod';
2382: } else {
2383: $publishthis=1;
2384: }
2385: }
2386: unless ($skipthis) {
2387: my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];
2388: my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];
2389: if ( $meta_rmtime<$meta_cmtime ) {
2390: if ($env{'form.excludemodmeta'}) {
2391: $skipthis='modmeta';
2392: $publishthis=0;
2393: } else {
2394: $publishthis=1;
2395: }
2396: } else {
2397: unless (&Apache::loncommon::fileembstyle($extension) eq 'prv') {
2398: if ($commonaccess{'dist'}) {
2399: my ($currdist,$currdistfile,$currsourceavail);
2400: my $currdist = &Apache::lonnet::metadata($thisdisresdir.'/'.$filename,'copyright');
2401: if ($currdist eq 'custom') {
2402: $currdistfile = &Apache::lonnet::metadata($thisdisresdir.'/'.$filename,'customdistributionfile');
2403: }
2404: if ($env{'form.commondistselect'} eq 'custom') {
2405: if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) {
2406: if ($currdist eq 'custom') {
2407: unless ($env{'form.commoncustomrights'} eq $currdistfile) {
2408: $publishthis=1;
2409: }
2410: } else {
2411: $publishthis=1;
2412: }
2413: }
2414: } elsif ($env{'form.commondistselect'} =~ /^default|domain|public$/) {
2415: unless ($currdist eq $env{'form.commondistselect'}) {
2416: $publishthis=1;
2417: }
2418: }
2419: }
2420: }
2421: }
2422: }
2423: } else {
2424: # never published
2425: if ($env{'form.excludeunpub'}) {
2426: $skipthis='unpub';
2427: } else {
2428: $publishthis=1;
2429: }
2430: }
2431:
2432: if ($publishthis) {
2433: &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename,$nokeyref);
2434: } else {
2435: my $reason;
2436: if ($skipthis) {
2437: $reason = $reasons{$skipthis};
2438: } else {
2439: $reason = &mt('No changes needed to published resource or metadata');
2440: }
2441: $r->print('<br />'.&mt('Skipping').' '.$filename);
2442: if ($reason) {
2443: $r->print(' ('.$reason.')');
2444: }
2445: $r->print('<br />');
2446: }
2447: $r->rflush();
2448: }
2449: }
2450: closedir(DIR);
2451: }
2452: }
2453:
2454: #########################################
2455: # publish a default.meta file
2456:
2457: sub defaultmetapublish {
2458: my ($r,$fn,$cuname,$cudom)=@_;
2459: unless (-e $fn) {
2460: return HTTP_NOT_FOUND;
2461: }
2462: my $target=$fn;
2463: $target=~s/^\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/priv\//\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/res\//;
2464:
2465:
2466: &Apache::loncommon::content_type($r,'text/html');
2467: $r->send_http_header;
2468:
2469: $r->print(&Apache::loncommon::start_page('Metadata Publication'));
2470:
2471: # ---------------------------------------------------------------- Write Source
2472: my $copyfile=$target;
2473:
2474: my @parts=split(/\//,$copyfile);
2475: my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
2476:
2477: my $count;
2478: for ($count=5;$count<$#parts;$count++) {
2479: $path.="/$parts[$count]";
2480: if ((-e $path)!=1) {
2481: mkdir($path,0777);
2482: $r->print('<p>'
2483: .&mt('Created directory [_1]'
2484: ,'<span class="LC_filename">'.$parts[$count].'</span>')
2485: .'</p>'
2486: );
2487: }
2488: }
2489:
2490: if (copy($fn,$copyfile)) {
2491: $r->print('<p>'.&mt('Copied source file').'</p>');
2492: } else {
2493: return "<span class=\"LC_error\">".
2494: &mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>";
2495: }
2496:
2497: # --------------------------------------------------- Send update notifications
2498:
2499: my @subscribed=&get_subscribed_hosts($target);
2500: foreach my $subhost (@subscribed) {
2501: $r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;
2502: my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
2503: $r->print($reply.'</p><br />');$r->rflush;
2504: }
2505: # ------------------------------------------------------------------- Link back
2506: $r->print("<a href='".&Apache::loncfile::display($fn)."'>".&mt('Back to Metadata').'</a>');
2507: $r->print(&Apache::loncommon::end_page());
2508: return OK;
2509: }
2510: #########################################
2511:
2512: =pod
2513:
2514: =item B<handler>
2515:
2516: A basic outline of the handler subroutine follows.
2517:
2518: =over 4
2519:
2520: =item *
2521:
2522: Get query string for limited number of parameters.
2523:
2524: =item *
2525:
2526: Check filename.
2527:
2528: =item *
2529:
2530: File is there and owned, init lookup tables.
2531:
2532: =item *
2533:
2534: Start page output.
2535:
2536: =item *
2537:
2538: Evaluate individual file, and then output information.
2539:
2540: =item *
2541:
2542: Publishing from $thisfn to $thistarget with $thisembstyle.
2543:
2544: =back
2545:
2546: =cut
2547:
2548: #########################################
2549: #########################################
2550: sub handler {
2551: my $r=shift;
2552:
2553: if ($r->header_only) {
2554: &Apache::loncommon::content_type($r,'text/html');
2555: $r->send_http_header;
2556: return OK;
2557: }
2558:
2559: # Get query string for limited number of parameters
2560:
2561: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
2562: ['filename']);
2563:
2564: # -------------------------------------- Flag and buffer for registered cleanup
2565: $registered_cleanup=0;
2566: @{$modified_urls}=();
2567: # -------------------------------------------------------------- Check filename
2568:
2569: my $fn=&unescape($env{'form.filename'});
2570: ($cuname,$cudom)=&Apache::lonnet::constructaccess($fn);
2571: # ----------------------------------------------------- Do we have permissions?
2572: unless (($cuname) && ($cudom)) {
2573: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
2574: ' trying to publish file '.$env{'form.filename'}.
2575: ' - not authorized',
2576: $r->filename);
2577: return HTTP_NOT_ACCEPTABLE;
2578: }
2579: # ----------------------------------------------------------------- Get docroot
2580: $docroot=$r->dir_config('lonDocRoot');
2581:
2582:
2583: # special publication: default.meta file
2584: if ($fn=~/\/default.meta$/) {
2585: return &defaultmetapublish($r,$fn,$cuname,$cudom);
2586: }
2587: $fn=~s/\.meta$//;
2588:
2589: # sanity test on the filename
2590:
2591: unless ($fn) {
2592: $r->log_reason($cuname.' at '.$cudom.
2593: ' trying to publish empty filename', $r->filename);
2594: return HTTP_NOT_FOUND;
2595: }
2596:
2597: unless (-e $docroot.$fn) {
2598: $r->log_reason($cuname.' at '.$cudom.
2599: ' trying to publish non-existing file '.
2600: $env{'form.filename'}.' ('.$fn.')',
2601: $r->filename);
2602: return HTTP_NOT_FOUND;
2603: }
2604:
2605: # --------------------------------- File is there and owned, start page output
2606:
2607: &Apache::loncommon::content_type($r,'text/html');
2608: $r->send_http_header;
2609:
2610: # Breadcrumbs
2611: &Apache::lonhtmlcommon::clear_breadcrumbs();
2612: my $crumbtext = 'Authoring Space';
2613: my $crumbhref = &Apache::loncommon::authorspace($fn);
2614: my $crsauthor;
2615: if ($env{'request.course.id'}) {
2616: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2617: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2618: if ($crumbhref eq "/priv/$cdom/$cnum/") {
2619: $crumbtext = 'Course Authoring Space';
2620: $crsauthor = 1;
2621: }
2622: }
2623: &Apache::lonhtmlcommon::add_breadcrumb({
2624: 'text' => $crumbtext,
2625: 'href' => $crumbhref,
2626: });
2627: &Apache::lonhtmlcommon::add_breadcrumb({
2628: 'text' => 'Resource Publication',
2629: 'href' => '',
2630: });
2631:
2632: my $js='<script type="text/javascript">'.
2633: &Apache::loncommon::browser_and_searcher_javascript().
2634: '</script>';
2635: my $startargs = {};
2636: if ($fn=~/\/$/) {
2637: unless ($env{'form.phase'} eq 'two') {
2638: $startargs->{'add_entries'} = { onload => 'javascript:setDefaultAccess();' };
2639: $js .= <<"END";
2640: <script type="text/javascript">
2641: // <![CDATA[
2642: function showHideAccess(caller,div) {
2643: if (document.getElementById(div)) {
2644: if (caller.checked) {
2645: document.getElementById(div).style.display='inline-block';
2646: } else {
2647: document.getElementById(div).style.display='none';
2648: }
2649: }
2650: }
2651:
2652: function showHideCustom(caller,divid) {
2653: if (document.getElementById(divid)) {
2654: if (caller.options[caller.selectedIndex].value == 'custom') {
2655: document.getElementById(divid).style.display="inline-block";
2656: } else {
2657: document.getElementById(divid).style.display="none";
2658: }
2659: }
2660: }
2661: function setDefaultAccess() {
2662: var chkids = Array('LC_commondist','LC_commonsource');
2663: for (var i=0; i<chkids.length; i++) {
2664: if (document.getElementById(chkids[i])) {
2665: document.getElementById(chkids[i]).checked = false;
2666: }
2667: if (document.getElementById(chkids[i]+'select')) {
2668: document.getElementById(chkids[i]+'select').selectedIndex = 0;
2669: }
2670: if (document.getElementById(chkids[i]+'div')) {
2671: document.getElementById(chkids[i]+'div').style.display = 'none';
2672: }
2673: }
2674: }
2675: // ]]>
2676: </script>
2677:
2678: END
2679: }
2680: }
2681: $r->print(&Apache::loncommon::start_page('Resource Publication',$js,$startargs)
2682: .&Apache::lonhtmlcommon::breadcrumbs()
2683: .&Apache::loncommon::head_subbox(
2684: &Apache::loncommon::CSTR_pageheader($docroot.$fn))
2685: );
2686:
2687: my $thisdisfn=&HTML::Entities::encode($fn,'<>&"');
2688: my $thistarget=$fn;
2689: $thistarget=~s/^\/priv\//\/res\//;
2690: my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"');
2691: my $nokeyref = &getnokey($r->dir_config('lonIncludes'));
2692:
2693: if ($fn=~/\/$/) {
2694: # -------------------------------------------------------- This is a directory
2695: &publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref,$crsauthor);
2696: $r->print(
2697: '<br /><br />'.
2698: &Apache::lonhtmlcommon::actionbox([
2699: '<a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>']));
2700: } else {
2701: # ---------------------- Evaluate individual file, and then output information.
2702: $fn=~/\.(\w+)$/;
2703: my $thistype=$1;
2704: my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
2705: if ($thistype eq 'page') { $thisembstyle = 'rat'; }
2706:
2707: $r->print('<h2>'
2708: .&mt('Publishing [_1]'
2709: ,'<span class="LC_filename">'.$thisdisfn.'</span>')
2710: .'</h2>'
2711: );
2712:
2713: $r->print('<h3>'.&mt('Resource Details').'</h3>');
2714:
2715: $r->print(&Apache::lonhtmlcommon::start_pick_box());
2716:
2717: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Type'))
2718: .&Apache::loncommon::filedescription($thistype)
2719: .&Apache::lonhtmlcommon::row_closure()
2720: );
2721:
2722: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Link to Resource'))
2723: .'<tt>'
2724: );
2725: $r->print(<<ENDCAPTION);
2726: <a href='javascript:void(window.open("$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
2727: $thisdisfn</a>
2728: ENDCAPTION
2729: $r->print('</tt>'
2730: .&Apache::lonhtmlcommon::row_closure()
2731: );
2732:
2733: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))
2734: .'<tt>'.$thisdistarget.'</tt>'
2735: );
2736: if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {
2737: $r->print(&Apache::lonhtmlcommon::row_closure()
2738: .&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))
2739: .'<span class="LC_warning">'
2740: .&Apache::loncommon::plainname($cuname,$cudom) .' ('.$cuname.':'.$cudom.')'
2741: .'</span>'
2742: );
2743: }
2744:
2745: if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
2746: $r->print(&Apache::lonhtmlcommon::row_closure()
2747: .&Apache::lonhtmlcommon::row_title(&mt('Diffs')));
2748: $r->print(<<ENDDIFF);
2749: <a href='javascript:void(window.open("/adm/diff?filename=$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
2750: ENDDIFF
2751: $r->print(&mt('Diffs with Current Version').'</a>');
2752: }
2753:
2754: $r->print(&Apache::lonhtmlcommon::row_closure(1)
2755: .&Apache::lonhtmlcommon::end_pick_box()
2756: );
2757:
2758: # ---------------------- Publishing from $fn to $thistarget with $thisembstyle.
2759:
2760: unless ($env{'form.phase'} eq 'two') {
2761: # ---------------------------------------------------------- Parse for problems
2762: my ($warningcount,$errorcount);
2763: if ($thisembstyle eq 'ssi') {
2764: ($warningcount,$errorcount)=&checkonthis($r,$fn);
2765: }
2766: unless ($errorcount) {
2767: my ($outstring,$error)=
2768: &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle,undef,$nokeyref);
2769: $r->print($outstring);
2770: } else {
2771: $r->print('<h3 class="LC_error">'.
2772: &mt('The document contains errors and cannot be published.').
2773: '</h3>');
2774: }
2775: } else {
2776: my ($output,$error) = &phasetwo($r,$docroot.$fn,$docroot.$thistarget,
2777: $thisembstyle,$thisdistarget);
2778: $r->print($output);
2779: }
2780: }
2781: $r->print(&Apache::loncommon::end_page());
2782:
2783: return OK;
2784: }
2785:
2786: BEGIN {
2787:
2788: # ----------------------------------- Read addid.tab
2789: unless ($readit) {
2790: %addid=();
2791:
2792: {
2793: my $tabdir = $Apache::lonnet::perlvar{'lonTabDir'};
2794: my $fh=Apache::File->new($tabdir.'/addid.tab');
2795: while (<$fh>=~/(\w+)\s+(\w+)/) {
2796: $addid{$1}=$2;
2797: }
2798: }
2799: }
2800: $readit=1;
2801: }
2802:
2803:
2804: 1;
2805: __END__
2806:
2807: =pod
2808:
2809: =back
2810:
2811: =cut
2812:
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