DBD-XBase

 view release on metacpan or  search on metacpan

dbit/30insertfetch.t  view on Meta::CPAN

    #   Insert a row into the test table.......
    #
    Test($state or $dbh->do("INSERT INTO $table"
			    . " VALUES(1, 'Alligator Descartes', 1111,"
			    . " 'Some Text')"), 'insert')
	or DbiError($dbh->err, $dbh->errstr);

    #
    #   Now, try SELECT'ing the row out. 
    #
    Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
					   . " WHERE id = 1"),
	 'prepare select')
	or DbiError($dbh->err, $dbh->errstr);
    
    Test($state or $cursor->execute, 'execute select')
	or DbiError($cursor->err, $cursor->errstr);
    
    my ($row, $errstr);
    Test($state or (defined($row = $cursor->fetchrow_arrayref)  &&
		    !($cursor->errstr)), 'fetch select')
	or DbiError($cursor->err, $cursor->errstr);
    
    Test($state or ($row->[0] == 1 &&
                    $row->[1] eq 'Alligator Descartes' &&    
                    $row->[2] == 1111 &&    
                    $row->[3] eq 'Some Text'), 'compare select')
	or DbiError($cursor->err, $cursor->errstr);
    
    Test($state or $cursor->finish, 'finish select')
	or DbiError($cursor->err, $cursor->errstr);
    
    Test($state or undef $cursor || 1, 'undef select');
    
    #
    #   ...and delete it........
    #
    Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"), 'delete')
	or DbiError($dbh->err, $dbh->errstr);

    #
    #   Now, try SELECT'ing the row out. This should fail.
    #
    Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
					   . " WHERE id = 1"),
	 'prepare select deleted')
	or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute, 'execute select deleted')
	or DbiError($cursor->err, $cursor->errstr);

    Test($state or (!defined($row = $cursor->fetchrow_arrayref)  &&
		    (!defined($errstr = $cursor->errstr) ||
		     $cursor->errstr eq '')), 'fetch select deleted')
	or DbiError($cursor->err, $cursor->errstr);

    Test($state or $cursor->finish, 'finish select deleted')
	or DbiError($cursor->err, $cursor->errstr);

    Test($state or undef $cursor || 1, 'undef select deleted');


    #
    #   Finally drop the test table.
    #
    Test($state or $dbh->do("DROP TABLE $table"), 'drop')
	or DbiError($dbh->err, $dbh->errstr);

}

dbit/40bindparam.t  view on Meta::CPAN

    #
    #   Create a new table; EDIT THIS!
    #
    Test($state or ($def = TableDefinition($table,
					   ["id",   "INTEGER",  4, 0],
					   ["name", "CHAR",    64, $COL_NULLABLE]) and
		    $dbh->do($def)), 'create', $def)
	or DbiError($dbh->err, $dbh->errstr);


    Test($state or $cursor = $dbh->prepare("INSERT INTO $table"
	                                   . " VALUES (?, ?)"), 'prepare')
	or DbiError($dbh->err, $dbh->errstr);

    #
    #   Insert some rows
    #

    # Automatic type detection
    my $numericVal = 1;
    my $charVal = "Alligator Descartes";
    Test($state or $cursor->execute($numericVal, $charVal), 'execute insert 1')
	or DbiError($dbh->err, $dbh->errstr);

    # Does the driver remember the automatically detected type?
    Test($state or $cursor->execute("3", "Jochen Wiedmann"),
	 'execute insert num as string')
	or DbiError($dbh->err, $dbh->errstr);
    $numericVal = 2;
    $charVal = "Tim Bunce";
    Test($state or $cursor->execute($numericVal, $charVal), 'execute insert 2')
	or DbiError($dbh->err, $dbh->errstr);

    # Now try the explicit type settings
    Test($state or $cursor->bind_param(1, " 4", SQL_INTEGER()), 'bind 1')
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->bind_param(2, "Andreas König"), 'bind 2')
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->execute, 'execute binds')
	or DbiError($dbh->err, $dbh->errstr);

    # Works undef -> NULL?
    Test($state or $cursor->bind_param(1, 5, SQL_INTEGER()))
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->bind_param(2, undef))
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->execute)
 	or DbiError($dbh->err, $dbh->errstr);
  

    Test($state or $cursor -> finish, 'finish');

    Test($state or undef $cursor  ||  1, 'undef cursor');

    Test($state or $dbh -> disconnect, 'disconnect');

    Test($state or undef $dbh  ||  1, 'undef dbh');

    #
    #   And now retreive the rows using bind_columns
    #
    #
    #   Connect to the database
    #
    Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
	 'connect for read')
	or ServerError();

    Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
					   . " ORDER BY id"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->bind_columns(undef, \$id, \$name))
	   or DbiError($dbh->err, $dbh->errstr);
    Test($state or ($ref = $cursor->fetch)  &&  $id == 1  &&
	 $name eq 'Alligator Descartes')
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));

    Test($state or (($ref = $cursor->fetch)  &&  $id == 2  &&
		    $name eq 'Tim Bunce'))
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));

    Test($state or (($ref = $cursor->fetch)  &&  $id == 3  &&
		    $name eq 'Jochen Wiedmann'))
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));

    Test($state or (($ref = $cursor->fetch)  &&  $id == 4  &&
		    $name eq 'Andreas König'))
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));
 
    Test($state or (($ref = $cursor->fetch)  &&  $id == 5  &&
		    (!defined($name) or $name eq '')))
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));

    Test($state or undef $cursor  or  1);

    #
    #   Finally drop the test table.
    #
    Test($state or $dbh->do("DROP TABLE $table"))
	   or DbiError($dbh->err, $dbh->errstr);
}

dbit/40blobs.t  view on Meta::CPAN

		print OUT $query;
		close(OUT);
	    }
	}
        Test($state or $dbh->do($query))
	    or DbiError($dbh->err, $dbh->errstr);

	#
	#   Now, try SELECT'ing the row out.
	#
	Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
					       . " WHERE id = 1"))
	       or DbiError($dbh->err, $dbh->errstr);

	Test($state or $cursor->execute)
	       or DbiError($dbh->err, $dbh->errstr);

	Test($state or (defined($row = $cursor->fetchrow_arrayref)))
	    or DbiError($cursor->err, $cursor->errstr);

	Test($state or (@$row == 2  &&  $$row[0] == 1  &&  $$row[1] eq $blob))
	    or (ShowBlob($blob),
		ShowBlob(defined($$row[1]) ? $$row[1] : ""));

	Test($state or $cursor->finish)
	    or DbiError($cursor->err, $cursor->errstr);

	Test($state or undef $cursor || 1)
	    or DbiError($cursor->err, $cursor->errstr);

	#
	#   Finally drop the test table.
	#
	next;

	Test($state or $dbh->do("DROP TABLE $table"))
	    or DbiError($dbh->err, $dbh->errstr);
    }
}

dbit/40listfields.t  view on Meta::CPAN

	   or DbiError($dbh->err, $dbh->errstr);

    #
    #   Create a new table
    #
    Test($state or ($def = TableDefinition($table, @table_def),
		    $dbh->do($def)))
	   or DbiError($dbh->err, $dbh->errstr);


    Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
	   or DbiError($cursor->err, $cursor->errstr);

    my $res;
    Test($state or (($res = $cursor->{'NUM_OF_FIELDS'}) == @table_def))
	   or DbiError($cursor->err, $cursor->errstr);
    if (!$state && $verbose) {
	printf("Number of fields: %s\n", defined($res) ? $res : "undef");
    }

    Test($state or ($ref = $cursor->{'NAME'})  &&  @$ref == @table_def
	            &&  (lc $$ref[0]) eq $table_def[0][0]
		    &&  (lc $$ref[1]) eq $table_def[1][0])
	   or DbiError($cursor->err, $cursor->errstr);
    if (!$state && $verbose) {
	print "Names:\n";
	for ($i = 0;  $i < @$ref;  $i++) {
	    print "    ", $$ref[$i], "\n";
	}
    }

    Test($state  or  ($dbdriver eq 'CSV') or ($dbdriver eq 'ConfFile')
	 or ($ref = $cursor->{'NULLABLE'})  &&  @$ref == @table_def
	     &&  !($$ref[0] xor ($table_def[0][3] & $COL_NULLABLE))
	     &&  !($$ref[1] xor ($table_def[1][3] & $COL_NULLABLE)))
	   or DbiError($cursor->err, $cursor->errstr);
    if (!$state && $verbose) {
	print "Nullable:\n";
	for ($i = 0;  $i < @$ref;  $i++) {
	    print "    ", ($$ref[$i] & $COL_NULLABLE) ? "yes" : "no", "\n";
	}
    }

    Test($state or undef $cursor  ||  1);


    #
    #  Drop the test table
    #
    Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->execute)
	or DbiError($cursor->err, $cursor->errstr);

    #  NUM_OF_FIELDS should be zero (Non-Select)
    Test($state or ($cursor->{'NUM_OF_FIELDS'} == 0))
	or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
			       $cursor->{'NUM_OF_FIELDS'});
    Test($state or (undef $cursor) or 1);
}

dbit/40nulls.t  view on Meta::CPAN



    #
    #   Test whether or not a field containing a NULL is returned correctly
    #   as undef, or something much more bizarre
    #
    Test($state or $dbh->do("INSERT INTO $table VALUES"
	                    . " ( NULL, 'NULL-valued id' )"))
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
	                                   . " WHERE " . IsNull("id")))
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($rv = $cursor->fetchrow_arrayref) or $dbdriver eq 'CSV'
	 or $dbdriver eq 'ConfFile')
	or DbiError($dbh->err, $dbh->errstr);

    Test($state or (!defined($$rv[0])  and  defined($$rv[1])) or
	 $dbdriver eq 'CSV' or $dbdriver eq 'ConfFile')
	or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->finish)
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or undef $cursor  ||  1);


    #
    #   Finally drop the test table.
    #
    Test($state or $dbh->do("DROP TABLE $table"))
	   or DbiError($dbh->err, $dbh->errstr);

}

dbit/40numrows.t  view on Meta::CPAN

    #   This section should exercise the sth->rows
    #   method by preparing a statement, then finding the
    #   number of rows within it.
    #   Prior to execution, this should fail. After execution, the
    #   number of rows affected by the statement will be returned.
    #
    Test($state or $dbh->do("INSERT INTO $table"
			    . " VALUES( 1, 'Alligator Descartes' )"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
					   . " WHERE id = 1")))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($numrows = $cursor->rows) == 1  or  ($numrows == -1))
	or ErrMsgF("Expected 1 rows, got %s.\n", $numrows);

    Test($state or ($numrows = TrueRows($cursor)) == 1)
	or ErrMsgF("Expected to fetch 1 rows, got %s.\n", $numrows);

    Test($state or $cursor->finish)
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or undef $cursor or 1);

    Test($state or $dbh->do("INSERT INTO $table"
			    . " VALUES( 2, 'Jochen Wiedmann' )"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
					    . " WHERE id >= 1")))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($numrows = $cursor->rows) == 2  or  ($numrows == -1))
	or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);

    Test($state or ($numrows = TrueRows($cursor)) == 2)
	or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);

    Test($state or $cursor->finish)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or undef $cursor or 1);

    Test($state or $dbh->do("INSERT INTO $table"
			    . " VALUES(3, 'Tim Bunce')"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
					    . " WHERE id >= 2")))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($numrows = $cursor->rows) == 2  or  ($numrows == -1))
	or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);

    Test($state or ($numrows = TrueRows($cursor)) == 2)
	or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);

    Test($state or $cursor->finish)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or undef $cursor or 1);

    #
    #   Finally drop the test table.
    #
    Test($state or $dbh->do("DROP TABLE $table"))
	   or DbiError($dbh->err, $dbh->errstr);

}

driver_characteristics  view on Meta::CPAN

     Does the driver or database implement a local row cache when fetching
     rows from a select statement? What is the default size?

DBD::XBase doesn't maintain a row cache (not applicable since the data
file is local to the driver).


=head2 Positioned updates and deletes

     Does the driver support positioned updates and deletes (also called
     updatable cursors)?  If so, what syntax is used? E.g, "update ...
     where current of $cursor_name".

DBD::XBase does not support positioned updates or deletes.


=head2 Differences from the DBI specification

     List any significant differences in behaviour from the current DBI
     specification.

DBD::XBase has no known significant differences in behaviour from the

eg/use_index  view on Meta::CPAN

	use XBase::Index;

	my $index = new XBase::Index "klantnum.ndx";
	$index->prepare_select;

	while (my @data = $index->fetch())
		{ print "@data\n"; }
	__END__

Note that we explicitely create object XBase::Index, not XBase, and
call methods of this object, not of cursor object.

This will list the keys from the ndx file, together with their
corresponding values, which are the record numbers in the dbf file.
If the results are not those you would expect, email me.

If you have an index format that can hold more index structures in one
file (mdx, cdx), you have to specify the tag in the file:

	my $index = new XBase::Index "cust.cdx", 'tag' => 'addr';

lib/DBD/XBase.pm  view on Meta::CPAN


sub _set_rows {
	my $sth = shift;
	if (not @_ or not defined $_[0]) {
		$sth->{'xbase_rows'} = undef; return -1;
	}
	$sth->{'xbase_rows'} = ( $_[0] ? $_[0] : '0E0' );
}
# Execute the current statement, possibly binding parameters. For
# nonselect commands the actions needs to be done here, for select we
# just create the cursor and wait for fetchrows
sub execute {
	my $sth = shift;

	# the binds_order arrayref holds the conversion from the first
	# occurence of the named parameter to its name;
	# we bind the parameters here
	my $parsed_sql = $sth->{'xbase_parsed_sql'};
	for (my $i = 0; $i < @_; $i++) {
		$sth->bind_param($parsed_sql->{'binds_order'}[$i], $_[$i]);
	}

lib/DBD/XBase.pm  view on Meta::CPAN

		push @{$parsed_sql->{'usedfields'}}, $xbase->field_names;
		$parsed_sql->{'selectfieldscount'} = scalar $xbase->field_names;
	}

	# we only set NUM_OF_FIELDS for select command -- which is
	# exactly what selectfieldscount means
	if (not $sth->FETCH('NUM_OF_FIELDS')) {
		$sth->STORE('NUM_OF_FIELDS', $parsed_sql->{'selectfieldscount'});
	}
		
	# this cursor will be needed, because both select and update and
	# delete with where clause need to fetch the data first
	my $cursor = $xbase->prepare_select(@{$parsed_sql->{'usedfields'}});

	
	# select with order by clause will be done using "substatement"
	if ($command eq 'select' and defined $parsed_sql->{'orderfields'}) {
		my @orderfields = @{$parsed_sql->{'orderfields'}};

		# make a copy of the $parsed_sql hash, but delete the
		# orderfields value
		my $subparsed_sql = { %$parsed_sql };
		delete $subparsed_sql->{'orderfields'};

lib/DBD/XBase.pm  view on Meta::CPAN

					$sortfn .= "\$_[0]->[$i] <=> \$_[1]->[$i]";
				}
			}
		}
		my $fn = eval "sub { $sortfn }";
		# sort them and store in xbase_lines
		$sth->{'xbase_lines'} =
			[ map { [ @{$_}[scalar(@orderfields) .. scalar(@$_) - 1 ] ] }
				sort { &{$fn}($a, $b) } @$data ];
	} elsif ($command eq 'select') {
		$sth->{'xbase_cursor'} = $cursor;
	} elsif ($command eq 'delete') {
		if (not defined $wherefn) {
			my $last = $xbase->last_record;
			for (my $i = 0; $i <= $last; $i++) {
				if (not (($xbase->get_record_nf($i, 0))[0])) {
					$xbase->delete_record($i);
					$rows = 0 unless defined $rows;
					$rows++;
				}
			}
		} else {
			my $values;
			while (defined($values = $cursor->fetch_hashref)) {
				next unless &{$wherefn}($xbase, $values,
				$bind_values, 0);
				$xbase->delete_record($cursor->last_fetched);
				$rows = 0 unless defined $rows;
				$rows++;
			}
		}
	} elsif ($command eq 'update') {
		my $values;
		while (defined($values = $cursor->fetch_hashref)) {
			next if defined $wherefn and not
			&{$wherefn}($xbase, $values, $bind_values);
			my %newval;
			@newval{ @{$parsed_sql->{'updatefields'}} } =
			&{$parsed_sql->{'updatefn'}}($xbase, $values,
			$bind_values);
			$xbase->update_record_hash($cursor->last_fetched, %newval);
			$rows = 0 unless defined $rows;
			$rows++;
		}
	} elsif ($command eq 'drop') {
		# dropping the table is really easy
		$xbase->drop or do {
			$sth->DBI::set_err(60, "Dropping table $table failed: "
							. $xbase->errstr);
			return;
		};

lib/DBD/XBase.pm  view on Meta::CPAN

	return $sth->DBD::XBase::st::_set_rows($rows);
}



sub fetch {
        my $sth = shift;
	my $retarray;
	if (defined $sth->{'xbase_lines'}) {
		$retarray = shift @{$sth->{'xbase_lines'}};
	} elsif (defined $sth->{'xbase_cursor'}) {
		my $cursor = $sth->{'xbase_cursor'};
		my $wherefn = $sth->{'xbase_parsed_sql'}{'wherefn'};

		my $xbase = $cursor->table;
		my $values;
		while (defined($values = $cursor->fetch_hashref)) {
			### use Data::Dumper; print Dumper $sth->{'xbase_bind_values'};
			next if defined $wherefn and not
			&{$wherefn}($xbase, $values,
					$sth->{'xbase_bind_values'});
			last;
		}
		$retarray = [ &{$sth->{'xbase_parsed_sql'}{'selectfn'}}($xbase, $values, $sth->{'xbase_bind_values'}) ]
			if defined $values;
	}

lib/XBase.pm  view on Meta::CPAN

					$i++;
				}
			}
		}
	}

	if (@unknown_fields) {
		$self->Error("There have been unknown fields `@unknown_fields' specified.\n");
		return 0;
	}
	my $cursor = $self->prepare_select(@fields);
	my @record;
	if (defined $table) {
		local $^W = 0;
		&ShowBoxTable( $cursor->names(), [], [],
			sub {
				if ($_[0]) { $cursor->rewind(); }
				else { $cursor->fetch() }
				});
	} else {
		while (@record = $cursor->fetch) {
			print join($fs, map { defined $_ ? $_ : $undef } @record), $rs;
		}
	}
	1;
}


# ###################
# Reading the records

lib/XBase.pm  view on Meta::CPAN


# Processing on read
sub _read_deleted {
	my $value = shift;
	if ($value eq '*') { return 1; } elsif ($value eq ' ') { return 0; }
	undef;
}

sub get_all_records {
	my $self = shift;
	my $cursor = $self->prepare_select(@_);

	my $result = [];
	my @record;
	while (@record = $cursor->fetch())
		{ push @$result, [ @record ]; }
	$result;
}

# #############
# Write records

# Write record, values of the fields are in the argument list.
# Record is always undeleted
sub set_record {

lib/XBase.pm  view on Meta::CPAN

    	my ($deleted, $id) = $table->get_record($_, "ID")
    	die $table->errstr unless defined $deleted;
    	next if $deleted;
	$table->update_record_hash($_, "MSG" => "New message")
						if $id == 123;
    }

=head2 Sequentially reading the file

If you plan to sequentially walk through the file, you can create
a cursor first and then repeatedly call B<fetch> to get next record.

=over 4

=item prepare_select

As parameters, pass list of field names to return, if no parameters,
the following B<fetch> will return all fields.

=item prepare_select_with_index

The first parameter is the file name of the index file, the rest is
as above. For index types that can hold more index structures in on
file, use arrayref instead of the file name and in that array include
file name and the tag name, and optionaly the index type.
The B<fetch> will then return records in the ascending order,
according to the index.

=back

Prepare will return object cursor, the following method are methods of
the cursor, not of the table.

=over 4

=item fetch

Returns the fields of the next available undeleted record. The list
thus doesn't contain the C<_DELETED> flag since you are guaranteed
that the record is not deleted.

=item fetch_hashref

Returns a hash reference of fields for the next non deleted record.

=item last_fetched

Returns the number of the record last fetched.

=item find_eq

This only works with cursor created via B<prepare_select_with_index>.
Will roll to the first record what is equal to specified argument, or
to the first greater if there is none equal. The following B<fetch>es
then continue normally.

=back

Examples of using cursors:

    my $table = new XBase "names.dbf" or die XBase->errstr;
    my $cursor = $table->prepare_select("ID", "NAME", "STREET");
    while (my @data = $cursor->fetch) {
	### do something here, like print "@data\n";
    }

    my $table = new XBase "employ.dbf";
    my $cur = $table->prepare_select_with_index("empid.ndx");
    ## my $cur = $table->prepare_select_with_index(
		["empid.cdx", "ADDRES", "char"], "id", "address");
    $cur->find_eq(1097);
    while (my $hashref = $cur->fetch_hashref
			and $hashref->{"ID"} == 1097) {

lib/XBase.pm  view on Meta::CPAN

The second example shows that after you have done B<find_eq>, the
B<fetch>es continue untill the end of the index, so you have to check
whether you are still on records with given value. And if there is no
record with value 1097 in the indexed field, you will just get the
next record in the order.

The updating example can be rewritten to:

    use XBase;
    my $table = new XBase "test.dbf" or die XBase->errstr;
    my $cursor = $table->prepare_select("ID")
    while (my ($id) = $cursor->fetch) {
	$table->update_record_hash($cursor->last_fetched,
			"MSG" => "New message") if $id == 123	
    }

=head2 Dumping the content of the file

A method B<get_all_records> returns reference to an array containing
array of values for each undeleted record at once. As parameters,
pass list of fields to return for each record.

To print the content of the file in a readable form, use method

lib/XBase/Index.pm  view on Meta::CPAN


		local $^W = 0;
		print "Page $page->{'num'}:\tkeys: @{[ map { s/\s+$//; $_; } @{$page->{'keys'}}]}\n\tvalues: @{$page->{'values'}}\n" if $DEBUG;
		print "\tlefts: @{$page->{'lefts'}}\n" if defined $page->{'lefts'} and $DEBUG;
	}
	$page;
}

# Get next (value, record number in dbf) pair
# The important values of the index object are 'level' holding the
# current level of the "cursor", 'pages' holding an array of pages
# currently open for each level and 'rows' with an array of current row
# in each level
sub fetch {
	my $self = shift;
	my ($level, $page, $row, $key, $val, $left);
	
	# cycle while we get to the leaf record or otherwise get
	# a real value, not a pointer to lower page
	while (not defined $val)
		{

lib/XBase/Index.pm  view on Meta::CPAN

	my $cur = $table->prepare_select_with_index("indexfile",
		"list", "of", "fields", "to", "return");

or

	my $cur = $table->prepare_select_with_index(
		[ "indexfile_with_tags", "tag_name" ],
		"list", "of", "fields", "to", "return");

where we specify the tag in the index file (this is necessary with cdx
and mdx). After we have the cursor, we can search to given record and
start fetching the data:

	$cur->find_eq('jezek');
	while (my @data = $cur->fetch) { # do something

=head2 Supported index formats

The following table summarizes which formats are supproted by
XBase::Index. If the field says something else that Yes, I welcome
testers and offers of example index files.

new-XBase  view on Meta::CPAN


type of call. This gives you an object to interact with the table.
You can then access the records using their position in the file

    my ($deleted, $id, $name, $born)
    	= $table->get_record($num, 'ID', 'NAME', 'DO_BIRTH');
    if ($id == 436) {
    	$table->update_record_hash($num, 'NAME' => 'Peter')
    }

or via cursors that allow you to walk through the file

    my $cur = $table->prepare_select('ID', 'NAME', 'DO_BIRTH');
    while (my ($id, $name, $born) = $cur->fetch) {
		# do some work
    }

If there are index files for given table, they can be used to speedup
the searches. You can either use them explicitely to open cursor based
on the index

    my $cur = $table->prepare_select_with_index('dbaseid.ndx'
    	'ID', 'NAME', 'DO_BIRTH');
    if ($cur->find_eq(436)) {
    	my ($id, $name, $born) = $cur->fetch;
    }

or you can attach the indexes to the table and they will be used when
needed and also updated when the dbf table changes

new-XBase  view on Meta::CPAN

    	$table->update_record_hash($cur->last_fetched,
    		'name' => 'Peter');
    }

The cdx, mdx and SDBM index files (with the same base name as the dbf)
are attached by default.

=head1 LIST OF METHODS

The following methods are available for XBase.pm tables and their
cursors, their meaning and parameters are in more detail described
below:

=over 4

=item General methods working with the table

	new			close
	create			drop
	attach_index
	pack			errstr

new-XBase  view on Meta::CPAN

	field_decimal

=item Accessing and modifying the records

	get_record		set_record
	get_record_nf		set_record_hash
	get_record_as_hash	update_record_hash
	get_all_records		delete_record
	dump_records		undelete_record

=item Creating cursors and working with them

	prepare_select			fetch
	prepare_select_with_index	fetch_hashref
	prepare_select_where		last_fetched
					find_eq
					cursor_uses_index

=back

=head1 General methods

The general methods working with the whole files or tables.

=head2 new

Opens the existing dbf file and provides an object to interact with

new-XBase  view on Meta::CPAN

Like B<set_record_hash> but fields that do not have value specified
in the hash retain their original value.

=head2 delete_record, undelete_record

Marks the specified record in the file deleted/undeleted.

=head1 Sequentially reading the file

If you plan to sequentially walk through the file, you can create
a cursor first and then repeatedly call B<fetch> to get next record.

=head2 prepare_select

Creates and returns an cursor to walk through the file.
As parameters, pass list of field names to return, by default all
fields.

=head2 prepare_select_with_index

The first parameter is the file name of the index file, the rest is
optional list of field names. For index types that can hold more
index structures in one file (have tags), instead of file name use
arrayref with the file name, the tag name and optionaly the index type
(at the moment, expressions are not supported, so XBase.pm won't be
able to determine type of the index unless you tell it).
The B<fetch> will then return records in the ascending order,
according to the index.

=head2 prepare_select_where

The first parameter is a string with boolean expression, the rest is
optional list of field names. The B<fetch>es on the returned cursor
will return only records matching the expression. If there are
attached index files, they may be used to speed the search.

The previous methods on the table object will return cursor object,
the following methods are to be called on the cursor, not on the
table.

=head2 fetch

Returns the fields of the next available undeleted record from the
cursor. The list thus doesn't contain the C<_DELETED> flag since you
are guaranteed that the record is not deleted.

=item fetch_hashref

Returns a hash reference of fields for the next undeleted record from
the cursor.

=item last_fetched

Returns the record number of the record last fetched.

=item find_eq

This only works with cursor created via B<prepare_select_with_index>
or B<prepare_select_where> that uses index. As a parameter it takes
the cursor value to find. It returns 1 if there is matching record,
or 0 otherwise.

If there is a match, the next B<fetch>es will fetch the records
matching, and continue with records greater than the specified value
(walk the index). If there isn't match, B<fetch> returns next greater
record.

=item cursor_uses_index

Returns true if the cursor created with B<prepare_select_where> uses
index.

=head1 EXAMPLES

Assorted examples of reading and writing:

    my @data = $table->get_record(3, "jezek", "krtek");
    my $hashref = $table->get_record_as_hash(38);
    $table->set_record_hash(8, "jezek" => "jezecek",
					"krtek" => 5);

new-XBase  view on Meta::CPAN

    use XBase;
    my $table = new XBase "test.dbf" or die XBase->errstr;
    for (0 .. $table->last_record) {
    	my ($deleted, $id) = $table->get_record($_, "ID")
    	die $table->errstr unless defined $deleted;
    	next if $deleted;
	$table->update_record_hash($_, "MSG" => "New message")
						if $id == 123;
    	}

Examples of using cursors:

    my $table = new XBase "names.dbf" or die XBase->errstr;
    my $cursor = $table->prepare_select("ID", "NAME", "STREET");
    while (my @data = $cursor->fetch)
	{ ### do something here, like print "@data\n"; }

    my $table = new XBase "employ.dbf";
    my $cur = $table->prepare_select_with_index("empid.ndx");
    ## my $cur = $table->prepare_select_with_index(
		["empid.cdx", "ADDRES"], "id", "address");
    $cur->find_eq(1097);
    while (my $hashref = $cur->fetch_hashref
			and $hashref->{"ID"} == 1097)
	{ ### do something here with $hashref }

new-XBase  view on Meta::CPAN

The second example shows that after you have done B<find_eq>, the
B<fetch>es continue untill the end of the index, so you have to check
whether you are still on records with given value. And if there is no
record with value 1097 in the indexed field, you will just get the
next record in the order.

The updating example can be rewritten to:

    use XBase;
    my $table = new XBase "test.dbf" or die XBase->errstr;
    my $cursor = $table->prepare_select("ID")
    while (my ($id) = $cursor->fetch) {
	$table->update_record_hash($cursor->last_fetched,
			"MSG" => "New message") if $id == 123	
	}

=head1 DATA TYPES

The character fields are returned "as is". No charset or other
translation is done. The numbers are converted to Perl numbers. The
date fields are returned as 8 character string of the 'YYYYMMDD' form
and when inserting the date, you again have to provide it in this
form. No checking for the validity of the date is done. The datetime



( run in 0.857 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )