#!/usr/bin/perl

# Copyright Massachusetts Institute of technology, 2000.
# Written by Eric Prud'hommeaux

# Things that need to be done:
# 1: write it

#####
# What It Does:

use strict;

package W3C::Annotations::FlatUserRecords;
use POSIX;
use Fcntl ':flock'; # import LOCK_* constants

# W3C perl modules
use W3C::Util::Object;
use W3C::Util::Exception;

# package variables
use vars qw($REVISION $VERSION @ISA @EXPORT_OK);
$REVISION = '$Id: FlatUserRecords.pm,v 1.7 2004/07/06 18:51:36 eric Exp $ ';
@ISA = qw(W3C::Annotations::UserRecordSet);
use W3C::Annotations::UserRecord qw($RW_read $RW_write);

sub accessDB {
    my ($self, $file, $key, $value) = @_;
    my $ret = undef; # use in READ mode
    my %dbm;
    my $rwMode = (ref $value eq 'SCALAR' && $value == $RW_read) ? '' : '+<';
    my $lockMode = (ref $value eq 'SCALAR' && $value == $RW_read) ? LOCK_SH : LOCK_EX;
    my $op= (ref $value eq 'SCALAR' && $value == $RW_read) ? 'read' : 'write';
    my $fileMode = 4+32+128+256;
    my $expire = time() + $self->{-busyWait};

    # Emulate common functionality of dbms (I think) by creating noexistent db.
    if (!-e $file) {
	if (!open(DBFILE, ">$file")) {
	    $self->_throwException(new W3C::Util::FileOperationException(-filename => $file, -operation => 'create'));
	}	
    }
    if (!open(DBFILE, "$rwMode$file")) {
	$self->_throwException(new W3C::Util::FileOperationException(-filename => $file, -operation => $op));
    }

    flock(DBFILE, $lockMode);
    local $/ = undef;
    my $contents; # = <DBFILE>;
    sysread(DBFILE, $contents, 999999);

    my ($begin, $end) = (0, undef);
    my ($curValue, $rest) = (undef, '');
    my @soFar = ();
    while ($contents =~ m/\G(.*?)\n/gcxs) {
	my $line = $1;
	$end = pos $contents;
	my $curKey;
	($curKey, $curValue) = split(':', $line, 2);
	if ($curKey eq $key) {
	    $contents =~ m/\G(.*)$/gcxs;
	    $rest = $1;
	    last;
	}
	push (@soFar, $line);
	$curValue = undef;
	$begin = $end;
    }

    if (ref $value eq 'SCALAR') {
	if ($value == $RW_read) {
	    $ret = $curValue;
	} else {
	    &throw(new W3C::Util::ProgramFlowException());
	}
    } else {
	if (ref $value eq 'CODE') {
	    $value = &$value($curValue);
	}
	$ret = $value;
	truncate(DBFILE, 0);
	seek(DBFILE, 0, SEEK_SET);
	foreach my $soFar (@soFar) {
	    syswrite(DBFILE, "$soFar\n");
	}
	if (defined $value) {
	    syswrite(DBFILE, "$key:$value\n");
	}
	syswrite(DBFILE, $rest);
    }
    flock(DBFILE, LOCK_UN);
    close(DBFILE);
    return $ret;
}

sub createGroupEntry {
    my ($self, $user, $group, $file) = @_;
    $self->accessDB($file, $group, 
		    sub {$self->mergeUser($user, @_)});
}

# Get a groups record and merge in a new user.
sub mergeUser {
    my ($self, $user, $pendingEntry) = @_;
    my @users = split(' ', $pendingEntry);
    if (!grep {$_ eq $user} @users) {
	push (@users, $user);
    }
    return join(' ', @users);
}

1;

## FlatUserRecords: Generic interface to annotation user and group records for
#  users of the W3C Annotations project.

1;

__END__

=head1 NAME

W3C::Annotations::FlatUserRecords - A specialization L<UserRecord.pm> for flat files

=head1 SYNOPSIS

  use W3C::Annotations::DBMUserRecords;

=head1 DESCRIPTION

This module implements the L<W3C::Annotations::UserRecord> interface to user accounts. It stores and retrieves user information from a flat file. This database is compatible with the Apache user database, but defines several more fields. The L<W3C::Annotations::FlatUserRecord> is much more efficient, though probelematic.

This module is used with the W3C::Annotations CPAN module.

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

L<W3C::Annotations::UserRecord>
L<W3C::Annotations::DBMUserRecords>

=cut

