view release on metacpan or  search on metacpan

CodeBase.xs  view on Meta::CPAN

	for (field_no = 1; field_no <= n_fields; field_no++) 
	{
	    CB_TRACE(1, (", %s", SvPV(ST(field_no), na)));
	    if (!set_field_value(d4fieldJ(self->data4, field_no), ST(field_no)))
	    {
		CB_TRACE(1, ("...\nreplace_record returns %d\n", cb_errno));
		XSRETURN_UNDEF;
	    }
	}
    }

    CB_TRACE(1, (")\nreplace_record returns OK\n"));
    XSRETURN_YES;


##############################################################################
#
# Field handling functions
#
#	fldcount
#	fieldinfo
#	names
#	type
#	fields
#	field($name)
#	set_field(name, value)

MODULE = CodeBase		PACKAGE = CodeBase::RecordPtr

# $fieldcount = $file->fldcount;
# 	Returns the number of fields
int
fldcount(self)
    CodeBase::Record	*self

 CODE:
    CB_TRACE(1, ("fldcount(\"%s\"\n", SELF));
    cb_errno = CB_SUCCESS;
    RETVAL = d4numFields(self->data4);
    CB_TRACE(1, ("fldcount returns %d\n", RETVAL));

 OUTPUT:
    RETVAL



# @fieldinfo = $file->fieldinfo();
# 	Returns a field info array suitable for use in creating a new 
#	database file.  This consists of alternating field name and type values.
void
fieldinfo(self)
     CodeBase::Record	*self

 PREINIT:
    int 	field_no;
    char	buffer[256];
    FIELD4	*field;
    char	field_type;
    int		n_fields;
	
 PPCODE:
    CB_TRACE(1, ("fieldinfo(\"%s\")\n", SELF));
    CB_TRACE(1, ("fieldinfo returns ("));
    cb_errno = CB_SUCCESS;

    n_fields = d4numFields(self->data4);
    
    EXTEND(sp, 2 * n_fields);

    for (field_no = 1; field_no <= n_fields; field_no++) 
    {
	field = d4fieldJ(self->data4, field_no);

	CB_TRACE(1, ("%s\"%s\"", (field_no > 1) ? ", " : "", f4name(field)));

	PUSHs(sv_2mortal(newSVpv((char *)f4name(field), 0)));

	switch (field_type = f4type(field))
	{
	case r4str:	    
	case r4date:	    
	case r4memo:
	    sprintf(buffer, "%c%d", field_type, f4len(field));
	    break;
		
	case r4num:
	    sprintf(buffer, "N%d.%d", f4len(field), f4decimals(field));
	    break;
		    
	default:
	    buffer[0] = field_type;
	    buffer[1] = '\0';
	    break;
	}
	CB_TRACE(1, ("=> \"%s\"", buffer));
	PUSHs(sv_2mortal(newSVpv(buffer, 0)));
    }
    CB_TRACE(1, (")\n"));


# @names = $file->names;
# 	Returns an array of field names
void
names(self)
    CodeBase::Record	*self

 PREINIT:
    const FIELD4	*field;
    const char		*field_name;
    int			field_no, n_fields;

 PPCODE:
    CB_TRACE(1, ("names(\"%s\"\n", SELF));
    cb_errno = CB_SUCCESS;
    n_fields = d4numFields(self->data4);
    CB_TRACE(1, ("names returns ("));
    EXTEND(sp, n_fields);
    for (field_no = 1; field_no <= n_fields; field_no++)
    {
	field      = d4fieldJ(self->data4, field_no);
	field_name = f4name(field);
	PUSHs(sv_2mortal(newSVpv((char *)field_name, 0)));
	CB_TRACE(1, ("%s%s", (field_no > 1 ? ", " : ""), field_name));
    }
    CB_TRACE(1, (")\n"));


    
# $type = $file->type($field_name);
#	Returns the type of a field. 
char *
type(self, name)
    CodeBase::Record	*self
    char	*name

 PREINIT:
    FIELD4	*field;
    char	field_type;
    char	buffer[256];

 CODE:
    CB_TRACE(1, ("type(\"%s\", \"%s\")\n", SELF, name));
    cb_errno = CB_SUCCESS;

    field = d4field(self->data4, name);
    if (field == NULL)
    {
	cb_errno = CB_ERR_INVALID_USAGE;
	XSRETURN_UNDEF;
    }

    switch (field_type = f4type(field))
    {
    case r4str:	    
    case r4date:	    
    case r4memo:
	sprintf(buffer, "%c%d", field_type, f4len(field));
	break;
	
    case r4num:
	sprintf(buffer, "N%d.%d", f4len(field), f4decimals(field));
	break;
		    
    default:
	buffer[0] = field_type;
	buffer[1] = '\0';
	break;
    }
    RETVAL = buffer;
    CB_TRACE(1, ("type returns \"%s\"\n", buffer));

 OUTPUT:
    RETVAL




# @fields = $file->fields([$field_name ...]);
#	Returns a list of field values.  If any field names are specified, the values of those
#	fields are returned in the order of the names, otherwise the values of all fields are
#	returned in the order they occur within a record.
void
fields(self, ...)
    CodeBase::Record	*self

 PREINIT:
    FIELD4	*field;
    int 	field_no;
    char	buffer[256];
    char	fieldtype;
    Boolean	only_named_fields = (items > 1);
    int		n_fields;

 PPCODE:
    CB_TRACE(1, ("values(\"%s\")\n", SvPV(ST(0),na)));
    CB_TRACE(1, ("values returns ("));
    cb_errno = CB_SUCCESS;
    n_fields = (only_named_fields ? items - 1 : d4numFields(self->data4));

    EXTEND(sp, n_fields);
    for (field_no = 1; field_no <= n_fields; field_no++) 
    {
	if (!only_named_fields) 
	{
	    field = d4fieldJ(self->data4, field_no);
	}
	else if (   SvOK(ST(field_no))
		 || ((field = d4field(self->data4, SvPV(ST(field_no), na))) == NULL))
	{
	    PUSHs(sv_newmortal());
	    continue;
	}

	switch (fieldtype = f4type(field))
	{
	case r4str:	    
	case r4date:	    
	case r4log:
	    CB_TRACE(1, ("%s\"%.*s\"", (field_no > 1 ? ", " : ""), 
			 field_len(field), f4ptr(field)));
	    XPUSHs(sv_2mortal(newSVpv(f4ptr(field), field_len(field))));
	    break;
		
	case r4memo:
	    CB_TRACE(1, ("%s\"%.*s\"", (field_no > 1 ? ", " : ""), 
			 field_len(field), f4memoPtr(field)));
	    XPUSHs(sv_2mortal(newSVpv(f4memoPtr(field), field_len(field))));
	    break;

	case r4num:
	    CB_TRACE(1, ("%s%f", (field_no > 1 ? ", " : ""), f4double(field)));
	    XPUSHs(sv_2mortal(newSVnv(f4double(field))));
	    break;
		    
	default:
	    buffer[0] = fieldtype;
	    buffer[1] = '\0';
	    break;
	}
    }
    CB_TRACE(1, (")\n"));





# $field = $file->field("field_name");
#
#	Interprete the second parameter as a field name.  If there is no field
#       of that name, try it as a field number.
#
void
field(self, field_name)
    CodeBase::Record	*self

CodeBase.xs  view on Meta::CPAN

reindex(self)
    CodeBase::File	*self

 CODE:
    CB_TRACE(1, ("reindex(\"%s\")\n",  SELF));
    cb_errno = CB_SUCCESS;
    if (d4reindex(self->data4) != 0)
    {
	CB_TRACE(1, ("reindex returns error %d\n", cb_errno));
        XSRETURN_UNDEF;
    }
    CB_TRACE(1, ("reindex returns OK\n"));
    XSRETURN_YES;


##############################################################################
#
# $tagcount = $file->tagcount
#
#	Return number of tags associated with current index file.
#
int
tagcount(self)
    CodeBase::File	*self

 PREINIT:
    TAG4	*tag   = NULL;
    int		n_tags = 0;

 CODE:
    CB_TRACE(1, ("tagcount(\"%s\")\n", SELF));
    cb_errno = CB_SUCCESS;
    while ((tag = d4tagNext(self->data4, tag)) != NULL)
    {
	n_tags++;
    }
    CB_TRACE(1, ("tagcount returns %d\n", n_tags));
    RETVAL = n_tags;

 OUTPUT:
    RETVAL


# @taginfo = $file->taginfo
#
#	Return tags associated with current index file.
#
void
taginfo(self, index_name = NULL)
    CodeBase::File	*self
    char	*index_name

 PREINIT:
    INDEX4	*index;
    HV		*hash;
    SV		*ref;
    TAG4INFO	*tag4info;
    int		tag_no;
    char	*value;

 PPCODE:
#if S4VERSION < 6000
    if (index_name == NULL)
    {
	index_name = d4fileName(self->data4);
    }
#endif
    CB_TRACE(1, ("taginfo(\"%s\", \"%s\")\n", SELF, index_name));
    cb_errno = CB_SUCCESS;

    if (   ((index = d4index(self->data4, index_name)) == NULL)
	|| ((tag4info = i4tagInfo(index)) == NULL))
    {
	XSRETURN_UNDEF;
    }

    CB_TRACE(1, ("tags returns (\n"));
    for (tag_no = 0; tag4info->name; tag_no++, tag4info++)
    {
	hash = newHV();
	ref  = newRV((SV *)hash);
	PUSHs(ref);

	CB_TRACE(1, ("   { name => \"%s\", expression => \"%s\"",
		     tag4info->name, tag4info->expression));

	hv_store(hash, "name",        4, newSVpv((char *)tag4info->name, 0), 0);
	hv_store(hash, "expression", 10, newSVpv((char *)tag4info->expression, 0), 0);
	
	if (tag4info->filter && tag4info->filter[0])
	{
	    CB_TRACE(1, (", filter => \"%s\"", tag4info->filter));
	    hv_store(hash, "filter", 6, newSVpv((char *)tag4info->filter, 0), 0);
	}
	
	value = (tag4info->descending == r4descending) ? "DESCENDING" : "ASCENDING";
	CB_TRACE(1, (", order => \"%s\"", value));
	hv_store(hash, "order", 5, newSVpv(value, 0), 0);

	switch (tag4info->unique)
	{
	case e4unique:
	    value = "ERROR";
	    break;
	    
	case r4unique_continue:
	    value = "KEEP";
	    break;
	    
	case 0:
	    value = "DISCARD";
	    break;

        default:
   	    break;
	}
	
	CB_TRACE(1, (", duplicates => \"%s\" },\n", value));
	hv_store(hash, "duplicates", 10, newSVpv(value, 0), 0);

    }
    CB_TRACE(1, (")\n"));



#
# @tags = $file->tags
#
#	Return tags associated with current index file.
#
void
tags(self)
    CodeBase::File	*self

 PREINIT:
    TAG4	*tag   = NULL;
    int		n_tags = 0;

 PPCODE:
    CB_TRACE(1, ("tags(\"%s\")\n", SELF));
    CB_TRACE(1, ("tags returns ("));
    cb_errno = CB_SUCCESS;
    while ((tag = d4tagNext(self->data4, tag)) != NULL)
    {
	XPUSHs(sv_2mortal(newSVpv(t4alias(tag), 0)));
	CB_TRACE(1, ("%s%s", (n_tags++ ? ", " : ""), t4alias(tag)));
    }
    CB_TRACE(1, (")\n"));



# $rc = $file->set_tag([$tag]);
#	Set the current index tag.

void
set_tag(self, ...)
    CodeBase::File	*self
   
 PREINIT:
    TAG4	*tag;
    char 	*tag_name;

 CODE:
    cb_errno = CB_SUCCESS;
    if (items == 1)
    {
	CB_TRACE(1, ("set_tag(\"%s\")\n", SELF));
	d4tagSelect(self->data4, NULL);
	if (cb_errno)
	{
	    XSRETURN_UNDEF;
	}
    }
    else 
    {
	tag_name = SvPV(ST(1), na);
	CB_TRACE(1, ("set_tag(\"%s\", \"%s\")\n", SELF, tag_name));
	if (!(tag = d4tag(self->data4, tag_name)))
	{
	    XSRETURN_UNDEF;
	}
	d4tagSelect(self->data4, tag);
    }
    CB_TRACE(1, ("set_tag returns OK\n", SELF));
    XSRETURN_YES;


# $rec = $file->seek($key);
# 	Seek for a key match.
# 	Searches through the currently selected index for a match for the
#	supplied key.  If a match is found then the record number is returned,
#	otherwise the undefined values is returned and the error code can be
# 	retrieved with cb_errno.

int
seek(self, key)
    CodeBase::File	*self
    char	*key