home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / perlindex.bat < prev    next >
Encoding:
DOS Batch File  |  2004-03-20  |  15.5 KB  |  921 lines
  1. @rem = '--*-Perl-*--
  2. @echo off
  3. if "%OS%" == "Windows_NT" goto WinNT
  4. perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. :WinNT
  7. perl -x -S %0 %*
  8. if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
  9. if %errorlevel% == 9009 echo You do not have Perl in your PATH.
  10. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
  11. goto endofperl
  12. @rem ';
  13. #!perl
  14. #line 15
  15.     eval 'exec perl -S $0 "$@"'
  16.     if 0;
  17. #                              -*- Mode: Perl -*- 
  18. # $Basename: perlindex.PL $
  19. # $Revision: 1.3 $
  20. # Author          : Ulrich Pfeifer
  21. # Created On      : Mon Jan 22 13:00:41 1996
  22. # Last Modified By: Ulrich Pfeifer
  23. # Last Modified On: Wed Jun 18 19:43:36 2003
  24. # Language        : Perl
  25. # Update Count    : 302
  26. # Status          : Unknown, Use with caution!
  27. # 
  28. # (C) Copyright 1997, Ulrich Pfeifer, all rights reserved.
  29. # 
  30. # 
  31. # %SEEN is used to store the absolute pathes to files which have been
  32. #       indexed. Probably this could be replaced by %FN.
  33. # 
  34. # %FN   $FN{'last'}    greatest documentid
  35. #       $FN{$did}      a pair of $mtf and $filename where $mtf is the
  36. #                      number of occurances of the most frequent word in
  37. #                      the document with number $did.
  38. # 
  39. # %IDF  $IDF{'*all*'}  number of documents (essentially the same as 
  40. #                      $FN{'last'})
  41. #       $IDF{$word}    number of documents containing $word
  42. # 
  43. # %IF   $IF{$word}     list of pairs ($docid,$tf) where $docid is
  44. #                      the number of a document containing $word $tf
  45. # 
  46. use Fcntl;
  47. use less 'time';
  48. use Getopt::Long;
  49. use File::Basename;
  50. use Text::English;
  51.  
  52. # NDBM_File as LAST resort
  53. package AnyDBM_File;
  54.  
  55. @ISA = qw(DB_File GDBM_File SDBM_File ODBM_File NDBM_File) unless @ISA;
  56.  
  57. for $mod (@ISA) {
  58.     last if eval "require $mod"
  59. }
  60.  
  61. package main;
  62.  
  63. $p          = 'w'; # compressed int patch available
  64. $nroff      = '';
  65. $man1direxp = 'D:\Perl\man\man1';
  66. $man3direxp = 'D:\Perl\man\man3';
  67. @perllib    = 'D:\Perl\lib';
  68. push @perllib,'D:\Perl\site\lib';
  69. $prefix     = 'D:\Perl';
  70. $pager      = 'more /e';
  71. use Term::ReadKey;
  72.  
  73. $stemmer = \&Text::English::stem;
  74. # directory for the index 
  75. $IDIR = $man1direxp;
  76. $IDIR =~ s:/[^/]*$::;
  77.  
  78. $opt_index   = '';                # make perl -w happy
  79. $opt_menu    = 1;
  80. $opt_maxhits = 15;
  81. $opt_cbreak  = 1;
  82. &GetOptions(
  83.             'index',
  84.             'cbreak!',
  85.             'maxhits=i',
  86.             'menu!',
  87.             'verbose',
  88.             'dict:i',
  89.             'idir=s',
  90.             ) || die "Usage: $0 [-index] [words ...]\n";
  91.  
  92. if (defined $opt_idir) {
  93.     $IDIR = $opt_idir;          # avoid to many changes below.
  94. }
  95.  
  96. if (defined $opt_dict) {
  97.     $opt_dict ||= 100;
  98. }
  99.  
  100. if ($opt_index) {
  101.     &initstop;
  102.  
  103.     tie (%IF,   AnyDBM_File, "$IDIR/index_if",   O_CREAT|O_RDWR, 0644)
  104.         or die "Could not tie $IDIR/index_if: $!\n";
  105.     tie (%IDF,  AnyDBM_File, "$IDIR/index_idf",  O_CREAT|O_RDWR, 0644)
  106.         or die "Could not tie $IDIR/index_idf: $!\n";
  107.     tie (%SEEN, AnyDBM_File, "$IDIR/index_seen", O_CREAT|O_RDWR, 0644)
  108.         or die "Could not tie $IDIR/index_seen: $!\n";
  109.     tie (%FN,   AnyDBM_File, "$IDIR/index_fn",   O_CREAT|O_RDWR, 0644)
  110.         or die "Could not tie $IDIR/index_fn: $!\n";
  111.  
  112.     require "find.pl";
  113.  
  114.     unless (@ARGV) {            # breaks compatibility :-(
  115.         for $dir (@perllib) {
  116.             print "Scanning $dir ... \n";
  117.             &find($dir);
  118.         }
  119.     }
  120.     for $name (@ARGV) {
  121.         my $fns = $name;
  122.         $fns =~ s:$prefix/::;
  123.         next if $SEEN{$fns};
  124.         next unless -f $name;
  125.         if ($name !~ /(~|,v)$/) {
  126.             $did = $FN{'last'}++;
  127.             $SEEN{$fns} = &index($name, $fns, $did); 
  128.         }
  129.     }
  130.     untie %IF;
  131.     untie %IDF;
  132.     untie %FN;
  133.     untie %SEEN;
  134. } elsif ($opt_dict) {
  135.     tie (%IDF,  AnyDBM_File, "$IDIR/index_idf",  O_RDONLY, 0644)
  136.         or die "Could not tie $IDIR/index_idf: $!\n".
  137.             "Did you run '$0 -index'?\n";
  138.     while (($key,$val) = each %IDF) {
  139.         printf "%-20s %d\n", $key, $val if $val >= $opt_dict;
  140.     }
  141.     untie %IDF;
  142. } else {
  143.     tie (%IF,   AnyDBM_File, "$IDIR/index_if",   O_RDONLY, 0644)
  144.         or die "Could not tie $IDIR/index_if: $!\n".
  145.             "Did you run '$0 -index'?\n";
  146.     tie (%IDF,  AnyDBM_File, "$IDIR/index_idf",   O_RDONLY, 0644)
  147.         or die "Could not tie $IDIR/index_idf: $!\n";
  148.     tie (%FN,   AnyDBM_File, "$IDIR/index_fn",   O_RDONLY, 0644)
  149.         or die "Could not tie $IDIR/index_fn: $!\n";
  150.     &search(@ARGV);
  151.     untie %IF;
  152.     untie %IDF;
  153.     untie %FN;
  154.     untie %SEEN;
  155. }
  156.  
  157. sub wanted {
  158.     my $fns = $name;
  159.  
  160.     if ($name eq $man3direxp) {
  161.         $prune = 1;
  162.     }
  163.     $fns =~ s:$prefix/::;
  164.     return if $SEEN{$fns};
  165.     return unless -f $_;
  166.     if ($name =~ /man|bin|\.(pod|pm)$/) {
  167.         if (!/(~|,v)$/) {
  168.             $did = $FN{'last'}++;
  169.             $SEEN{$fns} = &index($name, $fns, $did); 
  170.         }
  171.     }
  172. }
  173.  
  174. sub index {
  175.     my $fn  = shift;
  176.     my $fns = shift;
  177.     my $did = shift;
  178.     my %tf;
  179.     my $maxtf = 0;
  180.     my $pod = ($fns =~ /\.pod|man/);
  181.  
  182.     open(IN, "<$fn") || warn "Could not open $fn: $!\n", return (0);
  183.     while ($line = <IN>) {
  184.         if ($line =~ /^=head/) {
  185.             $pod = 1;
  186.         } elsif ($line =~ /^=cut/){
  187.             $pod = 0;
  188.         } else {
  189.             next unless $pod;
  190.         }
  191.         for $word (&normalize($line)) {
  192.             next if $stop{$word};
  193.             $tf{$word}++;
  194.         }
  195.     }
  196.     for $tf (values %tf) {
  197.         $maxtf = $tf if $tf > $maxtf;
  198.     }
  199.     for $word (keys %tf) {
  200.         $IDF{$word}++;
  201.         $IF{$word} = '' unless defined $IF{$word}; # perl -w
  202.         $IF{$word} .= pack($p.$p, $did, $tf{$word});
  203.     }
  204.     close(IN);
  205.     $FN{$did} = pack($p, $maxtf).$fns; 
  206.     print STDERR "$fns\n";
  207.     1;
  208. }
  209.  
  210. sub normalize {
  211.     my $line = join ' ', @_;
  212.     my @result;
  213.  
  214.     $line =~ tr/A-Z/a-z/;
  215.     $line =~ tr/a-z0-9/ /cs;
  216.     for $word (split ' ', $line ) {
  217.         $word =~ s/^\d+//;
  218.         next unless length($word) > 2;
  219.         if ($stemmer) {
  220.             push @result, &$stemmer($word);
  221.         } else {
  222.             push @result, $word;
  223.         }
  224.     }
  225.     @result;
  226. }
  227.  
  228. sub search {
  229.     my %score;
  230.     my $maxhits = $opt_maxhits;
  231.     my (@unknown, @stop);
  232.  
  233.     &initstop if $opt_verbose;
  234.     for $word (normalize(@_)) {
  235.         unless ($IF{$word}) {
  236.             if ($stop{$word}) {
  237.                 push @stop, $word;
  238.             } else {
  239.                 push @unknown, $word;
  240.             }
  241.             next;
  242.         }
  243.         my %post = unpack($p.'*',$IF{$word});
  244.         my $idf = log($FN{'last'}/$IDF{$word});
  245.         for $did (keys %post) {
  246.             my ($maxtf) = unpack($p, $FN{$did});
  247.             $score{$did} = 0 unless defined $score{$did}; # perl -w 
  248.             $score{$did} += $post{$did} / $maxtf * $idf;
  249.         }
  250.     }
  251.     if ($opt_verbose) {
  252.         print "Unkown:  @unknown\n" if @unknown;
  253.         print "Ingnore: @stop\n" if @stop;
  254.     }
  255.     if ($opt_menu) {
  256.         my @menu;
  257.         my $answer = '';
  258.         my $no = 0;
  259.         my @s = ('1' .. '9', 'a' .. 'z');
  260.         my %s;
  261.         
  262.         for $did (sort {$score{$b} <=> $score{$a}} keys %score) {
  263.             my ($mtf, $path) = unpack($p.'a*', $FN{$did});
  264.             my $s = $s[$no];
  265.             push @menu, sprintf "%s %6.3f %s\n", $s, $score{$did}, $path;
  266.             $s{$s} = ++$no;
  267.             last unless --$maxhits;
  268.         }
  269.         &cbreak('on') if $opt_cbreak;
  270.         while (1) {
  271.             print @menu;
  272.             print "\nEnter Number or 'q'> ";
  273.             if ($opt_cbreak) {
  274.                 read(TTYIN,$answer,1);
  275.                 print "\n";
  276.             } else {
  277.                 $answer = <STDIN>;
  278.             }
  279.             last if $answer =~ /^q/i;
  280.             $answer = ($s{substr($answer,0,1)})-1;
  281.             if ($answer >= 0 and $answer <= $#menu) {
  282.                 my $selection = $menu[$answer];
  283.                 if ($selection =~ m:/man:) {
  284.                     my ($page, $sect) = 
  285.                         ($selection =~ m:([^/]*)\.(.{1,3})$:);
  286.                     print STDERR "Running man $sect $page\n";
  287.                     system 'man', $sect, $page;
  288.                 } else {
  289.                     my ($path) = ($selection =~ m:(\S+)$:);
  290.                     $path = $prefix.'/'.$path;
  291.                     print STDERR "Running pod2man $path\n";
  292.                     system "pod2man --official $path | $nroff -man | $pager";
  293.                 }
  294.             } else {
  295.                 my $path = $prefix."/bin/perlindex";
  296.                 system "pod2man --official $path | $nroff -man | $pager";
  297.             }
  298.         }
  299.         &cbreak('off') if $opt_cbreak;
  300.     } else {
  301.         for $did (sort {$score{$b} <=> $score{$a}} keys %score) {
  302.             printf("%6.3f %s\n", $score{$did}, 
  303.                    (unpack($p.'a*', $FN{$did}))[1]);
  304.             last unless --$maxhits;
  305.         }
  306.     }
  307. }
  308.  
  309. sub cbreak {
  310.     my $mode = shift;
  311.     if ($mode eq 'on') {
  312.         open(TTYIN, "</dev/tty") || die "can't read /dev/tty: $!";
  313.         open(TTYOUT, ">/dev/tty") || die "can't write /dev/tty: $!";
  314.         select(TTYOUT);
  315.         $| = 1;
  316.         select(STDOUT);
  317.         $SIG{'QUIT'} = $SIG{'INT'} = 'cbreak';
  318.     ReadMode 3; # Set cbreak mode
  319.     } else {
  320.     ReadMode 0; # Restore non-cbreak mode
  321.     }
  322. }
  323.  
  324.  
  325. $stopinited = 0;                # perl -w
  326. sub initstop {
  327.     return if $stopinited++;
  328.     while (<DATA>) {
  329.         next if /^\#/;
  330.         for (normalize($_)) {
  331.           $stop{$_}++;
  332.         }
  333.     }
  334. }
  335.  
  336. =head1 NAME
  337.  
  338. perlindex - index and query perl manual pages
  339.  
  340. =head1 SYNOPSIS
  341.  
  342.     perlindex -index
  343.  
  344.     perlindex tell me where the flowers are
  345.  
  346. =head1 DESCRIPTION
  347.  
  348. "C<perlindex -index>" generates an AnyDBM_File index which can be
  349. searched with free text queries "C<perlindex> I<a verbose query>".
  350.  
  351. Each word of the query is searched in the index and a score is
  352. generated for each document containing it. Scores for all words are
  353. added and the documents with the highest score are printed.  All words
  354. are stemed with Porters algorithm (see L<Text::English>) before
  355. indexing and searching happens.
  356.  
  357. The score is computed as:
  358.  
  359.     $score{$document} += $tf{$word,$document}/$maxtf{$document}
  360.                          * log ($N/$n{$word});
  361.  
  362. where
  363.  
  364. =over 10
  365.  
  366. =item C<$N>
  367.  
  368. is the number of documents in the index,
  369.  
  370. =item C<$n{$word}>
  371.  
  372. is the number of documents containing the I<word>,
  373.  
  374. =item C<$tf{$word,$document}>
  375.  
  376. is the number of occurances of I<word> in the I<document>, and
  377.  
  378. =item C<$maxtf{$document}>
  379.  
  380. is the maximum freqency of any word in I<document>.
  381.  
  382. =back
  383.  
  384. =head1 OPTIONS
  385.  
  386. All options may be abreviated.
  387.  
  388. =over 10
  389.  
  390. =item B<-maxhits> maxhits
  391.  
  392. Maximum numer of hits to display. Default is 15.
  393.  
  394. =item B<-menu>
  395.  
  396. =item B<-nomenu>
  397.  
  398. Use the matches as menu for calling C<man>. Default is B<-menu>.q
  399.  
  400. =item B<-cbreak>
  401.  
  402. =item B<-nocbreak>
  403.  
  404. Switch to cbreak in menu mode or dont. B<-cbreak> is the default.
  405.  
  406. =item B<-verbose>
  407.  
  408. Generates additional information which query words have been not found
  409. in the database and which words of the query are stopwords.
  410.  
  411. =back
  412.  
  413. =head1 EXAMPLE
  414.  
  415.     perlindex foo bar
  416.  
  417.     1  3.735 lib/pod/perlbot.pod
  418.     2  2.640 lib/pod/perlsec.pod
  419.     3  2.153 lib/pod/perldata.pod
  420.     4  1.920 lib/Symbol.pm
  421.     5  1.802 lib/pod/perlsub.pod
  422.     6  1.586 lib/Getopt/Long.pm
  423.     7  1.190 lib/File/Path.pm
  424.     8  1.042 lib/pod/perlop.pod
  425.     9  0.857 lib/pod/perlre.pod
  426.     a  0.830 lib/Shell.pm
  427.     b  0.691 lib/strict.pm
  428.     c  0.691 lib/Carp.pm
  429.     d  0.680 lib/pod/perlpod.pod
  430.     e  0.680 lib/File/Find.pm
  431.     f  0.626 lib/pod/perlsyn.pod
  432.     Enter Number or 'q'>
  433.  
  434. Hitting the keys C<1> to C<f> will display the corresponding manual
  435. page. Hitting C<q> quits. All other keys display this manual page.
  436.  
  437. =head1 FILES
  438.  
  439. The index will be generated in your man directory. Strictly speaking in 
  440. C<$Config{man1direxp}/..>
  441.  
  442.     The following files will be generated:
  443.  
  444.     index_fn           # docid -> (max frequency, filename)
  445.     index_idf          # term  -> number of documents containing term
  446.     index_if           # term  -> (docid, frequency)*
  447.     index_seen         # fn    -> indexed?
  448.     
  449.  
  450. =head1 AUTHOR
  451.  
  452. Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>
  453.  
  454. =cut
  455.  
  456. __END__
  457. # freeWAIS-sf stopwords
  458. a
  459. about
  460. above
  461. according
  462. across
  463. actually
  464. adj
  465. after
  466. afterwards
  467. again
  468. against
  469. all
  470. almost
  471. alone
  472. along
  473. already
  474. also
  475. although
  476. always
  477. among
  478. amongst
  479. an
  480. and
  481. another
  482. any
  483. anyhow
  484. anyone
  485. anything
  486. anywhere
  487. are
  488. aren't
  489. around
  490. as
  491. at
  492. b
  493. be
  494. became
  495. because
  496. become
  497. becomes
  498. becoming
  499. been
  500. before
  501. beforehand
  502. begin
  503. beginning
  504. behind
  505. being
  506. below
  507. beside
  508. besides
  509. between
  510. beyond
  511. billion
  512. both
  513. but
  514. by
  515. c
  516. can
  517. can't
  518. cannot
  519. caption
  520. co
  521. co.
  522. could
  523. couldn't
  524. d
  525. did
  526. didn't
  527. do
  528. does
  529. doesn't
  530. don't
  531. down
  532. during
  533. e
  534. each
  535. eg
  536. eight
  537. eighty
  538. either
  539. else
  540. elsewhere
  541. end
  542. ending
  543. enough
  544. etc
  545. even
  546. ever
  547. every
  548. everyone
  549. everything
  550. everywhere
  551. except
  552. f
  553. few
  554. fifty
  555. first
  556. five
  557. vfor
  558. former
  559. formerly
  560. forty
  561. found "
  562. four
  563. from
  564. further
  565. g
  566. h
  567. had
  568. has
  569. hasn't
  570. have
  571. haven't
  572. he
  573. he'd
  574. he'll
  575. he's
  576. hence
  577. her
  578. here
  579. here's
  580. hereafter
  581. hereby
  582. herein
  583. hereupon
  584. hers
  585. herself
  586. him
  587. himself
  588. his
  589. how
  590. however
  591. hundred
  592. i
  593. i'd
  594. i'll
  595. i'm
  596. i've
  597. ie
  598. if
  599. in
  600. inc.
  601. indeed
  602. instead
  603. into
  604. is
  605. isn't
  606. it
  607. it's
  608. its
  609. itself
  610. j
  611. k
  612. l
  613. last
  614. later
  615. latter
  616. latterly
  617. least
  618. less
  619. let
  620. let's
  621. like
  622. likely
  623. ltd
  624. m
  625. made
  626. make
  627. makes
  628. many
  629. maybe
  630. me
  631. meantime
  632. meanwhile
  633. might
  634. million
  635. miss
  636. more
  637. moreover
  638. most
  639. mostly
  640. mr
  641. mrs
  642. much
  643. must
  644. my
  645. myself
  646. n
  647. namely
  648. neither
  649. never
  650. nevertheless
  651. next
  652. nine
  653. ninety
  654. no
  655. nobody
  656. none
  657. nonetheless
  658. noone
  659. nor
  660. not
  661. nothing
  662. now
  663. nowhere
  664. o
  665. of
  666. off
  667. often
  668. on
  669. once
  670. one
  671. one's
  672. only
  673. onto
  674. or
  675. other
  676. others
  677. otherwise
  678. our
  679. ours
  680. ourselves
  681. out
  682. over
  683. overall
  684. own
  685. p
  686. per
  687. perhaps
  688. q
  689. r
  690. rather
  691. recent
  692. recently
  693. s
  694. same
  695. seem
  696. seemed
  697. seeming
  698. seems
  699. seven
  700. seventy
  701. several
  702. she
  703. she'd
  704. she'll
  705. she's
  706. should
  707. shouldn't
  708. since
  709. six
  710. sixty
  711. so
  712. some
  713. somehow
  714. someone
  715. something
  716. sometime
  717. sometimes
  718. somewhere
  719. still
  720. stop
  721. such
  722. t
  723. taking
  724. ten
  725. than
  726. that
  727. that'll
  728. that's
  729. that've
  730. the
  731. their
  732. them
  733. themselves
  734. then
  735. thence
  736. there
  737. there'd
  738. there'll
  739. there're
  740. there's
  741. there've
  742. thereafter
  743. thereby
  744. therefore
  745. therein
  746. thereupon
  747. these
  748. they
  749. they'd
  750. they'll
  751. they're
  752. they've
  753. thirty
  754. this
  755. those
  756. though
  757. thousand
  758. three
  759. through
  760. throughout
  761. thru
  762. thus
  763. to
  764. together
  765. too
  766. toward
  767. towards
  768. trillion
  769. twenty
  770. two
  771. u
  772. under
  773. unless
  774. unlike
  775. unlikely
  776. until
  777. up
  778. upon
  779. us
  780. used
  781. using
  782. v
  783. very
  784. via
  785. w
  786. was
  787. wasn't
  788. we
  789. we'd
  790. we'll
  791. we're
  792. we've
  793. well
  794. were
  795. weren't
  796. what
  797. what'll
  798. what's
  799. what've
  800. whatever
  801. when
  802. whence
  803. whenever
  804. where
  805. where's
  806. whereafter
  807. whereas
  808. whereby
  809. wherein
  810. whereupon
  811. wherever
  812. whether
  813. which
  814. while
  815. whither
  816. who
  817. who'd
  818. who'll
  819. who's
  820. whoever
  821. whole
  822. whom
  823. whomever
  824. whose
  825. why
  826. will
  827. with
  828. within
  829. without
  830. won't
  831. would
  832. wouldn't
  833. x
  834. y
  835. yes
  836. yet
  837. you
  838. you'd
  839. you'll
  840. you're
  841. you've
  842. your
  843. yours
  844. yourself
  845. yourselves
  846. z
  847. # occuring in more than 100 files
  848. acc
  849. accent
  850. accents
  851. and
  852. are
  853. bell
  854. can
  855. character
  856. corrections
  857. crt
  858. daisy
  859. dash
  860. date
  861. defined
  862. definitions
  863. description
  864. devices
  865. diablo
  866. dummy
  867. factors
  868. following
  869. font
  870. for
  871. from
  872. fudge
  873. give
  874. have
  875. header
  876. holds
  877. log
  878. logo
  879. low
  880. lpr
  881. mark
  882. name
  883. nroff
  884. out
  885. output
  886. perl
  887. pitch
  888. put
  889. rcsfile
  890. reference
  891. resolution
  892. revision
  893. see
  894. set
  895. simple
  896. smi
  897. some
  898. string
  899. synopsis
  900. system
  901. that
  902. the
  903. this
  904. translation
  905. troff
  906. typewriter
  907. ucb
  908. unbreakable
  909. use
  910. used
  911. user
  912. vroff
  913. wheel
  914. will
  915. with
  916. you
  917.  
  918.  
  919. __END__
  920. :endofperl
  921.