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

   1 #!/usr/bin/perl
   2
   3 #
   4 # Notes.pm
   5 # $Id: Notes.pm,v 1.9 2010/06/20 18:31:22 johnh Exp $
   6 #
   7 # Copyright (C) 1996-2006,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 class.
  16 #
  17
  18 require 5.000;
  19 package Notes;
  20 use Carp;
  21 use strict;
  22
  23 #----------------------------------------------------------------------
  24
  25 # my($Notes::revsion) = '$Id: Notes.pm,v 1.9 2010/06/20 18:31:22 johnh Exp $'; #' font-lock hack
  26 # my($Notes::VERSION) = 1.00;
  27
  28 # public method
  29 # optional argument: pathname to read
  30 sub new {
  31     my ($class, $file) = @_;
  32     my $self = bless {};
  33     if (defined($file)) {
  34         $self->read_from_file($file);
  35     } else {
  36         $self->init();
  37     };
  38     return $self;
  39 }
  40
  41
  42 # public method
  43 sub read_from_file {
  44     my ($self, $filename) = @_;
  45
  46     $self->init();
  47
  48     open(FILE, "<$filename") || croak "Cannot open $filename";
  49     my(@lines) = <FILE>;
  50     close FILE;
  51     my($i);
  52     my($start, $Subject) = (0, undef);
  53     my(%entries);
  54
  55     for ($i = 0; $i < $#lines; $i++) {
  56         if ($lines[$i] =~ /^\* / &&
  57                 $lines[$i+1] =~ /^-+\r?$/) {
  58             $self->push_entry($Subject, join("", @lines[$start .. $i-1]));
  59             $start = $i;
  60             ($Subject) = ($lines[$i] =~ /^\*\s+(.*)\r?$/);
  61         };
  62     };
  63     $i = $#lines + 1;
  64     $self->push_entry($Subject, join("", @lines[$start .. $i-1]));
  65     return 1;
  66 }
  67
  68 # public_method
  69 sub subjects {
  70     my($self) = @_;
  71     return $self->{'subjects'};
  72 }
  73
  74 # public method
  75 sub by_subject {
  76     my($self, $Subject) = @_;
  77     my($subject) = lc($Subject);
  78     return wantarray ? () : undef
  79         if (!defined($self->{'entryis_by_subject'}{$subject}));
  80     my(@ret) = ();
  81     foreach (@{$self->{'entryis_by_subject'}{$subject}}) {
  82         push (@ret, $self->{'entries'}[$_]);
  83     };
  84     return @ret;
  85 }
  86
  87 # public method
  88 sub prelude {
  89     my($self) = @_;
  90     return $self->{'pre'};
  91 }
  92
  93
  94 # private method
  95 sub push_entry {
  96     my($self, $Subject, $entry) = @_;
  97     if (!defined($Subject)) {
  98         $self->{'pre'} = $entry;
  99         return;
 100     };
 101     my($subject) = lc($Subject);
 102     push (@{ $self->{'subjects'} }, $Subject);
 103     push (@{ $self->{'entries'} }, $entry);
 104     push (@{ $self->{'entryis_by_subject'}{$subject} }, $#{$self->{'entries'}});
 105 }
 106
 107
 108 # private method
 109 sub init {
 110     my($self) = @_;
 111 # These inits break things.  Go figure.
 112 #    @{ $self->{'subjects'} } =  @{$self->{'entries'}} = ();
 113 #    %{ $self->{'entryis_by_subject'} } = ();
 114     $self->{'pre'} = '';
 115 }
 116