loncom/interface/lonsearchcat.pm - diff

Return to lonsearchcat.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonsearchcat.pm between versions 1.121 and 1.122

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.121
changed lines
	Added in v.1.122