/[wait]/trunk/script/sman
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/script/sman

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

cvs-head/script/sman revision 10 by ulpfr, Fri Apr 28 15:40:52 2000 UTC trunk/script/sman revision 105 by dpavlin, Tue Jun 29 22:35:59 2004 UTC
# Line 1  Line 1 
1  #!/usr/local/perl5.005_56.Mar06/bin/perl -w  #!/usr/bin/perl -w
2  ######################### -*- Mode: Cperl -*- #########################  #                              -*- Mode: Perl -*-
3  ##  # $Basename: sman $
4  ## $Basename: sman $  # $Revision: 1.14 $
5  ## $Revision: 1.8 $  # Author          : Ulrich Pfeifer
6  ##  # Created On      : Fri Aug 30 15:52:25 1996
7  ## Author           : Ulrich Pfeifer  # Last Modified By: Ulrich Pfeifer
8  ## Created On       : Fri Aug 30 15:52:25 1996  # Last Modified On: Mon May  8 11:03:46 2000
9  ##  # Language        : CPerl
10  ## Last Modified By : Ulrich Pfeifer  #
11  ## Last Modified On : Sun May 30 17:48:53 1999  # (C) Copyright 1996-2000, Ulrich Pfeifer
12  ##  #
 ## Copyright (c) 1996-1997, Ulrich Pfeifer  
 ##  
 ##  
 ######################################################################  
13    
14  use strict;  use strict;
15    
16  use Term::ReadLine;  use Term::ReadLine;
17  use Getopt::Long;  use Getopt::Long;
18  use Fcntl;  use Fcntl qw(O_RDONLY);
19  use Config;  use Config;
20    
21    use lib '/data/wait/lib';
22    
23  require WAIT::Config;  require WAIT::Config;
24  require WAIT::Database;  require WAIT::Database;
25  require WAIT::Query::Base;  require WAIT::Query::Base;
# Line 43  GetOptions(\%OPT, Line 41  GetOptions(\%OPT,
41             'table=s',             'table=s',
42             'filter=i',             'filter=i',
43             'max=i',             'max=i',
44             'pager:s') || die "Usage: ...\n";             'pager:s') || die "
45    Usage: $0
46              [--database database]
47              [--dir      dir     ]
48              [--table    table   ]
49              [--filter   integer ]
50              [--max      integer ]
51              [--pager    pager   ]
52    ";
53    
54  my $db = WAIT::Database->open(name      => $OPT{database},  my $db = WAIT::Database->open(name      => $OPT{database},
55                                mode      => O_RDONLY,                                mode      => O_RDONLY,
# Line 66  if ($Config::Config{'archname'} eq 'i586 Line 72  if ($Config::Config{'archname'} eq 'i586
72    $format = new WAIT::Format::Term;    $format = new WAIT::Format::Term;
73  }  }
74    
75  my $pager =  ($OPT{pager}) ? \&pager : \&less;  my $pager =  ($OPT{pager}) ? \&less : \&pager;
76  my $OUT   = $term->OUT;  my $OUT   = $term->OUT;
77    
78  my $st = 1;  my $st = 1;
# Line 76  print $OUT "Enter 'h' for help.\n"; Line 82  print $OUT "Enter 'h' for help.\n";
82  # them (a query), show metadata for a hit (a view), show a hot (display)  # them (a query), show metadata for a hit (a view), show a hot (display)
83    
84  my($query, @did);  my($query, @did);
85    my (%hits, $query_text);
86    
87  while (defined ($_ = &myreadline("$st> "))) {  while (defined ($_ = &myreadline("$st> "))) {
88    chomp; $st++;    chomp; $st++;
89    
   my(%hits, $query_text);  
90    if (/^$/) {    if (/^$/) {
91      next;      next;
92    } elsif (/^m (\d+)$/) {    } elsif (/^m (\d+)$/) {
# Line 121  while (defined ($_ = &myreadline("$st> " Line 127  while (defined ($_ = &myreadline("$st> "
127      if ($@ ne '') {      if ($@ ne '') {
128        print $OUT "$_ => $query\n\$\@='$@'\n";        print $OUT "$_ => $query\n\$\@='$@'\n";
129      } elsif (ref($query)) {      } elsif (ref($query)) {
130        %hits = $query->execute();        %hits = $query->execute(top => $OPT{max}, picky => 1);
131        # the hash %hits has as keys document numbers and as values        # the hash %hits has as keys document numbers and as values
132        # quality figures. The doc numbers are not what we have as docid        # quality figures. The doc numbers are not what we have as docid
133        # to find the item in the access class, they are WAIT's private        # to find the item in the access class, they are WAIT's private
# Line 157  while (defined ($_ = &myreadline("$st> " Line 163  while (defined ($_ = &myreadline("$st> "
163    }    }
164    
165  } continue {  } continue {
166    # we don't do this since ANdreas Koenig does not think of it as feature    # we don't do this since Andreas Koenig does not think of it as feature
167    # $term->SetHistory(grep length($_)>4, $term->GetHistory)    # $term->SetHistory(grep length($_)>4, $term->GetHistory)
168  }  }
169    warn "Thank you for using sman\n";
170    
171    $tb->close;
172    $db->close;
173    
174  sub myreadline {  sub myreadline {
175    if (@ARGV) {    if (@ARGV) {
# Line 182  sub help { Line 192  sub help {
192   q              Exit from $0   q              Exit from $0
193   l              redisplay last ranking   l              redisplay last ranking
194  Other input is tried as wais query.  Other input is tried as wais query.
195  The following fields are known: $idb  The following fields for table '$OPT{table}' are known: $idb
196  ] ;  ] ;
197  }  }
198    
# Line 225  sub display { Line 235  sub display {
235  # WHAT DOES HE DO HERE? ULI???  # WHAT DOES HE DO HERE? ULI???
236  # Re: some indexing scripts did use pathnames relative to the table directory  # Re: some indexing scripts did use pathnames relative to the table directory
237  # especially the cpanwait script does this. uli  # especially the cpanwait script does this. uli
238  #  if ($tdid !~ m(^/)) {    if ($tdid !~ m(^/)) {
239  #    $tdid = $tb->dir . '/' . $tdid;      $tdid = $tb->dir . '/' . $tdid;
240  #  }    }
241      # if original version doesn't exist maybe someone created gziped one?
242      # (this is used if you decided to compress data files after indexing,
243      # next indexing will pick names with gz extension anyway)
244      if (! -e $tdid && -e $tdid.".gz") {
245        $tdid .= ".gz";
246      }
247    
248    # The main task of all that follows from here is highlighting. WAIT    # The main task of all that follows from here is highlighting. WAIT
249    # is designed to make it possible to show the user why a certain    # is designed to make it possible to show the user why a certain
# Line 347  sub filter { Line 363  sub filter {
363  }  }
364    
365  sub less {  sub less {
366    my $flags;    my $flags = '';
367    if ($WAIT::Config->{pager} =~ /less/) {    my $pager = $OPT{pager};
368      if ($pager =~ /less/) {
369      $flags = '-r';      $flags = '-r';
370    } elsif ($WAIT::Config->{pager} =~ /more/) {    } elsif ($pager =~ /more/) {
371      $flags = '-c';      $flags = '-c';
372      } elsif ($pager =~ /lynx/) {
373        $flags = '-stdin';
374    }    }
375    open(PAGER, "|$WAIT::Config->{pager} $flags") or die;    open(PAGER, "| $pager $flags") or die;
376    print PAGER @_;    print PAGER @_;
377    close PAGER;    close PAGER;
378  }  }
Legend:
Removed from v.10  
changed lines
  Added in v.105
  ViewVC Help
Powered by ViewVC 1.1.26