view release on metacpan or  search on metacpan

FlatFile.pm  view on Meta::CPAN

=head2 C<< $db = FlatFile->new(FILE => $filename, FIELDS => [...], ...); >>

The C<new> method opens the database.  At least two arguments are
required: the C<FILE> argument that gives the path at which the data
can be accessed, and the C<FIELDS> argument that names the fields, in
order.

By default, the file will be opened for reading only.  To override
this, supply a C<MODE> argument whose value is a mode string like the
one given as the second argument to the Perl built-in C<open>
function.  For read-write access, you should probably use C<< MODE => "+<" >>.  As of version 0.10, only C<< < >>, C<< +< >>, and C<< +> >> are supported.

The file will be assumed to contain "records" that are divided into
"fields".  By default, records are assumed to be terminated with a
newline character; to override this, use C<< RECSEP => $separator >>.
Fields are assumed to be separated by whitespace; to override, use
C<< FIELDSEP => $pattern >>.  C<$pattern> may be a compiled regex
object or a literal string.  If it is a pattern, you must also supply
an example string with C<<FIELDSEPSTR>> that will be used when writing
out records.  For example, for the Unix password file, whose fields
are separated by colons, use:

        FIELDSEP => ":"

but for a file whose fields are separated by one or more space
characters, use:

        FIELDSEP => qr/ +/,  FIELDSEPSTR => "  "

The C<FIELDSEPSTR> argument tells the module to use two spaces between
fields when writing out new records.

You may supply a 

	DEFAULTS => { field => default_value, ... }

argument that specifies default values for some or all of the fields.  Fields for which no default value 

When changes are written to the disk, the module first copies the
modified data to a temporary file, then atomically replaces the old
file with the temporary file.  To specify a temporary filename, use
C<< TMPFILE => $filename >>.  Otherwise, it will default to the name
of the main file with C<".tmp"> appended.

Record objects will be allocated in dynamically generated classes
named C<FlatFile::Rec::A>,
C<FlatFile::Rec::B>, and so on, which inherit from common
base class C<FlatFile::Rec>.  To override this choice of
class, supply a class name with C<< RECCLASS => $classname >>.  You
may want your custom class to inherit from
C<FlatFile::Rec>.

=cut

my $classid = "A";
sub new {
  my ($class, %opts) = @_;
  my $self = {recno => 0};

  bless $self => $class;

  # acquire object properties from argument list (%opts)
  # or from class defaults or default defaults, as appropriate.
  # _default will detect missing required values
  # and unknown key names
  for my $source (\%opts, $class->_classvars) {
    $self->_acquire_settings($source, check_keys => 1);
  }

  # TODO: TESTS for this logic
  if (exists $self->{FIELDSEP}) {
    if (ref $self->{FIELDSEP}) {
      defined($self->{FIELDSEPSTR})
        or croak "FIELDSEPSTR required in conjunction with FIELDSEP";
    } else {
      # literal string; compile it to a pattern
      my $str = $self->{FIELDSEP};
      $self->{FIELDSEPSTR} = $str;
      $self->{FIELDSEP} = "\Q$str";
    }
  }

  $self->_acquire_settings(\%default_default, mandatory => 1);

  $self->{RECCLASS} = join "::", $self->{RECBASECLASS}, $classid++
    unless $self->{RECCLASS};

  $self->{TMPFILE} = $self->{FILE} . ".tmp"
    unless exists $opts{TMPFILE};

  $self->_calculate_field_offsets;

  $self->_generate_record_class;


  return $self->_open_file ? $self : ();
}

sub _acquire_settings {
  my ($self, $settings, %opt)  = @_;
  for my $k (keys %$settings) {
    if ($opt{check_keys} && not exists $default_default{$k}) {
      croak "unknown key '$k'";
    }
    if (! exists $self->{$k} && exists $settings->{$k}) {
      if ($opt{mandatory} && not defined $settings->{$k}) {
        croak "Required key '$k' unspecified";        
      }
      $self->{$k} = $settings->{$k};
    }
  }
}

use Fcntl qw(O_RDONLY O_RDWR O_TRUNC);
my %MODE_OK = ('<', O_RDONLY, '+<', O_RDWR,
               '+>', O_RDWR|O_TRUNC);
sub _mode_flags {
  my $self = shift;
  $MODE_OK{$self->{MODE}};
}

FlatFile.pm  view on Meta::CPAN

record, and a synonymous <color> method that does the exact same
thing. If the database was opened for writing, the record objects will
also support a C<set_color> method to modify the color in a record.
The effects of the C<set_*> methods will be propagated to the file
when the database is flushed.

Other methods follow.

=cut

package FlatFile::Rec;
use Carp 'croak';

sub default {
  my $self = shift;
  my $class = ref($self) || $self;
  my $field = shift;
  no strict 'refs';
  my $d = \%{"$class\::DEFAULT"};
  return wantarray ? (exists $d->{$field}, $d->{$field}) : $d->{$field};
}

=head2 C<< $record->fields >>

Returns a list of the fields in the object, in order.

=cut

sub fields {
  my $self = shift;
  my $class = ref($self) || $self;
  no strict 'refs';
  return @{"$class\::FIELD"};
}

sub new {
  my ($class, $db, $id, @data) = @_;
  my $self = {};
  my %data;

  my @f = $class->fields;
  @data{@f} = @data;

  # set default values in data hash
  for my $f (@f) {
    if (not defined $data{$f}) {
      my ($has_default, $default_value) = $class->default($f);
      if ($has_default) {
        $data{$f} = $default_value;
      } else {
        my $msg = "required field '$f' missing from record";
        $msg .= " $id" if $id;
        croak $msg;
      }
    }
  }

  $self->{data} = \%data;
  $self->{db} = $db;
  $self->{id} = $id;
  bless $self => $class;
}

=head2 C<< $record->db >>

Returns the database object from which the record was originally selected.
This example shows how one might modify a record and then write the
change to disk, even if the original database object was unavailable:

        $employee->set_salary(1.06 * $employee->salary);
        $employee->db->flush;

=cut

sub db {
  $_[0]{db};
}

sub id {
  $_[0]{id};
}

=head2 C<< %hash = $record->as_hash >>

Returns a hash containing all the data in the record.  The keys in the
hash are the field names, and the corresponding values are the record
data.

=cut

sub as_hash {
  my $self = shift;
  return %{$self->{data}};
}

=head2 C<< @data = $record->as_array >>

Return the record data values only.

=cut

sub as_array {
  my $self = shift;
  my @f = $self->fields;
  return @{$self->{data}}{@f};
}

=head2 C<< $line = $record->as_string >>

Return the record data in the same form that it appeared in the
original file.  For example, if the record were selected from the Unix
password file, this might return the string 
C<"root:x:0:0:Porpoise Super-User:/:/sbin/sh">.

=cut

sub as_string {
  my $self = shift;
  my $fsep = $self->db->field_separator_string;
  my $rsep = $self->db->record_separator;
  my @data = $self->as_array;
  return join($fsep, @data) . $rsep;
}

=head2 C<< $line = $record->delete >>

Delete this record from its associated database.  It will be removed
from the disk file the next time the database object is flushed.

=cut

# delete this record from its database
sub delete {
  my $self = shift;
  $self->db->delete_rec($self);
}

package FlatFile::Position;

sub new {
  my ($class, $record_number_ref) = @_;
  my $recno = $$record_number_ref;
  my $self = sub {
    $$record_number_ref = $recno;
  };
  bless $self => $class;
}

sub DESTROY {
  my $self = shift;
  $self->();
}

1;

__END__

=pod

=head1 BUGS

Various design defects; see TODO file

This module is ALPHA-LEVEL software.  Everything about it, including
the interface, might change in future versions.

=head1 AUTHOR

Mark Jason Dominus

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2006 by Mark Jason Dominus.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut