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}};
}