loncom/publisher/lonpublisher.pm - view

File: [LON-CAPA] / loncom / publisher / lonpublisher.pm
Revision 1.299: download - view: text, annotated - select for diffs
Fri Jun 4 03:06:15 2021 UTC (3 years ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Options for publishing a directory split into types.
- Options to exclude modified files and/or files with modified metadata
  when publishing directory (e.g., to avoid unwanted changes when updating
  copyright and/or source availability for an entire directory.
- For skipped files display reason file was skipped.

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