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