version 1.121, 2002/06/18 21:36:38
|
version 1.122, 2002/06/19 19:40:38
|
Line 236 sub handler {
|
Line 236 sub handler {
|
return OK if $r->header_only; |
return OK if $r->header_only; |
|
|
my $domain = $r->dir_config('lonDefDomain'); |
my $domain = $r->dir_config('lonDefDomain'); |
$diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::unescape($domain). |
$diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain). |
"\_".&Apache::lonnet::unescape($ENV{'user.name'})."_searchcat.db"; |
"\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db"; |
|
|
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, |
['catalogmode','launch','acts','mode','form','element']); |
['catalogmode','launch','acts','mode','form','element']); |
Line 246 sub handler {
|
Line 246 sub handler {
|
if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { |
if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) { |
&start_fresh_session(); |
&start_fresh_session(); |
untie %hash; |
untie %hash; |
} |
} else { |
else { |
|
$r->print('<html><head></head><body>Unable to tie hash to db '. |
$r->print('<html><head></head><body>Unable to tie hash to db '. |
'file</body></html>'); |
'file</body></html>'); |
return OK; |
return OK; |
Line 488 ENDDOCUMENT
|
Line 487 ENDDOCUMENT
|
|
|
Returns a scalar which holds the current ENV{'form.*'} values in |
Returns a scalar which holds the current ENV{'form.*'} values in |
a 'hidden' html input tag. |
a 'hidden' html input tag. |
|
|
=cut |
=cut |
|
|
###################################################################### |
###################################################################### |
###################################################################### |
###################################################################### |
|
|
# ------------------------------------------------------------- make persistent |
|
|
|
sub make_persistent { |
sub make_persistent { |
my $persistent=''; |
my $persistent=''; |
|
|
Line 512 END
|
Line 510 END
|
return $persistent; |
return $persistent; |
} |
} |
|
|
# --------------------------------------------------------- Various form fields |
|
|
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item HTML form building functions |
|
|
|
=over 4 |
|
|
|
=item &simpletextfield() |
|
|
|
Inputs: $name,$value,$size |
|
|
|
Returns a text input field with the given name, value, and size. |
|
If size is not specified, a value of 20 is used. |
|
|
|
=item &simplecheckbox() |
|
|
|
Inputs: $name,$value |
|
|
|
Returns a simple check box with the given $name. |
|
If $value eq 'on' the box is checked. |
|
|
|
=item &searchphrasefield() |
|
|
|
Inputs: $title,$name,$value |
|
|
|
Returns html for a title line and an input field for entering search terms. |
|
the instructions "Enter terms or phrases separated by search operators such |
|
as AND, OR, or NOT." are given following the title. The entry field (which |
|
is where the $name and $value are used) is an 80 column simpletextfield. |
|
|
|
=item &dateboxes() |
|
|
|
=item &selectbox() |
|
|
|
=back |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
|
|
sub simpletextfield { |
sub simpletextfield { |
my ($name,$value)=@_; |
my ($name,$value,$size)=@_; |
return '<input type=text name=\''.$name. |
$size = 20 if (! defined($size)); |
'\' size=20 value=\''.$value.'\' />'; |
return '<input type="text" name="'.$name. |
|
'" size="'.$size.'" value="'.$value.'" />'; |
} |
} |
|
|
sub simplecheckbox { |
sub simplecheckbox { |
my ($name,$value)=@_; |
my ($name,$value)=@_; |
my $checked=''; |
my $checked=''; |
$checked="CHECKED" if $value eq 'on'; |
$checked="CHECKED" if $value eq 'on'; |
return '<input type=checkbox name=\''.$name.'\' '. $checked . '>'; |
return '<input type="checkbox" name="'.$name.'" '. $checked . ' />'; |
} |
} |
|
|
sub searchphrasefield { |
sub searchphrasefield { |
my ($title,$name,$value)=@_; |
my ($title,$name,$value)=@_; |
my $instruction=<<END; |
my $instruction=<<END; |
Enter terms or phrases separated by search operators such |
Enter terms or phrases separated by search operators such as AND, OR, or NOT. |
as AND, OR, or NOT. |
|
END |
END |
my $uctitle=uc($title); |
my $uctitle=uc($title); |
return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:</b>". |
return "\n". |
"</FONT> $instruction<br />". |
'<p><font color="#800000" face="helvetica"><b>'.$uctitle.':</b>'. |
'<input type=text name="'.$name.'" size=80 value=\''.$value.'\'>'; |
"</FONT> $instruction<br />".&simpletextfield($name,$value,80); |
} |
} |
|
|
sub dateboxes { |
sub dateboxes { |
Line 586 END
|
Line 626 END
|
sub selectbox { |
sub selectbox { |
my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_; |
my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_; |
my $uctitle=uc($title); |
my $uctitle=uc($title); |
my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:". |
my $selout="\n".'<p><font color="#800000" face="helvetica">'. |
"</b></font><br />".'<select name="'.$name.'">'; |
'<b>'.$uctitle.':</b></font><br /><select name="'.$name.'">'; |
foreach ($anyvalue,@idlist) { |
foreach ($anyvalue,@idlist) { |
$selout.='<option value=\''.$_.'\''; |
$selout.='<option value="'.$_.'"'; |
if ($_ eq $value and !/^any$/) { |
if ($_ eq $value and !/^any$/) { |
$selout.=' selected>'.&{$functionref}($_).'</option>'; |
$selout.=' selected >'.&{$functionref}($_).'</option>'; |
} |
} |
elsif ($_ eq $value and /^$anyvalue$/) { |
elsif ($_ eq $value and /^$anyvalue$/) { |
$selout.=' selected>'.$anytag.'</option>'; |
$selout.=' selected >'.$anytag.'</option>'; |
} |
} |
else {$selout.='>'.&{$functionref}($_).'</option>';} |
else {$selout.='>'.&{$functionref}($_).'</option>';} |
} |
} |
return $selout.'</select>'; |
return $selout.'</select>'; |
} |
} |
|
|
# ----------------------------------------------- Performing an advanced search |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &advancedsearch() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub advancedsearch { |
sub advancedsearch { |
my ($r,$envhash)=@_; |
my ($r,$envhash)=@_; |
my %ENV=%{$envhash}; |
my %ENV=%{$envhash}; |
|
|
my $fillflag=0; |
my $fillflag=0; |
# Clean up fields for safety |
# Clean up fields for safety |
for my $field ('title','author','subject','keywords','url','version', |
for my $field ('title','author','subject','keywords','url','version', |
Line 637 sub advancedsearch {
|
Line 686 sub advancedsearch {
|
&output_blank_field_error($r); |
&output_blank_field_error($r); |
return OK; |
return OK; |
} |
} |
|
|
|
|
# Turn the form input into a SQL-based query |
# Turn the form input into a SQL-based query |
my $query=''; |
my $query=''; |
|
|
my @queries; |
my @queries; |
# Evaluate logical expression AND/OR/NOT phrase fields. |
# Evaluate logical expression AND/OR/NOT phrase fields. |
foreach my $field ('title','author','subject','notes','abstract','url', |
foreach my $field ('title','author','subject','notes','abstract','url', |
Line 683 sub advancedsearch {
|
Line 729 sub advancedsearch {
|
elsif ($datequery) { |
elsif ($datequery) { |
push @queries,$datequery; |
push @queries,$datequery; |
} |
} |
|
|
# Process form information for custom metadata querying |
# Process form information for custom metadata querying |
my $customquery=''; |
my $customquery=''; |
if ($ENV{'form.custommetadata'}) { |
if ($ENV{'form.custommetadata'}) { |
Line 723 sub advancedsearch {
|
Line 768 sub advancedsearch {
|
return 'Error. Should not have gone to this point.'; |
return 'Error. Should not have gone to this point.'; |
} |
} |
|
|
# --------------------------------------------------- Performing a basic search |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &basicsearch() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub basicsearch { |
sub basicsearch { |
my ($r,$envhash)=@_; |
my ($r,$envhash)=@_; |
my %ENV=%{$envhash}; |
my %ENV=%{$envhash}; |
Line 762 sub basicsearch {
|
Line 817 sub basicsearch {
|
return OK; |
return OK; |
} |
} |
|
|
# ------------------------------------------------------------- build_SQL_query |
|
|
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &build_SQL_query() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub build_SQL_query { |
sub build_SQL_query { |
my ($field_name,$logic_statement)=@_; |
my ($field_name,$logic_statement)=@_; |
my $q=new Text::Query('abc', |
my $q=new Text::Query('abc', |
Line 774 sub build_SQL_query {
|
Line 840 sub build_SQL_query {
|
return $sql_query; |
return $sql_query; |
} |
} |
|
|
# ------------------------------------------------- build custom metadata query |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &build_custommetadata_query() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub build_custommetadata_query { |
sub build_custommetadata_query { |
my ($field_name,$logic_statement)=@_; |
my ($field_name,$logic_statement)=@_; |
|
&Apache::lonnet::logthis("Entered build_custommetadata_query:". |
|
$field_name.':'.$logic_statement); |
my $q=new Text::Query('abc', |
my $q=new Text::Query('abc', |
-parse => 'Text::Query::ParseAdvanced', |
-parse => 'Text::Query::ParseAdvanced', |
-build => 'Text::Query::BuildAdvancedString'); |
-build => 'Text::Query::BuildAdvancedString'); |
Line 784 sub build_custommetadata_query {
|
Line 862 sub build_custommetadata_query {
|
my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'}; |
my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'}; |
# quick fix to change literal into xml tag-matching |
# quick fix to change literal into xml tag-matching |
# will eventually have to write a separate builder module |
# will eventually have to write a separate builder module |
my $oldmatchexp=$matchexp; |
# wordone=wordtwo becomes\<wordone\>[^\<] *wordtwo[^\<]*\<\/wordone\> |
$matchexp=~s/(\w+)\\=([\w\\\+]+)/\\<$1\\>\[\^\\<\]\*$2\[\^\\<\]\*\\<\\\/$1\\>/g; |
$matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to |
|
/\\<$1\\>?# \<wordone\> |
|
\[\^\\<\]?# [^\<] |
|
\*$2\[\^\\<\]?# *wordtwo[^\<] |
|
\*\\<\\\/$1\\>?# *\<\/wordone\> |
|
/g; |
|
&Apache::lonnet::logthis("match expression: ".$matchexp); |
return $matchexp; |
return $matchexp; |
} |
} |
|
|
# - Recursively parse a reverse notation expression into a SQL query expression |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &recursive_SQL_query_build() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub recursive_SQL_query_build { |
sub recursive_SQL_query_build { |
my ($dkey,$pattern)=@_; |
my ($dkey,$pattern)=@_; |
my @matches=($pattern=~/(\[[^\]|\[]*\])/g); |
my @matches=($pattern=~/(\[[^\]|\[]*\])/g); |
Line 823 sub recursive_SQL_query_build {
|
Line 917 sub recursive_SQL_query_build {
|
&recursive_SQL_query_build($dkey,$pattern); |
&recursive_SQL_query_build($dkey,$pattern); |
} |
} |
|
|
# ------------------------------------------------------------ Build date query |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &build_date_queries() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub build_date_queries { |
sub build_date_queries { |
my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2, |
my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2, |
$lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_; |
$lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_; |
Line 872 sub build_date_queries {
|
Line 976 sub build_date_queries {
|
return ''; |
return ''; |
} |
} |
|
|
# ----------------------------- format and output results based on a reply list |
###################################################################### |
# There are two windows that this function writes to. The main search |
###################################################################### |
# window ("srch") has a listing of the results. A secondary window ("popwin") |
|
# gives the status of the network search (time elapsed, number of machines |
=pod |
# contacted, etc.) |
|
|
=item &output_results() |
|
|
|
Format and output results based on a reply list. |
|
There are two windows that this function writes to. The main search |
|
window ("srch") has a listing of the results. A secondary window ("popwin") |
|
gives the status of the network search (time elapsed, number of machines |
|
contacted, etc.) |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub output_results { |
sub output_results { |
my $fnum; # search result counter |
my $fnum; # search result counter |
my ($mode,$r,$envhash,$query,$replyref)=@_; |
my ($mode,$r,$envhash,$query,$replyref)=@_; |
Line 1336 RESULTS
|
Line 1452 RESULTS
|
RESULTS |
RESULTS |
} |
} |
|
|
# ------------------------------------------------------ Detailed Citation View |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item Metadata Viewing Functions |
|
|
|
Output is a HTML-ified string. |
|
Input arguments are title, author, subject, url, keywords, version, |
|
notes, short abstract, mime, language, creation date, |
|
last revision date, owner, copyright, hostname, httphost, and |
|
extra custom metadata to show. |
|
|
|
=over 4 |
|
|
|
=item &detailed_citation_view() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub detailed_citation_view { |
sub detailed_citation_view { |
my ($title,$author,$subject,$url,$keywords,$version, |
my ($title,$author,$subject,$url,$keywords,$version, |
$notes,$shortabstract,$mime,$lang, |
$notes,$shortabstract,$mime,$lang, |
Line 1375 END
|
Line 1511 END
|
return $result; |
return $result; |
} |
} |
|
|
# ---------------------------------------------------------------- Summary View |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &summary_view() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub summary_view { |
sub summary_view { |
my ($title,$author,$subject,$url,$keywords,$version, |
my ($title,$author,$subject,$url,$keywords,$version, |
$notes,$shortabstract,$mime,$lang, |
$notes,$shortabstract,$mime,$lang, |
Line 1393 END
|
Line 1539 END
|
return $result; |
return $result; |
} |
} |
|
|
# -------------------------------------------------------------- Fielded Format |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &fielded_format_view() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub fielded_format_view { |
sub fielded_format_view { |
my ($title,$author,$subject,$url,$keywords,$version, |
my ($title,$author,$subject,$url,$keywords,$version, |
$notes,$shortabstract,$mime,$lang, |
$notes,$shortabstract,$mime,$lang, |
Line 1424 END
|
Line 1580 END
|
return $result; |
return $result; |
} |
} |
|
|
# -------------------------------------------------------------------- XML/SGML |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &xml_sgml_view() |
|
|
|
=back |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub xml_sgml_view { |
sub xml_sgml_view { |
my ($title,$author,$subject,$url,$keywords,$version, |
my ($title,$author,$subject,$url,$keywords,$version, |
$notes,$shortabstract,$mime,$lang, |
$notes,$shortabstract,$mime,$lang, |
Line 1466 END
|
Line 1634 END
|
return $result; |
return $result; |
} |
} |
|
|
# ---------------------------------------------------- see if a field is filled |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &filled() see if field is filled. |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub filled { |
sub filled { |
my ($field)=@_; |
my ($field)=@_; |
if ($field=~/\S/ && $field ne 'any') { |
if ($field=~/\S/ && $field ne 'any') { |
Line 1477 sub filled {
|
Line 1655 sub filled {
|
} |
} |
} |
} |
|
|
# ---------------- Message to output when there are not enough fields filled in |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &output_blank_field_error() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub output_blank_field_error { |
sub output_blank_field_error { |
my ($r)=@_; |
my ($r)=@_; |
# make query information persistent to allow for subsequent revision |
# make query information persistent to allow for subsequent revision |
Line 1511 processed.
|
Line 1699 processed.
|
RESULTS |
RESULTS |
} |
} |
|
|
# ----------------------------------------------------------- Output date error |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &output_date_error() |
|
|
|
Output a full html page with an error message. |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub output_date_error { |
sub output_date_error { |
my ($r,$message)=@_; |
my ($r,$message)=@_; |
# make query information persistent to allow for subsequent revision |
# make query information persistent to allow for subsequent revision |
my $persistent=&make_persistent(); |
my $persistent=&make_persistent(); |
|
|
$r->print(<<BEGINNING); |
$r->print(<<RESULTS); |
<html> |
<html> |
<head> |
<head> |
<title>The LearningOnline Network with CAPA</title> |
<title>The LearningOnline Network with CAPA</title> |
BEGINNING |
|
$r->print(<<RESULTS); |
|
</head> |
</head> |
<body bgcolor="#ffffff"> |
<body bgcolor="#ffffff"> |
<img align='right' src='/adm/lonIcons/lonlogos.gif' /> |
<img align='right' src='/adm/lonIcons/lonlogos.gif' /> |
Line 1542 $message
|
Line 1740 $message
|
RESULTS |
RESULTS |
} |
} |
|
|
# --------- settings whenever the user causes the search window to be launched |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &start_fresh_session() |
|
|
|
Cleans the global %hash by removing all fields which begin with |
|
'pre_' or 'store'. |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub start_fresh_session { |
sub start_fresh_session { |
delete $hash{'mode_catalog'}; |
delete $hash{'mode_catalog'}; |
foreach (keys %hash) { |
foreach (keys %hash) { |
Line 1555 sub start_fresh_session {
|
Line 1766 sub start_fresh_session {
|
} |
} |
} |
} |
|
|
# ----------------------------------------------- send javascript to popwin |
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &popwin_js() send javascript to popwin |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub popwin_js { |
sub popwin_js { |
# Print javascript out to popwin, but make sure we dont generate |
# Print javascript out to popwin, but make sure we dont generate |
# any javascript errors in doing so. |
# any javascript errors in doing so. |
Line 1570 END
|
Line 1791 END
|
$r->rflush(); |
$r->rflush(); |
} |
} |
|
|
|
###################################################################### |
|
###################################################################### |
|
|
|
=pod |
|
|
|
=item &popwin_imgupdate() |
|
|
|
=cut |
|
|
|
###################################################################### |
|
###################################################################### |
sub popwin_imgupdate { |
sub popwin_imgupdate { |
my ($r,$imgnum,$icon) = @_; |
my ($r,$imgnum,$icon) = @_; |
&popwin_js($r,'popwin.document.img'.$imgnum.'.'. |
&popwin_js($r,'popwin.document.img'.$imgnum.'.'. |
Line 1774 more fields need to be filled in
|
Line 2006 more fields need to be filled in
|
|
|
=item * |
=item * |
|
|
output_date_error(server reference, error message) : outputs |
output_date_error(server reference, error message) : |
an error message specific to bad date format. |
|
|
|
=back |
=back |
|
|