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

   1 #!/usr/bin/perl
   2
   3 #
   4 # NotesIndex.pm
   5 # $Id: NotesIndex.pm,v 1.3 2003/05/23 16:26:19 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 # A Perl module implement a notes-index class.
  16 #
  17
  18 package NotesIndex;
  19 use Carp;
  20 use strict;
  21
  22 require 5.000;
  23 $Notes::revsion = '$Id: NotesIndex.pm,v 1.3 2003/05/23 16:26:19 johnh Exp $';
  24 $Notes::VERSION = 1.00;
  25
  26 =head1 NAME
  27
  28 NotesIndex - a simple class for notes-index files
  29
  30 =head1 Public Methods
  31
  32 new, read_from_file, subjects, by_subject, prelude
  33
  34 =cut
  35 #' # font-lock hack
  36
  37 #----------------------------------------------------------------------
  38
  39
  40 # public method
  41 sub new {
  42     my ($class, $file) = @_;
  43     my $self = bless {};
  44     if (!defined($file)) {
  45         $self->init();
  46     } else {
  47         $self->read_from_file($file);
  48     };
  49     return $self;
  50 }
  51
  52
  53 # public method
  54 sub read_from_file {
  55     my ($self, $filename) = @_;
  56
  57     $self->init();
  58
  59     open(FILE, "<$filename") || croak "Cannot open $filename";
  60
  61     while (<FILE>) {
  62         chomp;
  63         $self->push_link($_);
  64     };
  65
  66     close FILE;
  67     return 1;
  68 }
  69
  70 # public_method
  71 sub subjects {
  72     my($self) = @_;
  73     return keys %{$self->{'links_by_subject'}};
  74 }
  75
  76 # public method
  77 sub by_subject {
  78     my($self, $subject) = @_;
  79     $subject = lc($subject);
  80     my($resref) = $self->{'links_by_subject'}{$subject};
  81     return wantarray ? () : undef
  82         if (!defined($resref));
  83     return wantarray ? @$resref : 1;
  84 }
  85
  86
  87 # private method
  88 sub push_link {
  89     my($self, $link) = @_;
  90     my($subject) = ($link =~ m/\d{2}\#\* (.*)$/);
  91     $subject = lc($subject);
  92     push (@{ $self->{'links_by_subject'}{$subject} }, $link);
  93 }
  94
  95
  96 # private method
  97 sub init {
  98     my($self) = @_;
  99 }
 100