code.delx.au - gnu-emacs-elpa/blob - packages/notes-mode/catsubject

   1 #!/usr/bin/perl -w
   2
   3 #
   4 # catsubject
   5 # $Id: catsubject,v 1.7 2003/05/23 16:26:24 johnh Exp $
   6 #
   7 # Copyright (C) 1996,2012  Free Software Foundation, Inc.
   8 # Comments to <johnh@isi.edu>.
   9 #
  10 # This file is under the Gnu Public License, version 2.
  11 # For details see the COPYING which accompanies this distribution.
  12 #
  13
  14
  15 sub usage {
  16     print STDOUT <<END;
  17 usage: $0 [-m] subject
  18
  19 Outputs (to stdout) the contents of all entries with the given subject.
  20
  21 Assumes that rawindex is up-to-date.
  22
  23 Options:
  24     -m  match subjects with a perl regexp
  25
  26 END
  27     exit 1
  28 }
  29
  30 require 5.000;
  31
  32 use Getopt::Long;
  33
  34 &usage if ($#ARGV >= 0 && $ARGV[0] eq '-?');
  35 my(%opts);
  36 &GetOptions(\%opts, qw(m));
  37 &usage if ($#ARGV < 0);
  38
  39 #BEGIN {
  40 #    $home_dir = ((getpwuid($<))[7]);
  41 #    @config = `$home_dir/.notesrc perl`;
  42 #    die "$0: missing .notesrc\n" if ($#config == -1);
  43 #    eval join("", @config);
  44 #    unshift(@INC, $notes{'bin_dir'});
  45 #}
  46
  47 use POSIX;
  48 BEGIN { unshift(@INC, $ENV{'NOTES_BIN_DIR'}); };
  49 use NotesVars;
  50 use Notes;
  51 use NotesIndex;
  52 use strict;
  53
  54
  55
  56 # NEEDSWORK: replace with real argument parsing
  57 my($Subject) = @ARGV;
  58 my($subject) = lc($Subject);
  59 my($match_subject) = ($opts{'m'});
  60
  61 my($subject_description) = ($match_subject ? "match on " : "") . $Subject;
  62
  63
  64 #
  65 # Say what we're doing.
  66 #
  67 print "\n* What\n------\n\nOutput of:\n\t$0 " . $subject_description . "\n" .
  68     "as of " . localtime(time) . "\n\n\n";
  69
  70 my($notes_index) = new NotesIndex($::notes{dir} . "/rawindex");
  71
  72
  73 #
  74 # Match?
  75 #
  76 my(@subjects);
  77 if ($match_subject) {
  78     my($subjects) = ();
  79     my($code) = '$s =~ m{' . $subject . '}';
  80     my($s);
  81     foreach $s ($notes_index->subjects()) {
  82         if (eval $code) {
  83             push(@subjects, $s);
  84         };
  85     };
  86     print "Subjects:\n", join("\n", @subjects), "\n\n";
  87 } else {
  88     @subjects = ($subject);
  89 };
  90
  91 #
  92 #  Do it.
  93 #
  94 my($url);
  95 my($s);
  96 foreach $s (@subjects) {
  97     foreach $url ($notes_index->by_subject($s)) {
  98         my($notes) = new Notes(url_to_pathname($url));
  99         my($entry);
 100         foreach $entry ($notes->by_subject($s)) {
 101             my($this) = "this: <$url>";
 102             my(@lines) = split(/\n/, $entry);
 103             if ($lines[2] =~ /^prev: /) {
 104                 print join("\n", @lines[0..2], $this, @lines[3..$#lines], "\n\n");
 105             } else {
 106                 print join("\n", @lines[0..1], $this, @lines[2..$#lines], "\n\n");
 107             };
 108         };
 109     };
 110 };
 111
 112 exit 0;