version 1.93, 2002/08/12 14:48:32
|
version 1.94, 2002/09/10 14:52:35
|
Line 67
|
Line 67
|
|
|
=pod |
=pod |
|
|
=head1 Name |
=head1 NAME |
|
|
lonpublisher - LON-CAPA publishing handler |
lonpublisher - LON-CAPA publishing handler |
|
|
=head1 Synopsis |
=head1 SYNOPSIS |
|
|
lonpublisher takes the proper steps to add resources to the LON-CAPA |
B<lonpublisher> is used by B<mod_perl> inside B<Apache>. This is the |
|
invocation by F<loncapa_apache.conf>: |
|
|
|
<Location /adm/publish> |
|
PerlAccessHandler Apache::lonacc |
|
SetHandler perl-script |
|
PerlHandler Apache::lonpublisher |
|
ErrorDocument 403 /adm/login |
|
ErrorDocument 404 /adm/notfound.html |
|
ErrorDocument 406 /adm/unauthorized.html |
|
ErrorDocument 500 /adm/errorhandler |
|
</Location> |
|
|
|
=head1 DESCRIPTION |
|
|
|
B<lonpublisher> takes the proper steps to add resources to the LON-CAPA |
digital library. This includes updating the metadata table in the |
digital library. This includes updating the metadata table in the |
LON-CAPA database. |
LON-CAPA database. |
|
|
=head1 Description |
B<lonpublisher> is many things to many people. |
|
|
lonpublisher is many things to many people. |
|
To all people it is woefully documented. |
|
This documentation conforms to this standard. |
|
|
|
This module publishes a file. This involves gathering metadata, |
This module publishes a file. This involves gathering metadata, |
versioning the file, copying file from construction space to |
versioning the file, copying file from construction space to |
publication space, and copying metadata from construction space |
publication space, and copying metadata from construction space |
to publication space. |
to publication space. |
|
|
=head2 Internal Functions |
=head2 SUBROUTINES |
|
|
|
Many of the undocumented subroutines implement various magical |
|
parsing shortcuts. |
|
|
=over 4 |
=over 4 |
|
|
Line 130 my $cudom;
|
Line 144 my $cudom;
|
|
|
=pod |
=pod |
|
|
=item metaeval |
=item B<metaeval> |
|
|
|
Evaluates a string that contains metadata. This subroutine |
|
stores values inside I<%metadatafields> and I<%metadatakeys>. |
|
The hash key is a I<$unikey> corresponding to a unique id |
|
that is descriptive of the parser location inside the XML tree. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
Evaluate string with metadata |
=item I<$metastring> |
|
|
|
A string that contains metadata. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
nothing |
|
|
=cut |
=cut |
|
|
Line 185 sub metaeval {
|
Line 216 sub metaeval {
|
|
|
=pod |
=pod |
|
|
=item metaread |
=item B<metaread> |
|
|
Read a metadata file |
Read a metadata file |
|
|
|
Parameters: |
|
|
|
=over |
|
|
|
=item I<$logfile> |
|
|
|
File output stream to output errors and warnings to. |
|
|
|
=item I<$fn> |
|
|
|
File name (including path). |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
=over 4 |
|
|
|
=item Scalar string (if successful) |
|
|
|
XHTML text that indicates successful reading of the metadata. |
|
|
|
=back |
|
|
=cut |
=cut |
|
|
######################################### |
######################################### |
Line 196 Read a metadata file
|
Line 251 Read a metadata file
|
sub metaread { |
sub metaread { |
my ($logfile,$fn)=@_; |
my ($logfile,$fn)=@_; |
unless (-e $fn) { |
unless (-e $fn) { |
print $logfile 'No file '.$fn."\n"; |
print($logfile 'No file '.$fn."\n"); |
return '<br><b>No file:</b> <tt>'.$fn.'</tt>'; |
return '<br><b>No file:</b> <tt>'.$fn.'</tt>'; |
} |
} |
print $logfile 'Processing '.$fn."\n"; |
print($logfile 'Processing '.$fn."\n"); |
my $metastring; |
my $metastring; |
{ |
{ |
my $metafh=Apache::File->new($fn); |
my $metafh=Apache::File->new($fn); |
Line 214 sub metaread {
|
Line 269 sub metaread {
|
|
|
=pod |
=pod |
|
|
=item sqltime |
=item B<sqltime> |
|
|
Convert 'time' format into a datetime sql format |
Convert 'time' format into a datetime sql format |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item I<$timef> |
|
|
|
Seconds since 00:00:00 UTC, January 1, 1970. |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
=over 4 |
|
|
|
=item Scalar string |
|
|
|
MySQL-compatible datetime string. |
|
|
|
=back |
|
|
=cut |
=cut |
|
|
######################################### |
######################################### |
Line 236 sub sqltime {
|
Line 311 sub sqltime {
|
|
|
=pod |
=pod |
|
|
=item Form field generating functions |
=item Form-field-generating subroutines. |
|
|
|
For input parameters, these subroutines take in values |
|
such as I<$name>, I<$value> and other form field metadata. |
|
The output (scalar string that is returned) is an XHTML |
|
string which presents the form field (foreseeably inside |
|
<form></form> tags). |
|
|
=over 4 |
=over 4 |
|
|
=item textfield |
=item B<textfield> |
|
|
=item hiddenfield |
=item B<hiddenfield> |
|
|
=item selectbox |
=item B<selectbox> |
|
|
=back |
=back |
|
|
Line 255 sub sqltime {
|
Line 336 sub sqltime {
|
sub textfield { |
sub textfield { |
my ($title,$name,$value)=@_; |
my ($title,$name,$value)=@_; |
return "\n<p><b>$title:</b><br>". |
return "\n<p><b>$title:</b><br>". |
'<input type=text name="'.$name.'" size=80 value="'.$value.'">'; |
'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />'; |
} |
} |
|
|
sub hiddenfield { |
sub hiddenfield { |
my ($name,$value)=@_; |
my ($name,$value)=@_; |
return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">'; |
return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />'; |
} |
} |
|
|
sub selectbox { |
sub selectbox { |
Line 283 sub selectbox {
|
Line 364 sub selectbox {
|
|
|
=pod |
=pod |
|
|
=item urlfixup |
=item B<urlfixup> |
|
|
Fix up a url? First step of publication |
Fix up a url? First step of publication |
|
|
Line 316 sub urlfixup {
|
Line 397 sub urlfixup {
|
|
|
=pod |
=pod |
|
|
=item absoluteurl |
=item B<absoluteurl> |
|
|
Currently undocumented |
Currently undocumented. |
|
|
=cut |
=cut |
|
|
Line 339 sub absoluteurl {
|
Line 420 sub absoluteurl {
|
|
|
=pod |
=pod |
|
|
=item set_allow |
=item B<set_allow> |
|
|
Currently undocumented |
Currently undocumented |
|
|
Line 370 sub set_allow {
|
Line 451 sub set_allow {
|
|
|
=pod |
=pod |
|
|
=item get_subscribed_hosts |
=item B<get_subscribed_hosts> |
|
|
Currently undocumented |
Currently undocumented |
|
|
Line 404 sub get_subscribed_hosts {
|
Line 485 sub get_subscribed_hosts {
|
} |
} |
} |
} |
} else { |
} else { |
&Apache::lonnet::logthis("Un able to open $target.subscription"); |
&Apache::lonnet::logthis("Unable to open $target.subscription"); |
} |
} |
&Apache::lonnet::logthis("Got list of ".join(':',@subscribed)); |
&Apache::lonnet::logthis("Got list of ".join(':',@subscribed)); |
return @subscribed; |
return @subscribed; |
Line 416 sub get_subscribed_hosts {
|
Line 497 sub get_subscribed_hosts {
|
|
|
=pod |
=pod |
|
|
=item get_max_ids_indices |
=item B<get_max_ids_indices> |
|
|
Currently undocumented |
Currently undocumented |
|
|
Line 460 sub get_max_ids_indices {
|
Line 541 sub get_max_ids_indices {
|
|
|
=pod |
=pod |
|
|
=item get_all_text_unbalanced |
=item B<get_all_text_unbalanced> |
|
|
Currently undocumented |
Currently undocumented |
|
|
Line 502 sub get_all_text_unbalanced {
|
Line 583 sub get_all_text_unbalanced {
|
|
|
=pod |
=pod |
|
|
=item fix_ids_and_indices |
=item B<fix_ids_and_indices> |
|
|
Currently undocumented |
Currently undocumented |
|
|
Line 654 sub fix_ids_and_indices {
|
Line 735 sub fix_ids_and_indices {
|
|
|
=pod |
=pod |
|
|
=item store_metadata |
=item B<store_metadata> |
|
|
Store the metadata in the metadata table in the loncapa database. |
Store the metadata in the metadata table in the loncapa database. |
Uses lonmysql to access the database. |
Uses lonmysql to access the database. |
Line 710 sub store_metadata {
|
Line 791 sub store_metadata {
|
|
|
=pod |
=pod |
|
|
=item publish |
=item B<publish> |
|
|
|
This is the workhorse function of this module. This subroutine generates |
|
backup copies, performs any automatic processing (prior to publication, |
|
especially for rat and ssi files), |
|
|
Currently undocumented. This is the workhorse function of this module. |
I<Additional documentation needed.> |
|
|
=cut |
=cut |
|
|
Line 769 sub publish {
|
Line 854 sub publish {
|
if ( |
if ( |
&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. |
&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'. |
$thisdep.'.meta') eq '-1') { |
$thisdep.'.meta') eq '-1') { |
$scrout.= |
$scrout.= ' - <font color="red">Currently not available'. |
' - <font color=red>Currently not available</font>'; |
'</font>'; |
} else { |
} else { |
my %temphash=(&Apache::lonnet::declutter($target).'___'. |
my %temphash=(&Apache::lonnet::declutter($target).'___'. |
&Apache::lonnet::declutter($thisdep).'___usage' |
&Apache::lonnet::declutter($thisdep).'___usage' |
Line 787 sub publish {
|
Line 872 sub publish {
|
|
|
#Encode any High ASCII characters |
#Encode any High ASCII characters |
$outstring=&HTML::Entities::encode($outstring,"\200-\377"); |
$outstring=&HTML::Entities::encode($outstring,"\200-\377"); |
# ------------------------------------------------------------- Write modified |
# ------------------------------------------------------------- Write modified. |
|
|
{ |
{ |
my $org; |
my $org; |
unless ($org=Apache::File->new('>'.$source)) { |
unless ($org=Apache::File->new('>'.$source)) { |
print $logfile "No write permit to $source\n"; |
print $logfile "No write permit to $source\n"; |
return |
return |
"<font color=red>No write permission to $source, FAIL</font>"; |
'<font color="red">No write permission to '.$source. |
|
', FAIL</font>'; |
} |
} |
print $org $outstring; |
print($org $outstring); |
} |
} |
$content=$outstring; |
$content=$outstring; |
|
|
} |
} |
# --------------------------------------------- Initial step done, now metadata |
# -------------------------------------------- Initial step done, now metadata. |
|
|
# ---------------------------------------- Storage for metadata keys and fields |
# --------------------------------------- Storage for metadata keys and fields. |
|
|
%metadatafields=(); |
%metadatafields=(); |
%metadatakeys=(); |
%metadatakeys=(); |
Line 1014 END
|
Line 1100 END
|
|
|
$scrout.=&textfield('Publisher/Owner','owner', |
$scrout.=&textfield('Publisher/Owner','owner', |
$metadatafields{'owner'}); |
$metadatafields{'owner'}); |
# --------------------------------------------------- Correct copyright for rat |
|
|
|
|
# -------------------------------------------------- Correct copyright for rat. |
if ($style eq 'rat') { |
if ($style eq 'rat') { |
if ($metadatafields{'copyright'} eq 'public') { |
if ($metadatafields{'copyright'} eq 'public') { |
delete $metadatafields{'copyright'}; |
delete $metadatafields{'copyright'}; |
Line 1032 END
|
Line 1118 END
|
(&Apache::loncommon::copyrightids)); |
(&Apache::loncommon::copyrightids)); |
} |
} |
|
|
my $copyright_help = Apache::loncommon::help_open_topic("Publishing_Copyright"); |
my $copyright_help = |
|
Apache::loncommon::help_open_topic('Publishing_Copyright'); |
$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; |
$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge; |
return $scrout. |
return $scrout. |
'<p><input type="submit" value="Finalize Publication" /></p></form>'; |
'<p><input type="submit" value="Finalize Publication" /></p></form>'; |
} |
} |
|
|
######################################### |
######################################### |
Line 1043 END
|
Line 1130 END
|
|
|
=pod |
=pod |
|
|
=item phasetwo |
=item B<phasetwo> |
|
|
Render second interface showing status of publication steps. |
Render second interface showing status of publication steps. |
This is publication step two. |
This is publication step two. |
|
|
|
Parameters: |
|
|
|
=over 4 |
|
|
|
=item I<$source> |
|
|
|
=item I<$target> |
|
|
|
=item I<$style> |
|
|
|
=item I<$distarget> |
|
|
|
=back |
|
|
|
Returns: |
|
|
|
=over 4 |
|
|
|
=item Scalar string |
|
|
|
String contains status (errors and warnings) and information associated with |
|
the server's attempts at publication. |
|
|
=cut |
=cut |
|
|
######################################### |
######################################### |
Line 1270 if (-e $target) {
|
Line 1380 if (-e $target) {
|
|
|
|
|
return $warning.$scrout. |
return $warning.$scrout. |
'<hr><a href="'.$thisdistarget.'"><font size=+2>View Published Version</font></a>'. |
'<hr><a href="'.$thisdistarget.'"><font size="+2">'. |
|
'View Published Version</font></a>'. |
'<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'. |
'<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'. |
'<p><a href="'.$thissrcdir. |
'<p><a href="'.$thissrcdir. |
'"><font size=+2>Back to Source Directory</font></a>'; |
'"><font size="+2">Back to Source Directory</font></a>'; |
|
|
} |
} |
|
|
Line 1283 if (-e $target) {
|
Line 1394 if (-e $target) {
|
|
|
=pod |
=pod |
|
|
=item handler |
=item B<handler> |
|
|
A basic outline of the handler subroutine follows. |
A basic outline of the handler subroutine follows. |
|
|
=over 4 |
=over 4 |
|
|
=item Get query string for limited number of parameters |
=item * |
|
|
|
Get query string for limited number of parameters. |
|
|
|
=item * |
|
|
|
Check filename. |
|
|
|
=item * |
|
|
|
File is there and owned, init lookup tables. |
|
|
|
=item * |
|
|
=item Check filename |
Start page output. |
|
|
=item File is there and owned, init lookup tables |
=item * |
|
|
=item Start page output |
Evaluate individual file, and then output information. |
|
|
=item Individual file |
=item * |
|
|
=item publish from $thisfn to $thistarget with $thisembstyle |
Publishing from $thisfn to $thistarget with $thisembstyle. |
|
|
=back |
=back |
|
|
Line 1378 sub handler {
|
Line 1501 sub handler {
|
|
|
unless ($ENV{'form.phase'} eq 'two') { |
unless ($ENV{'form.phase'} eq 'two') { |
|
|
# --------------------------------- File is there and owned, init lookup tables |
# -------------------------------- File is there and owned, init lookup tables. |
|
|
%addid=(); |
%addid=(); |
|
|
Line 1402 unless ($ENV{'form.phase'} eq 'two') {
|
Line 1525 unless ($ENV{'form.phase'} eq 'two') {
|
|
|
} |
} |
|
|
# ----------------------------------------------------------- Start page output |
# ---------------------------------------------------------- Start page output. |
|
|
$r->content_type('text/html'); |
$r->content_type('text/html'); |
$r->send_http_header; |
$r->send_http_header; |
|
|
$r->print('<html><head><title>LON-CAPA Publishing</title></head>'); |
$r->print('<html><head><title>LON-CAPA Publishing</title></head>'); |
$r->print( |
$r->print( |
'<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
'<body bgcolor="#FFFFFF"><img align="right" '. |
|
'src="/adm/lonIcons/lonlogos.gif" />'); |
my $thisfn=$fn; |
my $thisfn=$fn; |
|
|
# ------------------------------------------------------------- Individual file |
# ---------------------- Evaluate individual file, and then output information. |
{ |
{ |
$thisfn=~/\.(\w+)$/; |
$thisfn=~/\.(\w+)$/; |
my $thistype=$1; |
my $thistype=$1; |
Line 1433 unless ($ENV{'form.phase'} eq 'two') {
|
Line 1557 unless ($ENV{'form.phase'} eq 'two') {
|
&Apache::loncommon::filedescription($thistype).' <tt>'. |
&Apache::loncommon::filedescription($thistype).' <tt>'. |
$thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>'); |
$thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>'); |
|
|
if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { |
if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { |
$r->print('<h3><font color=red>Co-Author: '.$cuname.' at '.$cudom. |
$r->print('<h3><font color="red">Co-Author: '.$cuname.' at '.$cudom. |
'</font></h3>'); |
'</font></h3>'); |
} |
} |
|
|
if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { |
if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { |
$r->print('<br><a href="/adm/diff?filename=/~'.$cuname.'/'. |
$r->print('<br /><a href="/adm/diff?filename=/~'.$cuname.'/'. |
$thisdisfn. |
$thisdisfn. |
'&versionone=priv" target=cat>Diffs with Current Version</a><p>'); |
'&versionone=priv" target="cat">Diffs with Current Version</a><p>'); |
} |
} |
|
|
# ------------ We are publishing from $thisfn to $thistarget with $thisembstyle |
# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle. |
|
|
unless ($ENV{'form.phase'} eq 'two') { |
unless ($ENV{'form.phase'} eq 'two') { |
$r->print( |
$r->print( |
'<hr>'.&publish($thisfn,$thistarget,$thisembstyle)); |
'<hr />'.&publish($thisfn,$thistarget,$thisembstyle)); |
} else { |
} else { |
$r->print( |
$r->print( |
'<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget)); |
'<hr />'.&phasetwo($thisfn,$thistarget, |
|
$thisembstyle,$thisdistarget)); |
} |
} |
|
|
} |
} |