view release on metacpan or  search on metacpan

lib/App/Repository.pm  view on Meta::CPAN

                    $rowchange->[$rowidx] = "";
                    $nrows++;
                }
                if ($App::DEBUG && $self->{context}->dbg(7)) {
                    my $context = $self->{context};
                    $context->dbgprint("rep->commit(): [$self->{sql}]");
                    $context->dbgprint("    [", join("|",@{$rows->[$rowidx]}), "]");
                }
            }
        }
    }
    $self->{context}->dbgprint("rep->commit(): nrows=$nrows")
        if ($App::DEBUG && $self->{context}->dbg(2));
}

#############################################################################
# rollback()
#############################################################################

=head2 rollback()

    * Signature: $rep->rollback();
    * Param:     void
    * Return:    void
    * Throws:    App::Exception::Repository
    * Since:     0.01

    Sample Usage: 

    $rep->rollback();

=cut

sub rollback {
    my $self = shift;
}

#############################################################################
# METHODS
#############################################################################

=head1 Methods: Import/Export Data From File

=cut

#############################################################################
# import_rows()
#############################################################################

=head2 import_rows()

    * Signature: $rep->import_rows($table, $columns, $file);
    * Signature: $rep->import_rows($table, $columns, $file, $options);
    * Param:     $table        string
    * Param:     $columns      ARRAY     names of columns of the fields in the file
    * Param:     $file         string
    * Param:     $options      named
    * Param:     replace       boolean   rows should replace existing rows based on unique indexes
    * Param:     field_sep     char      character which separates the fields in the file (can by "\t")
    * Param:     field_quote   char      character which optionally encloses the fields in the file (i.e. '"')
    * Param:     field_escape  char      character which escapes the quote chars within quotes (i.e. "\")
    * Return:    void
    * Throws:    App::Exception::Repository
    * Since:     0.01

    Sample Usage: 

    $rep->import_rows("usr","usr.dat");

    # root:x:0:0:root:/root:/bin/bash
    $rep->import_rows("usr",
        [ "username", "password", "uid", "gid", "comment", "home_directory", "shell" ],
        "/etc/passwd" ,
        { field_sep => ":", });

=cut

sub import_rows {
    &App::sub_entry if ($App::trace);
    my ($self, $table, $columns, $file, $options) = @_;
    $columns = $self->_get_default_columns($table) if (!$columns);
    my $field_sep = $options->{field_sep} || ",";
    my $field_quote = $options->{field_quote};
    my $field_escape = $options->{field_escape};

    open(App::Repository::DBI::FILE, "< $file") || die "Unable to open $file for reading: $!";
    my (@row, $quoted_field_regexp, $field_regexp);
    while (<App::Repository::DBI::FILE>) {
        chomp;
        if ($field_quote) {
            @row = ();
            # TODO: use the _read_rows_from_file() method
            # TODO: incorporate escaping
            $field_regexp        = "$field_sep?$field_quote([^$field_quote]*)$field_quote";
            $quoted_field_regexp = "$field_sep?([^$field_sep]*)";
            while ($_) {
                if ($_ =~ s/^$quoted_field_regexp//) {
                    push(@row, $1);
                }
                elsif ($_ =~ s/^$field_regexp//) {
                    push(@row, $1);
                }
                else {
                    die "Imported data doesn't match quoted or unquoted field [$_]";
                }
            }
        }
        else {
            @row = split(/$field_sep/);
        }
        # TODO: use insert_rows() instead of insert_row()
        $self->insert_row($table, $columns, \@row);
    }
    close(App::Repository::DBI::FILE);

    &App::sub_exit() if ($App::trace);
}

#############################################################################
# export_rows()
#############################################################################

=head2 export_rows()

    * Signature: $rep->export_rows($table, $columns, $file);
    * Signature: $rep->export_rows($table, $columns, $file, $options);
    * Param:     $table        string
    * Param:     $file         string
    * Param:     $options      named
    * Param:     columns       ARRAY     names of columns of the fields in the file
    * Param:     replace       boolean   rows should replace existing rows based on unique indexes
    * Param:     field_sep     char      character which separates the fields in the file (can by "\t")
    * Param:     field_quote   char      character which optionally encloses the fields in the file (i.e. '"')
    * Param:     field_escape  char      character which escapes the quote chars within quotes (i.e. "\")
    * Return:    void
    * Throws:    App::Exception::Repository
    * Since:     0.01

    Sample Usage: 

    $rep->export_rows("usr","usr.dat");

    # root:x:0:0:root:/root:/bin/bash
    $rep->export_rows("usr", "passwd.dat" ,{
        field_sep => ":",
        columns => [ "username", "password", "uid", "gid", "comment", "home_directory", "shell" ],
    });

=cut

sub export_rows {
    &App::sub_entry if ($App::trace);
    my ($self, $table, $columns, $file, $options) = @_;
    $columns = $self->_get_default_columns($table) if (!$columns);
    my $rows = $self->get_rows($table, {}, $columns);
    my $field_sep = $options->{field_sep} || ",";
    my $field_quote = $options->{field_quote};
    my $field_escape = $options->{field_escape};

    open(App::Repository::DBI::FILE, "> $file") || die "Unable to open $file for writing: $!";
    my ($i, $value);
    foreach my $row (@$rows) {
        if ($field_quote) {
            for ($i = 0; $i <= $#$row; $i++) {
                print App::Repository::DBI::FILE $field_sep if ($i > 0);
                $value = $row->[$i];
                if ($value =~ /$field_sep/) {
                    if ($field_escape) {
                        $value =~ s/$field_escape/$field_escape$field_escape/g;
                        $value =~ s/$field_quote/$field_escape$field_quote/g;
                    }
                    print App::Repository::DBI::FILE $field_quote, $value, $field_quote;
                }
                else {
                    print App::Repository::DBI::FILE $value;
                }
            }
        }
        else {
            print App::Repository::DBI::FILE join($field_sep, @$row), "\n";
        }
    }
    close(App::Repository::DBI::FILE);

    &App::sub_exit() if ($App::trace);
}

sub _read_rows_from_file {
    &App::sub_entry if ($App::trace);
    my ($self, $fh, $cols, $options) = @_;
    my $maxrows             = $options->{maxrows};
    my $null_value          = $options->{null_value};
    $null_value = '\N' if (!defined $null_value);
    my $field_sep           = $options->{field_sep} || ",";
    my $field_quote         = $options->{field_quote} || "";
    my $field_escape        = $options->{field_escape} || "";
    die "TODO: field_escape not yet implemented" if ($field_escape);
    my $fieldsep_regexp     = ($field_sep eq "|") ? '\|' : $field_sep;
    my $quoted_field_regexp = "$field_sep?$field_quote([^$field_quote]*)$field_quote";
    my $field_regexp        = "$field_sep?([^$field_sep]*)";
    my $num_cols = $#$cols + 1;
    my $rows_read = 0;
    my $rows = [];
    my ($num_values_read, $line, $line_remainder, $row);
    while (<$fh>) {
        chomp;
        $line = $_;
        if ($line) {
            if (!$field_quote && !$field_escape) {
                $row = [ map { $_ eq $null_value ? undef : $_ } split(/$fieldsep_regexp/, $line) ];
                $num_values_read = $#$row + 1;
            }
            else {
                $num_values_read = 0;
                $line_remainder = $line;
                $row = [];
                while ($line_remainder) {
                    if ($line_remainder =~ s/^$quoted_field_regexp//) {
                        push(@$row, $1 eq $null_value ? undef : $1);
                    }
                    elsif ($line_remainder =~ s/^$field_regexp//) {
                        push(@$row, $1 eq $null_value ? undef : $1);
                    }
                    else {
                        die "Imported data [$line] doesn't match quoted or unquoted field at [$line_remainder]";
                    }
                }
            }
            die "In imported data [$line], num values on line [$num_values_read] != num columns expected [$num_cols]"
                if ($num_values_read != $num_cols);
            push(@$rows, $row);
            $rows_read ++;
            if ($maxrows && $rows_read >= $maxrows) {
                last;
            }
        }
    }
    &App::sub_exit($rows) if ($App::trace);
    return($rows);
}

#############################################################################
# METHODS
#############################################################################

=head1 Methods: Locking (Concurrency Management)

=cut

# this is a write lock for the table
sub _lock_table {
    &App::sub_entry if ($App::trace);
    my ($self, $table) = @_;
    if (! $self->{locked}) {   # I have locked it myself, so I don't need to again
        my ($name, $dbname, $context, $rlock);
        $name = $self->{name};
        $dbname = $self->{dbname};
        $context = $self->{context};
        $rlock = $context->resource_locker($name);  # get the one that corresponds to this repository
        $rlock->lock("db.$dbname.$table");
        $self->{locked} = 1;
    }
    &App::sub_exit() if ($App::trace);
}

# unlocks the write lock for the table
sub _unlock_table {
    &App::sub_entry if ($App::trace);
    my ($self, $table) = @_;