--- loncom/publisher/lonpublisher.pm 2000/12/04 12:27:58 1.12 +++ loncom/publisher/lonpublisher.pm 2001/01/30 21:03:55 1.17 @@ -5,18 +5,17 @@ # # 05/29/00,05/30,10/11 Gerd Kortemeyer) # -# 11/28,11/29,11/30,12/01,12/02,12/04 Gerd Kortemeyer +# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer package Apache::lonpublisher; use strict; use Apache::File; +use File::Copy; use Apache::Constants qw(:common :http :methods); use HTML::TokeParser; use Apache::lonxml; -use Apache::structuretags; -use Apache::inputtags; -use Apache::response; +use Apache::lonhomework; my %addid; my %nokey; @@ -127,16 +126,11 @@ sub publish { # ----------------------------------------------------------------- Backup Copy my $copyfile=$source.'.save'; - { - my $org=Apache::File->new($source); - my $cop=Apache::File->new('>'.$copyfile); - while (my $line=<$org>) { print $cop $line; } - } - if (-e $copyfile) { + if (copy($source,$copyfile)) { print $logfile "Copied original file to ".$copyfile."\n"; } else { - print $logfile "Unable to write backup ".$copyfile."\n"; - return "Failed to write backup copy, FAIL"; + print $logfile "Unable to write backup ".$copyfile.':'.$!."\n"; + return "Failed to write backup copy, $!,FAIL"; } # ------------------------------------------------------------- IDs and indices @@ -511,39 +505,27 @@ if (-e $target) { my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; - { - my $org=Apache::File->new($target); - my $cop; - unless ($cop=Apache::File->new('>'.$copyfile)) { - print $logfile "Unable to open for write ".$copyfile."\n"; - return "Failed to open '.$copyfile. - ', FAIL"; - } - while (my $line=<$org>) { print $cop $line; } - } - if (-e $copyfile) { + if (copy($target,$copyfile)) { print $logfile "Copied old target to ".$copyfile."\n"; $scrout.='

Copied old target file'; } else { - print $logfile "Unable to write ".$copyfile."\n"; - return "Failed to copy old target, FAIL"; + print $logfile "Unable to write ".$copyfile.':'.$!."\n"; + return "Failed to copy old target, $!, FAIL"; } # --------------------------------------------------------------- Copy Metadata $copyfile=$copyfile.'.meta'; - { - my $org=Apache::File->new($target.'.meta'); - my $cop=Apache::File->new('>'.$copyfile); - while (my $line=<$org>) { print $cop $line; } - } - if (-e $copyfile) { - print $logfile "Copied old target metadata to ".$copyfile."\n"; + + if (copy($target.'.meta',$copyfile)) { + print $logfile "Copied old target metadata to ".$copyfile."\n"; $scrout.='

Copied old metadata'; } else { - print $logfile "Unable to write metadata ".$copyfile."\n"; - return - "Failed to write old metadata copy, FAIL"; + print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; + if (-e $target.'.meta') { + return + "Failed to write old metadata copy, $!, FAIL"; + } } @@ -568,39 +550,25 @@ if (-e $target) { } } - { - my $org=Apache::File->new($source); - my $cop; - unless ($cop=Apache::File->new('>'.$copyfile)) { - print $logfile "Unable to open for write ".$copyfile."\n"; - return "Failed to open '.$copyfile. - ', FAIL"; - } - while (my $line=<$org>) { print $cop $line; } - } - if (-e $copyfile) { + if (copy($source,$copyfile)) { print $logfile "Copied original source to ".$copyfile."\n"; $scrout.='

Copied source file'; } else { - print $logfile "Unable to write ".$copyfile."\n"; - return "Failed to copy source, FAIL"; + print $logfile "Unable to write ".$copyfile.':'.$!."\n"; + return "Failed to copy source, $!, FAIL"; } # --------------------------------------------------------------- Copy Metadata - my $copyfile=$target.'.meta'; - { - my $org=Apache::File->new($source.'.meta'); - my $cop=Apache::File->new('>'.$copyfile); - while (my $line=<$org>) { print $cop $line; } - } - if (-e $copyfile) { + $copyfile=$copyfile.'.meta'; + + if (copy($source.'.meta',$copyfile)) { print $logfile "Copied original metadata to ".$copyfile."\n"; $scrout.='

Copied metadata'; } else { - print $logfile "Unable to write metadata ".$copyfile."\n"; + print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; return - "Failed to write metadata copy, FAIL"; + "Failed to write metadata copy, $!, FAIL"; } # --------------------------------------------------- Send update notifications @@ -648,6 +616,7 @@ sub handler { return OK; } +unless ($ENV{'form.pubdir'}) { # -------------------------------------------------------------- Check filename my $fn=$ENV{'form.filename'}; @@ -741,7 +710,8 @@ unless ($ENV{'form.phase'} eq 'two') { $r->send_http_header; $r->print('LON-CAPA Publishing'); - $r->print(''); + $r->print( + ''); my $thisfn=$fn; # ------------------------------------------------------------- Individual file @@ -775,7 +745,55 @@ unless ($ENV{'form.phase'} eq 'two') { } $r->print(''); +} else { + + my $fn=$ENV{'form.filename'}; + + $fn=~s/\/[^\/]+$//; + my $thisprefix=$fn; + $thisprefix=~s/\/\~/\/priv\//; + + $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; + + unless ($fn) { + $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}. + ' trying to publish empty directory', $r->filename); + return HTTP_NOT_FOUND; + } + +# ----------------------------------------------------------- Start page output + + $r->content_type('text/html'); + $r->send_http_header; + + $r->print('LON-CAPA Publishing Directory'); + $r->print( + ''); + + my $thisdisfn=$fn; + $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///; + + $r->print('

Publishing directory '.$thisdisfn.'

'); + my $i=0; + $r->print(''); + $r->print(''); + +} return OK; }