[LON-CAPA-cvs] cvs: loncom /interface lonsearchcat.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Wed, 19 Jun 2002 19:40:38 -0000
This is a MIME encoded message
--matthew1024515638
Content-Type: text/plain
matthew Wed Jun 19 15:40:38 2002 EDT
Modified files:
/loncom/interface lonsearchcat.pm
Log:
More (much more!) POD documentation.
Minor cleanups:
Changed yesterdays 'unescape' calls to 'escape'.
Reformatted regular expression writing regular expression in
&build_custom_metedata_query() so that a2ps can print it
out instead of hanging.
Changes to the form outputing routines (which should later be moved
to loncommon, I suspect) to be a little nicer.
Tried to make the html produced a little closer to xhtml standard.
--matthew1024515638
Content-Type: text/plain
Content-Disposition: attachment; filename="matthew-20020619154038.txt"
Index: loncom/interface/lonsearchcat.pm
diff -u loncom/interface/lonsearchcat.pm:1.121 loncom/interface/lonsearchcat.pm:1.122
--- loncom/interface/lonsearchcat.pm:1.121 Tue Jun 18 17:36:38 2002
+++ loncom/interface/lonsearchcat.pm Wed Jun 19 15:40:38 2002
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Search Catalog
#
-# $Id: lonsearchcat.pm,v 1.121 2002/06/18 21:36:38 matthew Exp $
+# $Id: lonsearchcat.pm,v 1.122 2002/06/19 19:40:38 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -236,8 +236,8 @@
return OK if $r->header_only;
my $domain = $r->dir_config('lonDefDomain');
- $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::unescape($domain).
- "\_".&Apache::lonnet::unescape($ENV{'user.name'})."_searchcat.db";
+ $diropendb= "/home/httpd/perl/tmp/".&Apache::lonnet::escape($domain).
+ "\_".&Apache::lonnet::escape($ENV{'user.name'})."_searchcat.db";
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['catalogmode','launch','acts','mode','form','element']);
@@ -246,8 +246,7 @@
if (tie(%hash,'GDBM_File',$diropendb,&GDBM_WRCREAT,0640)) {
&start_fresh_session();
untie %hash;
- }
- else {
+ } else {
$r->print('<html><head></head><body>Unable to tie hash to db '.
'file</body></html>');
return OK;
@@ -488,13 +487,12 @@
Returns a scalar which holds the current ENV{'form.*'} values in
a 'hidden' html input tag.
+
=cut
######################################################################
######################################################################
-# ------------------------------------------------------------- make persistent
-
sub make_persistent {
my $persistent='';
@@ -512,31 +510,73 @@
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 {
- my ($name,$value)=@_;
- return '<input type=text name=\''.$name.
- '\' size=20 value=\''.$value.'\' />';
+ my ($name,$value,$size)=@_;
+ $size = 20 if (! defined($size));
+ return '<input type="text" name="'.$name.
+ '" size="'.$size.'" value="'.$value.'" />';
}
sub simplecheckbox {
my ($name,$value)=@_;
my $checked='';
$checked="CHECKED" if $value eq 'on';
- return '<input type=checkbox name=\''.$name.'\' '. $checked . '>';
+ return '<input type="checkbox" name="'.$name.'" '. $checked . ' />';
}
sub searchphrasefield {
my ($title,$name,$value)=@_;
my $instruction=<<END;
-Enter terms or phrases separated by search operators such
-as AND, OR, or NOT.
+Enter terms or phrases separated by search operators such as AND, OR, or NOT.
END
my $uctitle=uc($title);
- return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:</b>".
- "</FONT> $instruction<br />".
- '<input type=text name="'.$name.'" size=80 value=\''.$value.'\'>';
+ return "\n".
+ '<p><font color="#800000" face="helvetica"><b>'.$uctitle.':</b>'.
+ "</FONT> $instruction<br />".&simpletextfield($name,$value,80);
}
sub dateboxes {
@@ -586,26 +626,35 @@
sub selectbox {
my ($title,$name,$value,$anyvalue,$anytag,$functionref,@idlist)=@_;
my $uctitle=uc($title);
- my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
- "</b></font><br />".'<select name="'.$name.'">';
+ my $selout="\n".'<p><font color="#800000" face="helvetica">'.
+ '<b>'.$uctitle.':</b></font><br /><select name="'.$name.'">';
foreach ($anyvalue,@idlist) {
- $selout.='<option value=\''.$_.'\'';
+ $selout.='<option value="'.$_.'"';
if ($_ eq $value and !/^any$/) {
- $selout.=' selected>'.&{$functionref}($_).'</option>';
+ $selout.=' selected >'.&{$functionref}($_).'</option>';
}
elsif ($_ eq $value and /^$anyvalue$/) {
- $selout.=' selected>'.$anytag.'</option>';
+ $selout.=' selected >'.$anytag.'</option>';
}
else {$selout.='>'.&{$functionref}($_).'</option>';}
}
return $selout.'</select>';
}
-# ----------------------------------------------- Performing an advanced search
+######################################################################
+######################################################################
+
+=pod
+
+=item &advancedsearch()
+
+=cut
+
+######################################################################
+######################################################################
sub advancedsearch {
my ($r,$envhash)=@_;
my %ENV=%{$envhash};
-
my $fillflag=0;
# Clean up fields for safety
for my $field ('title','author','subject','keywords','url','version',
@@ -637,11 +686,8 @@
&output_blank_field_error($r);
return OK;
}
-
-
# Turn the form input into a SQL-based query
my $query='';
-
my @queries;
# Evaluate logical expression AND/OR/NOT phrase fields.
foreach my $field ('title','author','subject','notes','abstract','url',
@@ -683,7 +729,6 @@
elsif ($datequery) {
push @queries,$datequery;
}
-
# Process form information for custom metadata querying
my $customquery='';
if ($ENV{'form.custommetadata'}) {
@@ -723,7 +768,17 @@
return 'Error. Should not have gone to this point.';
}
-# --------------------------------------------------- Performing a basic search
+######################################################################
+######################################################################
+
+=pod
+
+=item &basicsearch()
+
+=cut
+
+######################################################################
+######################################################################
sub basicsearch {
my ($r,$envhash)=@_;
my %ENV=%{$envhash};
@@ -762,7 +817,18 @@
return OK;
}
-# ------------------------------------------------------------- build_SQL_query
+
+######################################################################
+######################################################################
+
+=pod
+
+=item &build_SQL_query()
+
+=cut
+
+######################################################################
+######################################################################
sub build_SQL_query {
my ($field_name,$logic_statement)=@_;
my $q=new Text::Query('abc',
@@ -774,9 +840,21 @@
return $sql_query;
}
-# ------------------------------------------------- build custom metadata query
+######################################################################
+######################################################################
+
+=pod
+
+=item &build_custommetadata_query()
+
+=cut
+
+######################################################################
+######################################################################
sub build_custommetadata_query {
my ($field_name,$logic_statement)=@_;
+ &Apache::lonnet::logthis("Entered build_custommetadata_query:".
+ $field_name.':'.$logic_statement);
my $q=new Text::Query('abc',
-parse => 'Text::Query::ParseAdvanced',
-build => 'Text::Query::BuildAdvancedString');
@@ -784,12 +862,28 @@
my $matchexp=${$q}{'-parse'}{'-build'}{'matchstring'};
# quick fix to change literal into xml tag-matching
# will eventually have to write a separate builder module
- my $oldmatchexp=$matchexp;
- $matchexp=~s/(\w+)\\=([\w\\\+]+)/\\<$1\\>\[\^\\<\]\*$2\[\^\\<\]\*\\<\\\/$1\\>/g;
+ # wordone=wordtwo becomes\<wordone\>[^\<] *wordtwo[^\<]*\<\/wordone\>
+ $matchexp =~ s/(\w+)\\=([\w\\\+]+)?# wordone=wordtwo is changed to
+ /\\<$1\\>?# \<wordone\>
+ \[\^\\<\]?# [^\<]
+ \*$2\[\^\\<\]?# *wordtwo[^\<]
+ \*\\<\\\/$1\\>?# *\<\/wordone\>
+ /g;
+ &Apache::lonnet::logthis("match expression: ".$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 {
my ($dkey,$pattern)=@_;
my @matches=($pattern=~/(\[[^\]|\[]*\])/g);
@@ -823,7 +917,17 @@
&recursive_SQL_query_build($dkey,$pattern);
}
-# ------------------------------------------------------------ Build date query
+######################################################################
+######################################################################
+
+=pod
+
+=item &build_date_queries()
+
+=cut
+
+######################################################################
+######################################################################
sub build_date_queries {
my ($cmonth1,$cday1,$cyear1,$cmonth2,$cday2,$cyear2,
$lmonth1,$lday1,$lyear1,$lmonth2,$lday2,$lyear2)=@_;
@@ -872,11 +976,23 @@
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
-# contacted, etc.)
+######################################################################
+######################################################################
+
+=pod
+
+=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 {
my $fnum; # search result counter
my ($mode,$r,$envhash,$query,$replyref)=@_;
@@ -1336,7 +1452,27 @@
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 {
my ($title,$author,$subject,$url,$keywords,$version,
$notes,$shortabstract,$mime,$lang,
@@ -1375,7 +1511,17 @@
return $result;
}
-# ---------------------------------------------------------------- Summary View
+######################################################################
+######################################################################
+
+=pod
+
+=item &summary_view()
+
+=cut
+
+######################################################################
+######################################################################
sub summary_view {
my ($title,$author,$subject,$url,$keywords,$version,
$notes,$shortabstract,$mime,$lang,
@@ -1393,7 +1539,17 @@
return $result;
}
-# -------------------------------------------------------------- Fielded Format
+######################################################################
+######################################################################
+
+=pod
+
+=item &fielded_format_view()
+
+=cut
+
+######################################################################
+######################################################################
sub fielded_format_view {
my ($title,$author,$subject,$url,$keywords,$version,
$notes,$shortabstract,$mime,$lang,
@@ -1424,7 +1580,19 @@
return $result;
}
-# -------------------------------------------------------------------- XML/SGML
+######################################################################
+######################################################################
+
+=pod
+
+=item &xml_sgml_view()
+
+=back
+
+=cut
+
+######################################################################
+######################################################################
sub xml_sgml_view {
my ($title,$author,$subject,$url,$keywords,$version,
$notes,$shortabstract,$mime,$lang,
@@ -1466,7 +1634,17 @@
return $result;
}
-# ---------------------------------------------------- see if a field is filled
+######################################################################
+######################################################################
+
+=pod
+
+=item &filled() see if field is filled.
+
+=cut
+
+######################################################################
+######################################################################
sub filled {
my ($field)=@_;
if ($field=~/\S/ && $field ne 'any') {
@@ -1477,7 +1655,17 @@
}
}
-# ---------------- Message to output when there are not enough fields filled in
+######################################################################
+######################################################################
+
+=pod
+
+=item &output_blank_field_error()
+
+=cut
+
+######################################################################
+######################################################################
sub output_blank_field_error {
my ($r)=@_;
# make query information persistent to allow for subsequent revision
@@ -1511,18 +1699,28 @@
RESULTS
}
-# ----------------------------------------------------------- Output date error
+######################################################################
+######################################################################
+
+=pod
+
+=item &output_date_error()
+
+Output a full html page with an error message.
+
+=cut
+
+######################################################################
+######################################################################
sub output_date_error {
my ($r,$message)=@_;
# make query information persistent to allow for subsequent revision
my $persistent=&make_persistent();
- $r->print(<<BEGINNING);
+ $r->print(<<RESULTS);
<html>
<head>
<title>The LearningOnline Network with CAPA</title>
-BEGINNING
- $r->print(<<RESULTS);
</head>
<body bgcolor="#ffffff">
<img align='right' src='/adm/lonIcons/lonlogos.gif' />
@@ -1542,7 +1740,20 @@
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 {
delete $hash{'mode_catalog'};
foreach (keys %hash) {
@@ -1555,7 +1766,17 @@
}
}
-# ----------------------------------------------- send javascript to popwin
+######################################################################
+######################################################################
+
+=pod
+
+=item &popwin_js() send javascript to popwin
+
+=cut
+
+######################################################################
+######################################################################
sub popwin_js {
# Print javascript out to popwin, but make sure we dont generate
# any javascript errors in doing so.
@@ -1570,6 +1791,17 @@
$r->rflush();
}
+######################################################################
+######################################################################
+
+=pod
+
+=item &popwin_imgupdate()
+
+=cut
+
+######################################################################
+######################################################################
sub popwin_imgupdate {
my ($r,$imgnum,$icon) = @_;
&popwin_js($r,'popwin.document.img'.$imgnum.'.'.
@@ -1774,8 +2006,8 @@
=item *
-output_date_error(server reference, error message) : outputs
-an error message specific to bad date format.
+output_date_error(server reference, error message) :
+
=back
--matthew1024515638--