Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 113 lines (89 sloc) 2.28 KB
#!/usr/bin/perl -w
#
# catsubject
# $Id: catsubject,v 1.7 2003/05/23 16:26:24 johnh Exp $
#
# Copyright (C) 1996,2012 Free Software Foundation, Inc.
# Comments to <johnh@isi.edu>.
#
# This file is under the Gnu Public License, version 2.
# For details see the COPYING which accompanies this distribution.
#
sub usage {
print STDOUT <<END;
usage: $0 [-m] subject
Outputs (to stdout) the contents of all entries with the given subject.
Assumes that rawindex is up-to-date.
Options:
-m match subjects with a perl regexp
END
exit 1
}
require 5.000;
use Getopt::Long;
&usage if ($#ARGV >= 0 && $ARGV[0] eq '-?');
my(%opts);
&GetOptions(\%opts, qw(m));
&usage if ($#ARGV < 0);
#BEGIN {
# $home_dir = ((getpwuid($<))[7]);
# @config = `$home_dir/.notesrc perl`;
# die "$0: missing .notesrc\n" if ($#config == -1);
# eval join("", @config);
# unshift(@INC, $notes{'bin_dir'});
#}
use POSIX;
BEGIN { unshift(@INC, $ENV{'NOTES_BIN_DIR'}); };
use NotesVars;
use Notes;
use NotesIndex;
use strict;
# NEEDSWORK: replace with real argument parsing
my($Subject) = @ARGV;
my($subject) = lc($Subject);
my($match_subject) = ($opts{'m'});
my($subject_description) = ($match_subject ? "match on " : "") . $Subject;
#
# Say what we're doing.
#
print "\n* What\n------\n\nOutput of:\n\t$0 " . $subject_description . "\n" .
"as of " . localtime(time) . "\n\n\n";
my($notes_index) = new NotesIndex($::notes{dir} . "/rawindex");
#
# Match?
#
my(@subjects);
if ($match_subject) {
my($subjects) = ();
my($code) = '$s =~ m{' . $subject . '}';
my($s);
foreach $s ($notes_index->subjects()) {
if (eval $code) {
push(@subjects, $s);
};
};
print "Subjects:\n", join("\n", @subjects), "\n\n";
} else {
@subjects = ($subject);
};
#
# Do it.
#
my($url);
my($s);
foreach $s (@subjects) {
foreach $url ($notes_index->by_subject($s)) {
my($notes) = new Notes(url_to_pathname($url));
my($entry);
foreach $entry ($notes->by_subject($s)) {
my($this) = "this: <$url>";
my(@lines) = split(/\n/, $entry);
if ($lines[2] =~ /^prev: /) {
print join("\n", @lines[0..2], $this, @lines[3..$#lines], "\n\n");
} else {
print join("\n", @lines[0..1], $this, @lines[2..$#lines], "\n\n");
};
};
};
};
exit 0;