##--------------------------------------------------------------------------##
##  File:
##	$Id: Namazu.pm,v 1.1 2002/09/03 16:30:47 ehood Exp $
##  Description:
##	POD at end of file.
##--------------------------------------------------------------------------##
##  Copyright (C) 2002	Earl Hood <earl@earlhood.com>
##
##  This program is free software; you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation; either version 2 of the License, or
##  (at your option) any later version.
##  
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##  
##  You should have received a copy of the GNU General Public License
##  along with this program; if not, write to the Free Software
##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##  02111-1307, USA
##--------------------------------------------------------------------------##

package MHArc::Namazu;

use Exporter;
@ISA = qw(Exporter);

@EXPORT_OK = qw(
  &nmz_get_field
  &nmz_load_rc
  &nmz_msg_id_search
);

use Fcntl;

##--------------------------------------------------------------------------##

BEGIN {
  $Debug = 0;
}

##--------------------------------------------------------------------------##

sub nmz_msg_id_search {
  my $index_dir = shift;
  my $id	= shift;

  # check format of message-id
  $id =~ s/\A\s+//;
  $id =~ s/\s+\Z//;
  if ($id !~ /\A<[^>]>\Z/) {
    $id = '<'.$id.'>';
  }

  # Pathname to nmz field message-id file
  my $id_file = join('/', $index_dir, 'NMZ.field.message-id');
  if (! -e $id_file) {
    warn qq/"$id_file" does not exist\n/;
    return undef;
  }

  local(*F);
  local($_);
  # see if message-id exists in archive
  if (!open(F, $id_file)) {
    warn qq/Unable to open "$id_file": $!\n/;
    return undef;
  }
  my $line = undef;
  while (<F>) {
    chomp;
    if (/^[^<]/) {
      # message-id in file not surrounded by <>'s
      $_ = '<'.$_.'>';
    }
    if ($id eq $_) {
      $line = $.;
      last;
    }
  }
  close(F);

  $line;
}

sub nmz_load_rc {
  my $file = shift;

  local(*NMZRC);
  if (!open(NMZRC, $file)) {
    warn qq/Unable to open "$file": $!\n/;
    return undef;
  }

  local $_;
  my $rc = { };
  my @index = ( );
  my $replace = ( );
  while (<NMZRC>) {
    next  if /^\s*#/;
    next  unless /\S/;
    chomp;
    my($opt, $value) = split(' ', $_, 2);
    $opt = lc $opt;
    if ($opt eq 'index') {
      $value =~ s/\s+\Z//;
      push(@index, $value);
      next;
    }
    if ($opt eq 'replace') {
      $value =~ s/\s+\Z//;
      push(@replace, [ split(' ', $value, 2) ]);
      next;
    }
  }
  $rc->{'index'} = [ @index ];
  $rc->{'replace'} = [ @replace ];
  $rc;
}

sub nmz_get_field {
  my $index	  = shift;    # Pathname of directory containing namazu index
  my $docid	  = shift;    # Document ID (i.e. Line number)
  my $field	  = lc shift; # Field to get value for

  my $value	   = undef;
  my $field_file   = join('/', $index, ('NMZ.field.'.$field));
  my $field_file_i = $field_file . '.i';

  local(*F);
  if (!sysopen(F, $field_file_i, (O_RDONLY))) {
    warn qq/Unable to open "$field_file_i": $!\n/;
    return undef;
  }
  if (!defined(sysseek(F, (4*($docid-1)), SEEK_SET))) {
    warn qq/Unable to seek on "$field_file_i": $!\n/;
    close(F);
    return undef;
  }
  my $n = 4;
  my $bytes = '';
  while ($n > 0) {
    my $i = sysread(F, $bytes, $n, 4-$n);
    if (!defined($i)) {
      warn qq/sysread error for "$field_file_i": $!\n/;
      close(F);
      return undef;
    }
    if ($i == 0) {
      warn qq/Unexpected of EOF for "$field_file_i"\n/;
      close(F);
      return undef;
    }
    $n -= $i;
  }
  close(F);

  my $offset = unpack('N', $bytes);
  if (!open(F, $field_file)) {
    warn qq/Unable to open "$field_file": $!\n/;
    return undef;
  }
  if (!seek(F, $offset, SEEK_SET)) {
    warn qq/Unable to seek to $offset on "$field_file": $!\n/;
    close(F);
    return undef;
  }
  $value = scalar(<F>);
  chomp $value  if defined($value);
  close(F);

  $value;
}

##--------------------------------------------------------------------------##
1;
__END__

=head1 NAME

MHArc::Namazu - General Namazu-related utilities for mail archiving system.

=head1 SYNOPSIS

  use MHArc::Namazu;

=head1 DESCRIPTION

This module contains a collection of Namazu-related utility routines.

=head1 VARIABLES

The following module variables can be set to affect the behavior
of the utility routines:

=over

=item C<$Debug>

If set to a true value, routines will print out debugging information,
if appropriate.

=back

=head1 ROUTINES

By default, no routines are exported into the calling namespace.
Routines in this module can be imported by explicitly listing the
routines to import in the C<use> declaration:

  use MHArc::Namazu qw( nmz_get_field );

The following routines are availale:

=over

=item C<nmz_get_field($index, $docid, $field)>

Retrieve the value of a field for a document. C<$index> is the
pathname of the directory containing Namazu index files.  C<$docid>
is the ID of the document to retrieve a field value of.  Document
ID correlate to the line numbers within C<NMZ.field.I<field-name>>
files.  C<$field> is the field to retrieve the value of.

The return value of this function is the field value, or C<undef> if
the field value could not determined.

Any error messages generated by this function are printed via Perl's
C<warn> operator.

=item C<nmz_load_rc($filename)>

Parse Namazu configuration file denoted by C<$filename>.  The return
value is a hash reference where the keys are the option names (normalized
ot lowercases) and the values are the values associated with
the options.  The actual value types depends on the option.

If the conf file cannot be loaded, C<undef> is returned.

=back

=head1 DEPENDENCIES

C<Fcntl>

=head1 VERSION

C<$Id: Namazu.pm,v 1.1 2002/09/03 16:30:47 ehood Exp $>

=head1 AUTHOR

Earl Hood, earl@earlhood.com

This module is part of the mharc archiving system and comes with
ABSOLUTELY NO WARRANTY and may be copied only under the terms of
the GNU General Public License, which may be found in the MHArc
distribution.

=cut