File: text

package info (click to toggle)
libace-perl 1.92-12
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,012 kB
  • sloc: perl: 7,763; ansic: 7,420; makefile: 81
file content (82 lines) | stat: -rwxr-xr-x 2,016 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
#!/usr/bin/perl

use strict;
use vars qw/$DB $URL/;

use Ace 1.51;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs;
use Ace::Browser::SearchSubs;

# zero globals in utilities
my $pattern        = param('query');
my $search_type    = param('type');
my $offset         = AceSearchOffset();

$URL = url();
$URL=~s!^http://[^/]+!!;

# fetch database handle
$DB = OpenDatabase() || AceError("Couldn't open database.");

my ($objs,$count);
($objs,$count) = do_search($pattern,$offset,$search_type) if $pattern;
DoRedirect(@$objs) if $count==1;

PrintTop(undef,undef,'AceDB Text Search');
display_search_form();
display_search($objs,$count,$offset,$pattern) if $pattern;
PrintBottom();

exit 0;

sub display_search_form {
  print p({-class=>'small'},
	  "Type in text or keywords to search for.",
	  "The * and ? wildcard characters are allowed.");
  print 
      start_form,
      table(
	    TR(
	       td("Search text: "),
	       td(textfield(-name=>'query',-size=>40)),
	       td(submit(-label=>'Search'))),
	    TR(
	       td(),
	       td({-colspan=>2},
		  radio_group(-name=>'type',
			      -value=>[qw/short long/],
			      -labels=>{'short'=>'Fast search',
					'long' =>'In-depth search'}
			      )
		  )
	       )
	  ),
        end_form;
}

sub do_search {
  my ($pattern,$offset,$type) = @_;
  my $count;
  my (@objs) = $DB->grep(-pattern=> $pattern,
			 -count  => MAXOBJECTS,
			 -offset => $offset,
			 -total => \$count,
			 -long  => $type eq 'long',
			 );
  return unless @objs;
  return (\@objs,$count);
}

sub display_search {
    my ($objs,$count,$offset,$pattern) = @_;
    my $title = p(strong($count),"objects contain the keywords \"$pattern\"");
	if(!$objs) {
		 print "<b>No matches were found.</b><p>\n";
		 return;
	}
    my @objects = map { ObjectLink($_,font({-color=>'red'},$_->class) . ": $_") }
                      sort { $a->class cmp $b->class } @$objs;
    AceResultsTable(\@objects,$count,$offset,$title) if @objects;
}