aboutsummaryrefslogtreecommitdiffstats
path: root/test/monniaux/glpk-4.65/src/mpl/mpl6.c
diff options
context:
space:
mode:
Diffstat (limited to 'test/monniaux/glpk-4.65/src/mpl/mpl6.c')
-rw-r--r--test/monniaux/glpk-4.65/src/mpl/mpl6.c1039
1 files changed, 1039 insertions, 0 deletions
diff --git a/test/monniaux/glpk-4.65/src/mpl/mpl6.c b/test/monniaux/glpk-4.65/src/mpl/mpl6.c
new file mode 100644
index 00000000..ac2a0393
--- /dev/null
+++ b/test/monniaux/glpk-4.65/src/mpl/mpl6.c
@@ -0,0 +1,1039 @@
+/* mpl6.c */
+
+/***********************************************************************
+* This code is part of GLPK (GNU Linear Programming Kit).
+*
+* Copyright (C) 2003-2017 Andrew Makhorin, Department for Applied
+* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights
+* reserved. E-mail: <mao@gnu.org>.
+*
+* GLPK is free software: you can redistribute it and/or modify it
+* under the terms of the GNU General Public License as published by
+* the Free Software Foundation, either version 3 of the License, or
+* (at your option) any later version.
+*
+* GLPK is distributed in the hope that it will be useful, but WITHOUT
+* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+* License for more details.
+*
+* You should have received a copy of the GNU General Public License
+* along with GLPK. If not, see <http://www.gnu.org/licenses/>.
+***********************************************************************/
+
+#include "mpl.h"
+#include "mplsql.h"
+
+/**********************************************************************/
+
+#define CSV_FIELD_MAX 50
+/* maximal number of fields in record */
+
+#define CSV_FDLEN_MAX 100
+/* maximal field length */
+
+struct csv
+{ /* comma-separated values file */
+ int mode;
+ /* 'R' = reading; 'W' = writing */
+ char *fname;
+ /* name of csv file */
+ FILE *fp;
+ /* stream assigned to csv file */
+ jmp_buf jump;
+ /* address for non-local go to in case of error */
+ int count;
+ /* record count */
+ /*--------------------------------------------------------------*/
+ /* used only for input csv file */
+ int c;
+ /* current character or EOF */
+ int what;
+ /* current marker: */
+#define CSV_EOF 0 /* end-of-file */
+#define CSV_EOR 1 /* end-of-record */
+#define CSV_NUM 2 /* floating-point number */
+#define CSV_STR 3 /* character string */
+ char field[CSV_FDLEN_MAX+1];
+ /* current field just read */
+ int nf;
+ /* number of fields in the csv file */
+ int ref[1+CSV_FIELD_MAX];
+ /* ref[k] = k', if k-th field of the csv file corresponds to
+ k'-th field in the table statement; if ref[k] = 0, k-th field
+ of the csv file is ignored */
+#if 1 /* 01/VI-2010 */
+ int nskip;
+ /* number of comment records preceding the header record */
+#endif
+};
+
+#undef read_char
+
+static void read_char(struct csv *csv)
+{ /* read character from csv data file */
+ int c;
+ xassert(csv->c != EOF);
+ if (csv->c == '\n') csv->count++;
+loop: c = fgetc(csv->fp);
+ if (ferror(csv->fp))
+ { xprintf("%s:%d: read error - %s\n", csv->fname, csv->count,
+#if 0 /* 29/I-2017 */
+ strerror(errno));
+#else
+ xstrerr(errno));
+#endif
+ longjmp(csv->jump, 0);
+ }
+ if (feof(csv->fp))
+ { if (csv->c == '\n')
+ { csv->count--;
+ c = EOF;
+ }
+ else
+ { xprintf("%s:%d: warning: missing final end-of-line\n",
+ csv->fname, csv->count);
+ c = '\n';
+ }
+ }
+ else if (c == '\r')
+ goto loop;
+ else if (c == '\n')
+ ;
+ else if (iscntrl(c))
+ { xprintf("%s:%d: invalid control character 0x%02X\n",
+ csv->fname, csv->count, c);
+ longjmp(csv->jump, 0);
+ }
+ csv->c = c;
+ return;
+}
+
+static void read_field(struct csv *csv)
+{ /* read field from csv data file */
+ /* check for end of file */
+ if (csv->c == EOF)
+ { csv->what = CSV_EOF;
+ strcpy(csv->field, "EOF");
+ goto done;
+ }
+ /* check for end of record */
+ if (csv->c == '\n')
+ { csv->what = CSV_EOR;
+ strcpy(csv->field, "EOR");
+ read_char(csv);
+ if (csv->c == ',')
+err1: { xprintf("%s:%d: empty field not allowed\n", csv->fname,
+ csv->count);
+ longjmp(csv->jump, 0);
+ }
+ if (csv->c == '\n')
+ { xprintf("%s:%d: empty record not allowed\n", csv->fname,
+ csv->count);
+ longjmp(csv->jump, 0);
+ }
+#if 1 /* 01/VI-2010 */
+ /* skip comment records; may appear only before the very first
+ record containing field names */
+ if (csv->c == '#' && csv->count == 1)
+ { while (csv->c == '#')
+ { while (csv->c != '\n')
+ read_char(csv);
+ read_char(csv);
+ csv->nskip++;
+ }
+ }
+#endif
+ goto done;
+ }
+ /* skip comma before next field */
+ if (csv->c == ',')
+ read_char(csv);
+ /* read field */
+ if (csv->c == '\'' || csv->c == '"')
+ { /* read a field enclosed in quotes */
+ int quote = csv->c, len = 0;
+ csv->what = CSV_STR;
+ /* skip opening quote */
+ read_char(csv);
+ /* read field characters within quotes */
+ for (;;)
+ { /* check for closing quote and read it */
+ if (csv->c == quote)
+ { read_char(csv);
+ if (csv->c == quote)
+ ;
+ else if (csv->c == ',' || csv->c == '\n')
+ break;
+ else
+ { xprintf("%s:%d: invalid field\n", csv->fname,
+ csv->count);
+ longjmp(csv->jump, 0);
+ }
+ }
+ /* check the current field length */
+ if (len == CSV_FDLEN_MAX)
+err2: { xprintf("%s:%d: field too long\n", csv->fname,
+ csv->count);
+ longjmp(csv->jump, 0);
+ }
+ /* add the current character to the field */
+ csv->field[len++] = (char)csv->c;
+ /* read the next character */
+ read_char(csv);
+ }
+ /* the field has been read */
+ if (len == 0) goto err1;
+ csv->field[len] = '\0';
+ }
+ else
+ { /* read a field not enclosed in quotes */
+ int len = 0;
+ double temp;
+ csv->what = CSV_NUM;
+ while (!(csv->c == ',' || csv->c == '\n'))
+ { /* quotes within the field are not allowed */
+ if (csv->c == '\'' || csv->c == '"')
+ { xprintf("%s:%d: invalid use of single or double quote wi"
+ "thin field\n", csv->fname, csv->count);
+ longjmp(csv->jump, 0);
+ }
+ /* check the current field length */
+ if (len == CSV_FDLEN_MAX) goto err2;
+ /* add the current character to the field */
+ csv->field[len++] = (char)csv->c;
+ /* read the next character */
+ read_char(csv);
+ }
+ /* the field has been read */
+ if (len == 0) goto err1;
+ csv->field[len] = '\0';
+ /* check the field type */
+ if (str2num(csv->field, &temp)) csv->what = CSV_STR;
+ }
+done: return;
+}
+
+static struct csv *csv_open_file(TABDCA *dca, int mode)
+{ /* open csv data file */
+ struct csv *csv;
+ /* create control structure */
+ csv = xmalloc(sizeof(struct csv));
+ csv->mode = mode;
+ csv->fname = NULL;
+ csv->fp = NULL;
+ if (setjmp(csv->jump)) goto fail;
+ csv->count = 0;
+ csv->c = '\n';
+ csv->what = 0;
+ csv->field[0] = '\0';
+ csv->nf = 0;
+ /* try to open the csv data file */
+ if (mpl_tab_num_args(dca) < 2)
+ { xprintf("csv_driver: file name not specified\n");
+ longjmp(csv->jump, 0);
+ }
+ csv->fname = xmalloc(strlen(mpl_tab_get_arg(dca, 2))+1);
+ strcpy(csv->fname, mpl_tab_get_arg(dca, 2));
+ if (mode == 'R')
+ { /* open the file for reading */
+ int k;
+ csv->fp = fopen(csv->fname, "r");
+ if (csv->fp == NULL)
+ { xprintf("csv_driver: unable to open %s - %s\n",
+#if 0 /* 29/I-2017 */
+ csv->fname, strerror(errno));
+#else
+ csv->fname, xstrerr(errno));
+#endif
+ longjmp(csv->jump, 0);
+ }
+#if 1 /* 01/VI-2010 */
+ csv->nskip = 0;
+#endif
+ /* skip fake new-line */
+ read_field(csv);
+ xassert(csv->what == CSV_EOR);
+ /* read field names */
+ xassert(csv->nf == 0);
+ for (;;)
+ { read_field(csv);
+ if (csv->what == CSV_EOR)
+ break;
+ if (csv->what != CSV_STR)
+ { xprintf("%s:%d: invalid field name\n", csv->fname,
+ csv->count);
+ longjmp(csv->jump, 0);
+ }
+ if (csv->nf == CSV_FIELD_MAX)
+ { xprintf("%s:%d: too many fields\n", csv->fname,
+ csv->count);
+ longjmp(csv->jump, 0);
+ }
+ csv->nf++;
+ /* find corresponding field in the table statement */
+ for (k = mpl_tab_num_flds(dca); k >= 1; k--)
+ { if (strcmp(mpl_tab_get_name(dca, k), csv->field) == 0)
+ break;
+ }
+ csv->ref[csv->nf] = k;
+ }
+ /* find dummy RECNO field in the table statement */
+ for (k = mpl_tab_num_flds(dca); k >= 1; k--)
+ if (strcmp(mpl_tab_get_name(dca, k), "RECNO") == 0) break;
+ csv->ref[0] = k;
+ }
+ else if (mode == 'W')
+ { /* open the file for writing */
+ int k, nf;
+ csv->fp = fopen(csv->fname, "w");
+ if (csv->fp == NULL)
+ { xprintf("csv_driver: unable to create %s - %s\n",
+#if 0 /* 29/I-2017 */
+ csv->fname, strerror(errno));
+#else
+ csv->fname, xstrerr(errno));
+#endif
+ longjmp(csv->jump, 0);
+ }
+ /* write field names */
+ nf = mpl_tab_num_flds(dca);
+ for (k = 1; k <= nf; k++)
+ fprintf(csv->fp, "%s%c", mpl_tab_get_name(dca, k),
+ k < nf ? ',' : '\n');
+ csv->count++;
+ }
+ else
+ xassert(mode != mode);
+ /* the file has been open */
+ return csv;
+fail: /* the file cannot be open */
+ if (csv->fname != NULL) xfree(csv->fname);
+ if (csv->fp != NULL) fclose(csv->fp);
+ xfree(csv);
+ return NULL;
+}
+
+static int csv_read_record(TABDCA *dca, struct csv *csv)
+{ /* read next record from csv data file */
+ int k, ret = 0;
+ xassert(csv->mode == 'R');
+ if (setjmp(csv->jump))
+ { ret = 1;
+ goto done;
+ }
+ /* read dummy RECNO field */
+ if (csv->ref[0] > 0)
+#if 0 /* 01/VI-2010 */
+ mpl_tab_set_num(dca, csv->ref[0], csv->count-1);
+#else
+ mpl_tab_set_num(dca, csv->ref[0], csv->count-csv->nskip-1);
+#endif
+ /* read fields */
+ for (k = 1; k <= csv->nf; k++)
+ { read_field(csv);
+ if (csv->what == CSV_EOF)
+ { /* end-of-file reached */
+ xassert(k == 1);
+ ret = -1;
+ goto done;
+ }
+ else if (csv->what == CSV_EOR)
+ { /* end-of-record reached */
+ int lack = csv->nf - k + 1;
+ if (lack == 1)
+ xprintf("%s:%d: one field missing\n", csv->fname,
+ csv->count);
+ else
+ xprintf("%s:%d: %d fields missing\n", csv->fname,
+ csv->count, lack);
+ longjmp(csv->jump, 0);
+ }
+ else if (csv->what == CSV_NUM)
+ { /* floating-point number */
+ if (csv->ref[k] > 0)
+ { double num;
+ xassert(str2num(csv->field, &num) == 0);
+ mpl_tab_set_num(dca, csv->ref[k], num);
+ }
+ }
+ else if (csv->what == CSV_STR)
+ { /* character string */
+ if (csv->ref[k] > 0)
+ mpl_tab_set_str(dca, csv->ref[k], csv->field);
+ }
+ else
+ xassert(csv != csv);
+ }
+ /* now there must be NL */
+ read_field(csv);
+ xassert(csv->what != CSV_EOF);
+ if (csv->what != CSV_EOR)
+ { xprintf("%s:%d: too many fields\n", csv->fname, csv->count);
+ longjmp(csv->jump, 0);
+ }
+done: return ret;
+}
+
+static int csv_write_record(TABDCA *dca, struct csv *csv)
+{ /* write next record to csv data file */
+ int k, nf, ret = 0;
+ const char *c;
+ xassert(csv->mode == 'W');
+ nf = mpl_tab_num_flds(dca);
+ for (k = 1; k <= nf; k++)
+ { switch (mpl_tab_get_type(dca, k))
+ { case 'N':
+ fprintf(csv->fp, "%.*g", DBL_DIG,
+ mpl_tab_get_num(dca, k));
+ break;
+ case 'S':
+ fputc('"', csv->fp);
+ for (c = mpl_tab_get_str(dca, k); *c != '\0'; c++)
+ { if (*c == '"')
+ fputc('"', csv->fp), fputc('"', csv->fp);
+ else
+ fputc(*c, csv->fp);
+ }
+ fputc('"', csv->fp);
+ break;
+ default:
+ xassert(dca != dca);
+ }
+ fputc(k < nf ? ',' : '\n', csv->fp);
+ }
+ csv->count++;
+ if (ferror(csv->fp))
+ { xprintf("%s:%d: write error - %s\n", csv->fname, csv->count,
+#if 0 /* 29/I-2017 */
+ strerror(errno));
+#else
+ xstrerr(errno));
+#endif
+ ret = 1;
+ }
+ return ret;
+}
+
+static int csv_close_file(TABDCA *dca, struct csv *csv)
+{ /* close csv data file */
+ int ret = 0;
+ xassert(dca == dca);
+ if (csv->mode == 'W')
+ { fflush(csv->fp);
+ if (ferror(csv->fp))
+ { xprintf("%s:%d: write error - %s\n", csv->fname,
+#if 0 /* 29/I-2017 */
+ csv->count, strerror(errno));
+#else
+ csv->count, xstrerr(errno));
+#endif
+ ret = 1;
+ }
+ }
+ xfree(csv->fname);
+ fclose(csv->fp);
+ xfree(csv);
+ return ret;
+}
+
+/**********************************************************************/
+
+#define DBF_FIELD_MAX 50
+/* maximal number of fields in record */
+
+#define DBF_FDLEN_MAX 100
+/* maximal field length */
+
+struct dbf
+{ /* xBASE data file */
+ int mode;
+ /* 'R' = reading; 'W' = writing */
+ char *fname;
+ /* name of xBASE file */
+ FILE *fp;
+ /* stream assigned to xBASE file */
+ jmp_buf jump;
+ /* address for non-local go to in case of error */
+ int offset;
+ /* offset of a byte to be read next */
+ int count;
+ /* record count */
+ int nf;
+ /* number of fields */
+ int ref[1+DBF_FIELD_MAX];
+ /* ref[k] = k', if k-th field of the csv file corresponds to
+ k'-th field in the table statement; if ref[k] = 0, k-th field
+ of the csv file is ignored */
+ int type[1+DBF_FIELD_MAX];
+ /* type[k] is type of k-th field */
+ int len[1+DBF_FIELD_MAX];
+ /* len[k] is length of k-th field */
+ int prec[1+DBF_FIELD_MAX];
+ /* prec[k] is precision of k-th field */
+};
+
+static int read_byte(struct dbf *dbf)
+{ /* read byte from xBASE data file */
+ int b;
+ b = fgetc(dbf->fp);
+ if (ferror(dbf->fp))
+ { xprintf("%s:0x%X: read error - %s\n", dbf->fname,
+#if 0 /* 29/I-2017 */
+ dbf->offset, strerror(errno));
+#else
+ dbf->offset, xstrerr(errno));
+#endif
+ longjmp(dbf->jump, 0);
+ }
+ if (feof(dbf->fp))
+ { xprintf("%s:0x%X: unexpected end of file\n", dbf->fname,
+ dbf->offset);
+ longjmp(dbf->jump, 0);
+ }
+ xassert(0x00 <= b && b <= 0xFF);
+ dbf->offset++;
+ return b;
+}
+
+static void read_header(TABDCA *dca, struct dbf *dbf)
+{ /* read xBASE data file header */
+ int b, j, k, recl;
+ char name[10+1];
+ /* (ignored) */
+ for (j = 1; j <= 10; j++)
+ read_byte(dbf);
+ /* length of each record, in bytes */
+ recl = read_byte(dbf);
+ recl += read_byte(dbf) << 8;
+ /* (ignored) */
+ for (j = 1; j <= 20; j++)
+ read_byte(dbf);
+ /* field descriptor array */
+ xassert(dbf->nf == 0);
+ for (;;)
+ { /* check for end of array */
+ b = read_byte(dbf);
+ if (b == 0x0D) break;
+ if (dbf->nf == DBF_FIELD_MAX)
+ { xprintf("%s:0x%X: too many fields\n", dbf->fname,
+ dbf->offset);
+ longjmp(dbf->jump, 0);
+ }
+ dbf->nf++;
+ /* field name */
+ name[0] = (char)b;
+ for (j = 1; j < 10; j++)
+ { b = read_byte(dbf);
+ name[j] = (char)b;
+ }
+ name[10] = '\0';
+ b = read_byte(dbf);
+ if (b != 0x00)
+ { xprintf("%s:0x%X: invalid field name\n", dbf->fname,
+ dbf->offset);
+ longjmp(dbf->jump, 0);
+ }
+ /* find corresponding field in the table statement */
+ for (k = mpl_tab_num_flds(dca); k >= 1; k--)
+ if (strcmp(mpl_tab_get_name(dca, k), name) == 0) break;
+ dbf->ref[dbf->nf] = k;
+ /* field type */
+ b = read_byte(dbf);
+ if (!(b == 'C' || b == 'N'))
+ { xprintf("%s:0x%X: invalid field type\n", dbf->fname,
+ dbf->offset);
+ longjmp(dbf->jump, 0);
+ }
+ dbf->type[dbf->nf] = b;
+ /* (ignored) */
+ for (j = 1; j <= 4; j++)
+ read_byte(dbf);
+ /* field length */
+ b = read_byte(dbf);
+ if (b == 0)
+ { xprintf("%s:0x%X: invalid field length\n", dbf->fname,
+ dbf->offset);
+ longjmp(dbf->jump, 0);
+ }
+ if (b > DBF_FDLEN_MAX)
+ { xprintf("%s:0x%X: field too long\n", dbf->fname,
+ dbf->offset);
+ longjmp(dbf->jump, 0);
+ }
+ dbf->len[dbf->nf] = b;
+ recl -= b;
+ /* (ignored) */
+ for (j = 1; j <= 15; j++)
+ read_byte(dbf);
+ }
+ if (recl != 1)
+ { xprintf("%s:0x%X: invalid file header\n", dbf->fname,
+ dbf->offset);
+ longjmp(dbf->jump, 0);
+ }
+ /* find dummy RECNO field in the table statement */
+ for (k = mpl_tab_num_flds(dca); k >= 1; k--)
+ if (strcmp(mpl_tab_get_name(dca, k), "RECNO") == 0) break;
+ dbf->ref[0] = k;
+ return;
+}
+
+static void parse_third_arg(TABDCA *dca, struct dbf *dbf)
+{ /* parse xBASE file format (third argument) */
+ int j, k, temp;
+ const char *arg;
+ dbf->nf = mpl_tab_num_flds(dca);
+ arg = mpl_tab_get_arg(dca, 3), j = 0;
+ for (k = 1; k <= dbf->nf; k++)
+ { /* parse specification of k-th field */
+ if (arg[j] == '\0')
+ { xprintf("xBASE driver: field %s: specification missing\n",
+ mpl_tab_get_name(dca, k));
+ longjmp(dbf->jump, 0);
+ }
+ /* parse field type */
+ if (arg[j] == 'C' || arg[j] == 'N')
+ dbf->type[k] = arg[j], j++;
+ else
+ { xprintf("xBASE driver: field %s: invalid field type\n",
+ mpl_tab_get_name(dca, k));
+ longjmp(dbf->jump, 0);
+ }
+ /* check for left parenthesis */
+ if (arg[j] == '(')
+ j++;
+ else
+err: { xprintf("xBASE driver: field %s: invalid field format\n",
+ mpl_tab_get_name(dca, k));
+ longjmp(dbf->jump, 0);
+ }
+ /* parse field length */
+ temp = 0;
+ while (isdigit(arg[j]))
+ { if (temp > DBF_FDLEN_MAX) break;
+ temp = 10 * temp + (arg[j] - '0'), j++;
+ }
+ if (!(1 <= temp && temp <= DBF_FDLEN_MAX))
+ { xprintf("xBASE driver: field %s: invalid field length\n",
+ mpl_tab_get_name(dca, k));
+ longjmp(dbf->jump, 0);
+ }
+ dbf->len[k] = temp;
+ /* parse optional field precision */
+ if (dbf->type[k] == 'N' && arg[j] == ',')
+ { j++;
+ temp = 0;
+ while (isdigit(arg[j]))
+ { if (temp > dbf->len[k]) break;
+ temp = 10 * temp + (arg[j] - '0'), j++;
+ }
+ if (temp > dbf->len[k])
+ { xprintf("xBASE driver: field %s: invalid field precision"
+ "\n", mpl_tab_get_name(dca, k));
+ longjmp(dbf->jump, 0);
+ }
+ dbf->prec[k] = temp;
+ }
+ else
+ dbf->prec[k] = 0;
+ /* check for right parenthesis */
+ if (arg[j] == ')')
+ j++;
+ else
+ goto err;
+ }
+ /* ignore other specifications */
+ return;
+}
+
+static void write_byte(struct dbf *dbf, int b)
+{ /* write byte to xBASE data file */
+ fputc(b, dbf->fp);
+ dbf->offset++;
+ return;
+}
+
+static void write_header(TABDCA *dca, struct dbf *dbf)
+{ /* write xBASE data file header */
+ int j, k, temp;
+ const char *name;
+ /* version number */
+ write_byte(dbf, 0x03 /* file without DBT */);
+ /* date of last update (YYMMDD) */
+ write_byte(dbf, 70 /* 1970 */);
+ write_byte(dbf, 1 /* January */);
+ write_byte(dbf, 1 /* 1st */);
+ /* number of records (unknown so far) */
+ for (j = 1; j <= 4; j++)
+ write_byte(dbf, 0xFF);
+ /* length of the header, in bytes */
+ temp = 32 + dbf->nf * 32 + 1;
+ write_byte(dbf, temp);
+ write_byte(dbf, temp >> 8);
+ /* length of each record, in bytes */
+ temp = 1;
+ for (k = 1; k <= dbf->nf; k++)
+ temp += dbf->len[k];
+ write_byte(dbf, temp);
+ write_byte(dbf, temp >> 8);
+ /* (reserved) */
+ for (j = 1; j <= 20; j++)
+ write_byte(dbf, 0x00);
+ /* field descriptor array */
+ for (k = 1; k <= dbf->nf; k++)
+ { /* field name (terminated by 0x00) */
+ name = mpl_tab_get_name(dca, k);
+ for (j = 0; j < 10 && name[j] != '\0'; j++)
+ write_byte(dbf, name[j]);
+ for (j = j; j < 11; j++)
+ write_byte(dbf, 0x00);
+ /* field type */
+ write_byte(dbf, dbf->type[k]);
+ /* (reserved) */
+ for (j = 1; j <= 4; j++)
+ write_byte(dbf, 0x00);
+ /* field length */
+ write_byte(dbf, dbf->len[k]);
+ /* field precision */
+ write_byte(dbf, dbf->prec[k]);
+ /* (reserved) */
+ for (j = 1; j <= 14; j++)
+ write_byte(dbf, 0x00);
+ }
+ /* end of header */
+ write_byte(dbf, 0x0D);
+ return;
+}
+
+static struct dbf *dbf_open_file(TABDCA *dca, int mode)
+{ /* open xBASE data file */
+ struct dbf *dbf;
+ /* create control structure */
+ dbf = xmalloc(sizeof(struct dbf));
+ dbf->mode = mode;
+ dbf->fname = NULL;
+ dbf->fp = NULL;
+ if (setjmp(dbf->jump)) goto fail;
+ dbf->offset = 0;
+ dbf->count = 0;
+ dbf->nf = 0;
+ /* try to open the xBASE data file */
+ if (mpl_tab_num_args(dca) < 2)
+ { xprintf("xBASE driver: file name not specified\n");
+ longjmp(dbf->jump, 0);
+ }
+ dbf->fname = xmalloc(strlen(mpl_tab_get_arg(dca, 2))+1);
+ strcpy(dbf->fname, mpl_tab_get_arg(dca, 2));
+ if (mode == 'R')
+ { /* open the file for reading */
+ dbf->fp = fopen(dbf->fname, "rb");
+ if (dbf->fp == NULL)
+ { xprintf("xBASE driver: unable to open %s - %s\n",
+#if 0 /* 29/I-2017 */
+ dbf->fname, strerror(errno));
+#else
+ dbf->fname, xstrerr(errno));
+#endif
+ longjmp(dbf->jump, 0);
+ }
+ read_header(dca, dbf);
+ }
+ else if (mode == 'W')
+ { /* open the file for writing */
+ if (mpl_tab_num_args(dca) < 3)
+ { xprintf("xBASE driver: file format not specified\n");
+ longjmp(dbf->jump, 0);
+ }
+ parse_third_arg(dca, dbf);
+ dbf->fp = fopen(dbf->fname, "wb");
+ if (dbf->fp == NULL)
+ { xprintf("xBASE driver: unable to create %s - %s\n",
+#if 0 /* 29/I-2017 */
+ dbf->fname, strerror(errno));
+#else
+ dbf->fname, xstrerr(errno));
+#endif
+ longjmp(dbf->jump, 0);
+ }
+ write_header(dca, dbf);
+ }
+ else
+ xassert(mode != mode);
+ /* the file has been open */
+ return dbf;
+fail: /* the file cannot be open */
+ if (dbf->fname != NULL) xfree(dbf->fname);
+ if (dbf->fp != NULL) fclose(dbf->fp);
+ xfree(dbf);
+ return NULL;
+}
+
+static int dbf_read_record(TABDCA *dca, struct dbf *dbf)
+{ /* read next record from xBASE data file */
+ int b, j, k, ret = 0;
+ char buf[DBF_FDLEN_MAX+1];
+ xassert(dbf->mode == 'R');
+ if (setjmp(dbf->jump))
+ { ret = 1;
+ goto done;
+ }
+ /* check record flag */
+ b = read_byte(dbf);
+ if (b == 0x1A)
+ { /* end of data */
+ ret = -1;
+ goto done;
+ }
+ if (b != 0x20)
+ { xprintf("%s:0x%X: invalid record flag\n", dbf->fname,
+ dbf->offset);
+ longjmp(dbf->jump, 0);
+ }
+ /* read dummy RECNO field */
+ if (dbf->ref[0] > 0)
+ mpl_tab_set_num(dca, dbf->ref[0], dbf->count+1);
+ /* read fields */
+ for (k = 1; k <= dbf->nf; k++)
+ { /* read k-th field */
+ for (j = 0; j < dbf->len[k]; j++)
+ buf[j] = (char)read_byte(dbf);
+ buf[dbf->len[k]] = '\0';
+ /* set field value */
+ if (dbf->type[k] == 'C')
+ { /* character field */
+ if (dbf->ref[k] > 0)
+ mpl_tab_set_str(dca, dbf->ref[k], strtrim(buf));
+ }
+ else if (dbf->type[k] == 'N')
+ { /* numeric field */
+ if (dbf->ref[k] > 0)
+ { double num;
+ strspx(buf);
+ xassert(str2num(buf, &num) == 0);
+ mpl_tab_set_num(dca, dbf->ref[k], num);
+ }
+ }
+ else
+ xassert(dbf != dbf);
+ }
+ /* increase record count */
+ dbf->count++;
+done: return ret;
+}
+
+static int dbf_write_record(TABDCA *dca, struct dbf *dbf)
+{ /* write next record to xBASE data file */
+ int j, k, ret = 0;
+ char buf[255+1];
+ xassert(dbf->mode == 'W');
+ if (setjmp(dbf->jump))
+ { ret = 1;
+ goto done;
+ }
+ /* record flag */
+ write_byte(dbf, 0x20);
+ xassert(dbf->nf == mpl_tab_num_flds(dca));
+ for (k = 1; k <= dbf->nf; k++)
+ { if (dbf->type[k] == 'C')
+ { /* character field */
+ const char *str;
+ if (mpl_tab_get_type(dca, k) == 'N')
+ { sprintf(buf, "%.*g", DBL_DIG, mpl_tab_get_num(dca, k));
+ str = buf;
+ }
+ else if (mpl_tab_get_type(dca, k) == 'S')
+ str = mpl_tab_get_str(dca, k);
+ else
+ xassert(dca != dca);
+ if ((int)strlen(str) > dbf->len[k])
+ { xprintf("xBASE driver: field %s: cannot convert %.15s..."
+ " to field format\n", mpl_tab_get_name(dca, k), str);
+ longjmp(dbf->jump, 0);
+ }
+ for (j = 0; j < dbf->len[k] && str[j] != '\0'; j++)
+ write_byte(dbf, str[j]);
+ for (j = j; j < dbf->len[k]; j++)
+ write_byte(dbf, ' ');
+ }
+ else if (dbf->type[k] == 'N')
+ { /* numeric field */
+ double num = mpl_tab_get_num(dca, k);
+ if (fabs(num) > 1e20)
+err: { xprintf("xBASE driver: field %s: cannot convert %g to fi"
+ "eld format\n", mpl_tab_get_name(dca, k), num);
+ longjmp(dbf->jump, 0);
+ }
+ sprintf(buf, "%*.*f", dbf->len[k], dbf->prec[k], num);
+ xassert(strlen(buf) < sizeof(buf));
+ if ((int)strlen(buf) != dbf->len[k]) goto err;
+ for (j = 0; j < dbf->len[k]; j++)
+ write_byte(dbf, buf[j]);
+ }
+ else
+ xassert(dbf != dbf);
+ }
+ /* increase record count */
+ dbf->count++;
+done: return ret;
+}
+
+static int dbf_close_file(TABDCA *dca, struct dbf *dbf)
+{ /* close xBASE data file */
+ int ret = 0;
+ xassert(dca == dca);
+ if (dbf->mode == 'W')
+ { if (setjmp(dbf->jump))
+ { ret = 1;
+ goto skip;
+ }
+ /* end-of-file flag */
+ write_byte(dbf, 0x1A);
+ /* number of records */
+ dbf->offset = 4;
+ if (fseek(dbf->fp, dbf->offset, SEEK_SET))
+ { xprintf("%s:0x%X: seek error - %s\n", dbf->fname,
+#if 0 /* 29/I-2017 */
+ dbf->offset, strerror(errno));
+#else
+ dbf->offset, xstrerr(errno));
+#endif
+ longjmp(dbf->jump, 0);
+ }
+ write_byte(dbf, dbf->count);
+ write_byte(dbf, dbf->count >> 8);
+ write_byte(dbf, dbf->count >> 16);
+ write_byte(dbf, dbf->count >> 24);
+ fflush(dbf->fp);
+ if (ferror(dbf->fp))
+ { xprintf("%s:0x%X: write error - %s\n", dbf->fname,
+#if 0 /* 29/I-2017 */
+ dbf->offset, strerror(errno));
+#else
+ dbf->offset, xstrerr(errno));
+#endif
+ longjmp(dbf->jump, 0);
+ }
+skip: ;
+ }
+ xfree(dbf->fname);
+ fclose(dbf->fp);
+ xfree(dbf);
+ return ret;
+}
+
+/**********************************************************************/
+
+#define TAB_CSV 1
+#define TAB_XBASE 2
+#define TAB_ODBC 3
+#define TAB_MYSQL 4
+
+void mpl_tab_drv_open(MPL *mpl, int mode)
+{ TABDCA *dca = mpl->dca;
+ xassert(dca->id == 0);
+ xassert(dca->link == NULL);
+ xassert(dca->na >= 1);
+ if (strcmp(dca->arg[1], "CSV") == 0)
+ { dca->id = TAB_CSV;
+ dca->link = csv_open_file(dca, mode);
+ }
+ else if (strcmp(dca->arg[1], "xBASE") == 0)
+ { dca->id = TAB_XBASE;
+ dca->link = dbf_open_file(dca, mode);
+ }
+ else if (strcmp(dca->arg[1], "ODBC") == 0 ||
+ strcmp(dca->arg[1], "iODBC") == 0)
+ { dca->id = TAB_ODBC;
+ dca->link = db_iodbc_open(dca, mode);
+ }
+ else if (strcmp(dca->arg[1], "MySQL") == 0)
+ { dca->id = TAB_MYSQL;
+ dca->link = db_mysql_open(dca, mode);
+ }
+ else
+ xprintf("Invalid table driver '%s'\n", dca->arg[1]);
+ if (dca->link == NULL)
+ error(mpl, "error on opening table %s",
+ mpl->stmt->u.tab->name);
+ return;
+}
+
+int mpl_tab_drv_read(MPL *mpl)
+{ TABDCA *dca = mpl->dca;
+ int ret;
+ switch (dca->id)
+ { case TAB_CSV:
+ ret = csv_read_record(dca, dca->link);
+ break;
+ case TAB_XBASE:
+ ret = dbf_read_record(dca, dca->link);
+ break;
+ case TAB_ODBC:
+ ret = db_iodbc_read(dca, dca->link);
+ break;
+ case TAB_MYSQL:
+ ret = db_mysql_read(dca, dca->link);
+ break;
+ default:
+ xassert(dca != dca);
+ }
+ if (ret > 0)
+ error(mpl, "error on reading data from table %s",
+ mpl->stmt->u.tab->name);
+ return ret;
+}
+
+void mpl_tab_drv_write(MPL *mpl)
+{ TABDCA *dca = mpl->dca;
+ int ret;
+ switch (dca->id)
+ { case TAB_CSV:
+ ret = csv_write_record(dca, dca->link);
+ break;
+ case TAB_XBASE:
+ ret = dbf_write_record(dca, dca->link);
+ break;
+ case TAB_ODBC:
+ ret = db_iodbc_write(dca, dca->link);
+ break;
+ case TAB_MYSQL:
+ ret = db_mysql_write(dca, dca->link);
+ break;
+ default:
+ xassert(dca != dca);
+ }
+ if (ret)
+ error(mpl, "error on writing data to table %s",
+ mpl->stmt->u.tab->name);
+ return;
+}
+
+void mpl_tab_drv_close(MPL *mpl)
+{ TABDCA *dca = mpl->dca;
+ int ret;
+ switch (dca->id)
+ { case TAB_CSV:
+ ret = csv_close_file(dca, dca->link);
+ break;
+ case TAB_XBASE:
+ ret = dbf_close_file(dca, dca->link);
+ break;
+ case TAB_ODBC:
+ ret = db_iodbc_close(dca, dca->link);
+ break;
+ case TAB_MYSQL:
+ ret = db_mysql_close(dca, dca->link);
+ break;
+ default:
+ xassert(dca != dca);
+ }
+ dca->id = 0;
+ dca->link = NULL;
+ if (ret)
+ error(mpl, "error on closing table %s",
+ mpl->stmt->u.tab->name);
+ return;
+}
+
+/* eof */