aa3a4e4929bc0324685442c5f9408d6357471cd8
[pspp-builds.git] / src / get.c
1 /* PSPP - computes sample statistics.
2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3    Written by Ben Pfaff <blp@gnu.org>.
4
5    This program is free software; you can redistribute it and/or
6    modify it under the terms of the GNU General Public License as
7    published by the Free Software Foundation; either version 2 of the
8    License, or (at your option) any later version.
9
10    This program is distributed in the hope that it will be useful, but
11    WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    General Public License for more details.
14
15    You should have received a copy of the GNU General Public License
16    along with this program; if not, write to the Free Software
17    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
18    02111-1307, USA. */
19
20 #include <config.h>
21 #include "error.h"
22 #include <stdlib.h>
23 #include "alloc.h"
24 #include "command.h"
25 #include "error.h"
26 #include "file-handle.h"
27 #include "hash.h"
28 #include "lexer.h"
29 #include "misc.h"
30 #include "pfm.h"
31 #include "settings.h"
32 #include "sfm.h"
33 #include "str.h"
34 #include "value-labels.h"
35 #include "var.h"
36 #include "vfm.h"
37 #include "vfmP.h"
38
39 #include "debug-print.h"
40
41 /* GET or IMPORT input program. */
42 struct get_pgm 
43   {
44     struct file_handle *handle; /* File to GET or IMPORT from. */
45     size_t case_size;           /* Case size in bytes. */
46   };
47
48 /* XSAVE transformation (and related SAVE, EXPORT procedures). */
49 struct save_trns
50   {
51     struct trns_header h;
52     struct file_handle *f;      /* Associated system file. */
53     int nvar;                   /* Number of variables. */
54     struct variable **var;      /* Variables. */
55     flt64 *case_buf;            /* Case transfer buffer. */
56   };
57
58 /* Options bits set by trim_dictionary(). */
59 #define GTSV_OPT_COMPRESSED     001     /* Compression; (X)SAVE only. */
60 #define GTSV_OPT_SAVE           002     /* The SAVE/XSAVE/EXPORT procedures. */
61 #define GTSV_OPT_MATCH_FILES    004     /* The MATCH FILES procedure. */
62 #define GTSV_OPT_NONE           0
63
64 static int trim_dictionary (struct dictionary * dict, int *options);
65 static int save_write_case_func (struct ccase *, void *);
66 static trns_proc_func save_trns_proc;
67 static trns_free_func save_trns_free;
68
69 #if DEBUGGING
70 void dump_dict_variables (struct dictionary *);
71 #endif
72
73 /* Parses the GET command. */
74 int
75 cmd_get (void)
76 {
77   struct file_handle *handle;
78   struct dictionary *dict;
79   struct get_pgm *pgm;
80   int options = GTSV_OPT_NONE;
81
82   discard_variables ();
83
84   lex_match ('/');
85   if (lex_match_id ("FILE"))
86     lex_match ('=');
87
88   handle = fh_parse_file_handle ();
89   if (handle == NULL)
90     return CMD_FAILURE;
91
92   dict = sfm_read_dictionary (handle, NULL);
93   if (dict == NULL)
94     return CMD_FAILURE;
95
96 #if DEBUGGING
97   dump_dict_variables (dict);
98 #endif
99   if (0 == trim_dictionary (dict, &options))
100     {
101       fh_close_handle (handle);
102       return CMD_FAILURE;
103     }
104 #if DEBUGGING
105   dump_dict_variables (dict);
106 #endif
107
108   dict_compact_values (dict);
109
110 #if DEBUGGING
111   printf (_("GET translation table from file to memory:\n"));
112   for (i = 0; i < dict->nvar; i++)
113     {
114       struct variable *v = dict->var[i];
115
116       printf (_("  %8s from %3d,%3d to %3d,%3d\n"), v->name,
117               v->get.fv, v->get.nv, v->fv, v->nv);
118     }
119 #endif
120
121   dict_destroy (default_dict);
122   default_dict = dict;
123
124   pgm = xmalloc (sizeof *pgm);
125   pgm->handle = handle;
126   pgm->case_size = dict_get_case_size (default_dict);
127   vfm_source = create_case_source (&get_source_class, default_dict, pgm);
128
129   return CMD_SUCCESS;
130 }
131
132 /* SAVE or XSAVE command? */
133 enum save_cmd 
134   {
135     CMD_SAVE,
136     CMD_XSAVE
137   };
138
139 /* Parses the SAVE and XSAVE commands.  */
140 static int
141 cmd_save_internal (enum save_cmd save_cmd)
142 {
143   struct file_handle *handle;
144   struct dictionary *dict;
145   int options = GTSV_OPT_SAVE;
146
147   struct save_trns *t;
148   struct sfm_write_info inf;
149
150   int i;
151
152   lex_match ('/');
153   if (lex_match_id ("OUTFILE"))
154     lex_match ('=');
155
156   handle = fh_parse_file_handle ();
157   if (handle == NULL)
158     return CMD_FAILURE;
159
160   dict = dict_clone (default_dict);
161 #if DEBUGGING
162   dump_dict_variables (dict);
163 #endif
164   for (i = 0; i < dict_get_var_cnt (dict); i++) 
165     dict_get_var (dict, i)->aux = dict_get_var (default_dict, i);
166   if (0 == trim_dictionary (dict, &options))
167     {
168       fh_close_handle (handle);
169       return CMD_FAILURE;
170     }
171
172 #if DEBUGGING
173   dump_dict_variables (dict);
174 #endif
175
176   /* Write dictionary. */
177   inf.h = handle;
178   inf.dict = dict;
179   inf.compress = !!(options & GTSV_OPT_COMPRESSED);
180   if (!sfm_write_dictionary (&inf))
181     {
182       dict_destroy (dict);
183       fh_close_handle (handle);
184       return CMD_FAILURE;
185     }
186
187   /* Fill in transformation structure. */
188   t = xmalloc (sizeof *t);
189   t->h.proc = save_trns_proc;
190   t->h.free = save_trns_free;
191   t->f = handle;
192   t->nvar = dict_get_var_cnt (dict);
193   t->var = xmalloc (sizeof *t->var * t->nvar);
194   for (i = 0; i < t->nvar; i++)
195     t->var[i] = dict_get_var (dict, i)->aux;
196   t->case_buf = xmalloc (sizeof *t->case_buf * inf.case_size);
197   dict_destroy (dict);
198
199   if (save_cmd == CMD_SAVE)
200     {
201       procedure (save_write_case_func, t);
202       save_trns_free (&t->h);
203     }
204   else 
205     {
206       assert (save_cmd == CMD_XSAVE);
207       add_transformation (&t->h); 
208     }
209
210   return CMD_SUCCESS;
211 }
212
213 /* Parses and performs the SAVE procedure. */
214 int
215 cmd_save (void)
216 {
217   return cmd_save_internal (CMD_SAVE);
218 }
219
220 /* Parses the XSAVE transformation command. */
221 int
222 cmd_xsave (void)
223 {
224   return cmd_save_internal (CMD_XSAVE);
225 }
226
227 /* Writes the given C to the file specified by T. */
228 static void
229 do_write_case (struct save_trns *t, struct ccase *c) 
230 {
231   flt64 *p = t->case_buf;
232   int i;
233
234   for (i = 0; i < t->nvar; i++)
235     {
236       struct variable *v = t->var[i];
237       if (v->type == NUMERIC)
238         {
239           double src = c->data[v->fv].f;
240           if (src == SYSMIS)
241             *p++ = -FLT64_MAX;
242           else
243             *p++ = src;
244         }
245       else
246         {
247           memcpy (p, c->data[v->fv].s, v->width);
248           memset (&((char *) p)[v->width], ' ',
249                   REM_RND_UP (v->width, sizeof *p));
250           p += DIV_RND_UP (v->width, sizeof *p);
251         }
252     }
253
254   sfm_write_case (t->f, t->case_buf, p - t->case_buf);
255 }
256
257 /* Writes case C to the system file specified on SAVE. */
258 static int
259 save_write_case_func (struct ccase *c, void *aux UNUSED)
260 {
261   do_write_case (aux, c);
262   return 1;
263 }
264
265 /* Writes case C to the system file specified on XSAVE. */
266 static int
267 save_trns_proc (struct trns_header *h, struct ccase *c, int case_num UNUSED)
268 {
269   struct save_trns *t = (struct save_trns *) h;
270   do_write_case (t, c);
271   return -1;
272 }
273
274 /* Frees a SAVE transformation. */
275 static void
276 save_trns_free (struct trns_header *pt)
277 {
278   struct save_trns *t = (struct save_trns *) pt;
279
280   fh_close_handle (t->f);
281   free (t->var);
282   free (t->case_buf);
283   free (t);
284 }
285
286 static int rename_variables (struct dictionary * dict);
287
288 /* The GET and SAVE commands have a common structure after the
289    FILE/OUTFILE subcommand.  This function parses this structure and
290    returns nonzero on success, zero on failure.  It both reads
291    *OPTIONS, for the GTSV_OPT_SAVE bit, and writes it, for the
292    GTSV_OPT_COMPRESSED bit. */
293 /* FIXME: IN, FIRST, LAST, MAP. */
294 /* FIXME?  Should we call dict_compact_values() on dict as a
295    final step? */
296 static int
297 trim_dictionary (struct dictionary *dict, int *options)
298 {
299   if (get_scompression())
300     *options |= GTSV_OPT_COMPRESSED;
301
302   if (*options & GTSV_OPT_SAVE)
303     {
304       /* Delete all the scratch variables. */
305       struct variable **v;
306       size_t nv;
307       size_t i;
308
309       v = xmalloc (sizeof *v * dict_get_var_cnt (dict));
310       nv = 0;
311       for (i = 0; i < dict_get_var_cnt (dict); i++) 
312         if (dict_class_from_id (dict_get_var (dict, i)->name) == DC_SCRATCH)
313           v[nv++] = dict_get_var (dict, i);
314       dict_delete_vars (dict, v, nv);
315       free (v);
316     }
317   
318   while ((*options & GTSV_OPT_MATCH_FILES) || lex_match ('/'))
319     {
320       if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("COMPRESSED"))
321         *options |= GTSV_OPT_COMPRESSED;
322       else if (!(*options & GTSV_OPT_MATCH_FILES) && lex_match_id ("UNCOMPRESSED"))
323         *options &= ~GTSV_OPT_COMPRESSED;
324       else if (lex_match_id ("DROP"))
325         {
326           struct variable **v;
327           int nv;
328
329           lex_match ('=');
330           if (!parse_variables (dict, &v, &nv, PV_NONE))
331             return 0;
332           dict_delete_vars (dict, v, nv);
333           free (v);
334         }
335       else if (lex_match_id ("KEEP"))
336         {
337           struct variable **v;
338           int nv;
339           int i;
340
341           lex_match ('=');
342           if (!parse_variables (dict, &v, &nv, PV_NONE))
343             return 0;
344
345           /* Move the specified variables to the beginning. */
346           dict_reorder_vars (dict, v, nv);
347           
348           /* Delete the remaining variables. */
349           v = xrealloc (v, (dict_get_var_cnt (dict) - nv) * sizeof *v);
350           for (i = nv; i < dict_get_var_cnt (dict); i++)
351             v[i - nv] = dict_get_var (dict, i);
352           dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
353           free (v);
354         }
355       else if (lex_match_id ("RENAME"))
356         {
357           if (!rename_variables (dict))
358             return 0;
359         }
360       else
361         {
362           lex_error (_("while expecting a valid subcommand"));
363           return 0;
364         }
365
366       if (dict_get_var_cnt (dict) == 0)
367         {
368           msg (SE, _("All variables deleted from system file dictionary."));
369           return 0;
370         }
371
372       if (*options & GTSV_OPT_MATCH_FILES)
373         return 1;
374     }
375
376   if (token != '.')
377     {
378       lex_error (_("expecting end of command"));
379       return 0;
380     }
381   
382   return 1;
383 }
384
385 /* Parses and performs the RENAME subcommand of GET and SAVE. */
386 static int
387 rename_variables (struct dictionary * dict)
388 {
389   int i;
390
391   int success = 0;
392
393   struct variable **v;
394   char **new_names;
395   int nv, nn;
396   char *err_name;
397
398   int group;
399
400   lex_match ('=');
401   if (token != '(')
402     {
403       struct variable *v;
404
405       v = parse_dict_variable (dict);
406       if (v == NULL)
407         return 0;
408       if (!lex_force_match ('=')
409           || !lex_force_id ())
410         return 0;
411       if (!strncmp (tokid, v->name, 8))
412         return 1;
413       if (dict_lookup_var (dict, tokid) != NULL)
414         {
415           msg (SE, _("Cannot rename %s as %s because there already exists "
416                      "a variable named %s.  To rename variables with "
417                      "overlapping names, use a single RENAME subcommand "
418                      "such as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, "
419                      "\"/RENAME (A B C=B C A)\"."), v->name, tokid, tokid);
420           return 0;
421         }
422       
423       dict_rename_var (dict, v, tokid);
424       lex_get ();
425       return 1;
426     }
427
428   nv = nn = 0;
429   v = NULL;
430   new_names = 0;
431   group = 1;
432   while (lex_match ('('))
433     {
434       int old_nv = nv;
435
436       if (!parse_variables (dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
437         goto done;
438       if (!lex_match ('='))
439         {
440           msg (SE, _("`=' expected after variable list."));
441           goto done;
442         }
443       if (!parse_DATA_LIST_vars (&new_names, &nn, PV_APPEND | PV_NO_SCRATCH))
444         goto done;
445       if (nn != nv)
446         {
447           msg (SE, _("Number of variables on left side of `=' (%d) does not "
448                "match number of variables on right side (%d), in "
449                "parenthesized group %d of RENAME subcommand."),
450                nv - old_nv, nn - old_nv, group);
451           goto done;
452         }
453       if (!lex_force_match (')'))
454         goto done;
455       group++;
456     }
457
458   if (!dict_rename_vars (dict, v, new_names, nv, &err_name)) 
459     {
460       msg (SE, _("Requested renaming duplicates variable name %s."), err_name);
461       goto done;
462     }
463   success = 1;
464
465 done:
466   for (i = 0; i < nn; i++)
467     free (new_names[i]);
468   free (new_names);
469   free (v);
470
471   return success;
472 }
473
474 #if DEBUGGING
475 void
476 dump_dict_variables (struct dictionary * dict)
477 {
478   int i;
479
480   printf (_("\nVariables in dictionary:\n"));
481   for (i = 0; i < dict->nvar; i++)
482     printf ("%s, ", dict->var[i]->name);
483   printf ("\n");
484 }
485 #endif
486 \f
487 /* Clears internal state related to GET input procedure. */
488 static void
489 get_source_destroy (struct case_source *source)
490 {
491   struct get_pgm *pgm = source->aux;
492
493   /* It is not necessary to destroy the dictionary because if we get
494      to this point then the dictionary is default_dict. */
495   fh_close_handle (pgm->handle);
496   free (pgm);
497 }
498
499 /* Reads all the cases from the data file into C and passes them
500    to WRITE_CASE one by one, passing WC_DATA. */
501 static void
502 get_source_read (struct case_source *source,
503                  struct ccase *c,
504                  write_case_func *write_case, write_case_data wc_data)
505 {
506   struct get_pgm *pgm = source->aux;
507
508   while (sfm_read_case (pgm->handle, c->data, default_dict)
509          && write_case (wc_data))
510     ;
511 }
512
513 const struct case_source_class get_source_class =
514   {
515     "GET",
516     NULL,
517     get_source_read,
518     get_source_destroy,
519   };
520
521 \f
522 /* MATCH FILES. */
523
524 #include "debug-print.h"
525
526 /* File types. */
527 enum
528   {
529     MTF_FILE,                   /* Specified on FILE= subcommand. */
530     MTF_TABLE                   /* Specified on TABLE= subcommand. */
531   };
532
533 /* One of the files on MATCH FILES. */
534 struct mtf_file
535   {
536     struct mtf_file *next, *prev;
537                                 /* Next, previous in the list of files. */
538     struct mtf_file *next_min;  /* Next in the chain of minimums. */
539     
540     int type;                   /* One of MTF_*. */
541     struct variable **by;       /* List of BY variables for this file. */
542     struct file_handle *handle; /* File handle for the file. */
543     struct dictionary *dict;    /* Dictionary from system file. */
544     char in[9];                 /* Name of the variable from IN=. */
545     char first[9], last[9];     /* Name of the variables from FIRST=, LAST=. */
546     union value *input;         /* Input record. */
547   };
548
549 /* MATCH FILES procedure. */
550 struct mtf_proc 
551   {
552     struct mtf_file *head;      /* First file mentioned on FILE or TABLE. */
553     struct mtf_file *tail;      /* Last file mentioned on FILE or TABLE. */
554     
555     struct variable **by;       /* Variables on the BY subcommand. */
556     size_t by_cnt;              /* Number of variables on BY subcommand. */
557
558     struct dictionary *dict;    /* Dictionary of output file. */
559     struct case_sink *sink;     /* Sink to receive output. */
560     struct ccase *mtf_case;     /* Case used for output. */
561
562     unsigned seq_num;           /* Have we initialized this variable? */
563     unsigned *seq_nums;         /* Sequence numbers for each var in dict. */
564   };
565
566 static void mtf_free (struct mtf_proc *);
567 static void mtf_free_file (struct mtf_file *);
568 static int mtf_merge_dictionary (struct dictionary *const, struct mtf_file *);
569 static void mtf_delete_file_in_place (struct mtf_proc *, struct mtf_file **);
570
571 static void mtf_read_nonactive_records (void *);
572 static void mtf_processing_finish (void *);
573 static int mtf_processing (struct ccase *, void *);
574
575 static char *var_type_description (struct variable *);
576
577 /* Parse and execute the MATCH FILES command. */
578 int
579 cmd_match_files (void)
580 {
581   struct mtf_proc mtf;
582   struct mtf_file *first_table = NULL;
583   
584   int seen = 0;
585   
586   mtf.head = mtf.tail = NULL;
587   mtf.by = NULL;
588   mtf.by_cnt = 0;
589   mtf.dict = dict_create ();
590   mtf.sink = NULL;
591   mtf.mtf_case = NULL;
592   mtf.seq_num = 0;
593   mtf.seq_nums = NULL;
594   dict_set_case_limit (mtf.dict, dict_get_case_limit (default_dict));
595   
596   do
597     {
598       lex_match ('/');
599
600       if (lex_match (T_BY))
601         {
602           if (seen & 1)
603             {
604               msg (SE, _("The BY subcommand may be given once at most."));
605               goto lossage;
606             }
607           seen |= 1;
608               
609           lex_match ('=');
610           if (!parse_variables (mtf.dict, &mtf.by, &mtf.by_cnt,
611                                 PV_NO_DUPLICATE | PV_NO_SCRATCH))
612             goto lossage;
613         }
614       else if (token != T_ID)
615         {
616           lex_error (NULL);
617           goto lossage;
618         }
619       else if (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid))
620         {
621           struct mtf_file *file = xmalloc (sizeof *file);
622
623           file->in[0] = file->first[0] = file->last[0] = '\0';
624           file->dict = NULL;
625           file->by = NULL;
626           file->input = NULL;
627
628           if (lex_match_id ("FILE"))
629             file->type = MTF_FILE;
630           else if (lex_match_id ("TABLE"))
631             {
632               file->type = MTF_TABLE;
633               seen |= 4;
634             }
635           else
636             assert (0);
637
638           /* FILEs go first, then TABLEs. */
639           if (file->type == MTF_TABLE || first_table == NULL)
640             {
641               file->next = NULL;
642               file->prev = mtf.tail;
643               if (mtf.tail)
644                 mtf.tail->next = file;
645               mtf.tail = file;
646               if (mtf.head == NULL)
647                 mtf.head = file;
648               if (file->type == MTF_TABLE && first_table == NULL)
649                 first_table = file;
650             }
651           else 
652             {
653               assert (file->type == MTF_FILE);
654               file->next = first_table;
655               file->prev = first_table->prev;
656               if (first_table->prev)
657                 first_table->prev->next = file;
658               else
659                 mtf.head = file;
660               first_table->prev = file;
661             }
662           
663           lex_match ('=');
664           
665           if (lex_match ('*'))
666             {
667               file->handle = NULL;
668
669               if (seen & 2)
670                 {
671                   msg (SE, _("The active file may not be specified more "
672                              "than once."));
673                   goto lossage;
674                 }
675               seen |= 2;
676
677               assert (pgm_state != STATE_INPUT);
678               if (pgm_state == STATE_INIT)
679                 {
680                   msg (SE, _("Cannot specify the active file since no active "
681                              "file has been defined."));
682                   goto lossage;
683                 }
684
685               if (temporary != 0)
686                 {
687                   msg (SE,
688                        _("MATCH FILES may not be used after TEMPORARY when "
689                          "the active file is an input source.  "
690                          "Temporary transformations will be made permanent."));
691                   cancel_temporary (); 
692                 }
693             }
694           else
695             {
696               file->handle = fh_parse_file_handle ();
697               if (!file->handle)
698                 goto lossage;
699             }
700
701           if (file->handle)
702             {
703               file->dict = sfm_read_dictionary (file->handle, NULL);
704               if (!file->dict)
705                 goto lossage;
706             }
707           else
708             file->dict = default_dict;
709           if (!mtf_merge_dictionary (mtf.dict, file))
710             goto lossage;
711         }
712       else if (lex_id_match ("IN", tokid)
713                || lex_id_match ("FIRST", tokid)
714                || lex_id_match ("LAST", tokid))
715         {
716           const char *sbc;
717           char *name;
718           
719           if (mtf.tail == NULL)
720             {
721               msg (SE, _("IN, FIRST, and LAST subcommands may not occur "
722                          "before the first FILE or TABLE."));
723               goto lossage;
724             }
725
726           if (lex_match_id ("IN"))
727             {
728               name = mtf.tail->in;
729               sbc = "IN";
730             }
731           else if (lex_match_id ("FIRST"))
732             {
733               name = mtf.tail->first;
734               sbc = "FIRST";
735             }
736           else if (lex_match_id ("LAST"))
737             {
738               name = mtf.tail->last;
739               sbc = "LAST";
740             }
741           else 
742             {
743               assert (0);
744               abort ();
745             }
746
747           lex_match ('=');
748           if (token != T_ID)
749             {
750               lex_error (NULL);
751               goto lossage;
752             }
753
754           if (*name)
755             {
756               msg (SE, _("Multiple %s subcommands for a single FILE or "
757                          "TABLE."),
758                    sbc);
759               goto lossage;
760             }
761           strcpy (name, tokid);
762           lex_get ();
763
764           if (!dict_create_var (mtf.dict, name, 0))
765             {
766               msg (SE, _("Duplicate variable name %s while creating %s "
767                          "variable."),
768                    name, sbc);
769               goto lossage;
770             }
771         }
772       else if (lex_id_match ("RENAME", tokid)
773                || lex_id_match ("KEEP", tokid)
774                || lex_id_match ("DROP", tokid))
775         {
776           int options = GTSV_OPT_MATCH_FILES;
777           
778           if (mtf.tail == NULL)
779             {
780               msg (SE, _("RENAME, KEEP, and DROP subcommands may not occur "
781                          "before the first FILE or TABLE."));
782               goto lossage;
783             }
784
785           if (!trim_dictionary (mtf.tail->dict, &options))
786             goto lossage;
787         }
788       else if (lex_match_id ("MAP"))
789         {
790           /* FIXME. */
791         }
792       else
793         {
794           lex_error (NULL);
795           goto lossage;
796         }
797     }
798   while (token != '.');
799
800   if (seen & 4)
801     {
802       if (!(seen & 1))
803         {
804           msg (SE, _("The BY subcommand is required when a TABLE subcommand "
805                      "is given."));
806           goto lossage;
807         }
808     }
809
810   if (seen & 1)
811     {
812       struct mtf_file *iter;
813
814       for (iter = mtf.head; iter; iter = iter->next)
815         {
816           int i;
817           
818           iter->by = xmalloc (sizeof *iter->by * mtf.by_cnt);
819
820           for (i = 0; i < mtf.by_cnt; i++)
821             {
822               iter->by[i] = dict_lookup_var (iter->dict, mtf.by[i]->name);
823               if (iter->by[i] == NULL)
824                 {
825                   msg (SE, _("File %s lacks BY variable %s."),
826                        iter->handle ? handle_get_name (iter->handle) : "*",
827                        mtf.by[i]->name);
828                   goto lossage;
829                 }
830             }
831         }
832     }
833
834 #if DEBUGGING
835   {
836     /* From sfm-read.c. */
837     extern void dump_dictionary (struct dictionary *);
838
839     dump_dictionary (mtf.dict);
840   }
841 #endif
842
843   /* MATCH FILES performs an n-way merge on all its input files.
844      Abstract algorithm:
845
846      1. Read one input record from every input FILE.
847
848      2. If no FILEs are left, stop.  Otherwise, proceed to step 3.
849
850      3. Find the FILE input record with minimum BY values.  Store all
851      the values from this input record into the output record.
852
853      4. Find all the FILE input records with BY values identical to
854      the minimums.  Store all the values from these input records into
855      the output record.
856
857      5. For every TABLE, read another record as long as the BY values
858      on the TABLE's input record are less than the FILEs' BY values.
859      If an exact match is found, store all the values from the TABLE
860      input record into the output record.
861
862      6. Write the output record.
863
864      7. Read another record from each input file FILE and TABLE that
865      we stored values from above.  If we come to the end of one of the
866      input files, remove it from the list of input files.
867
868      8. Repeat from step 2.
869
870      Unfortunately, this algorithm can't be directly implemented
871      because there's no function to read a record from the active
872      file; instead, it has to be done using callbacks.
873
874      FIXME: For merging large numbers of files (more than 10?) a
875      better algorithm would use a heap for finding minimum
876      values. */
877
878   if (!(seen & 2))
879     discard_variables ();
880
881   mtf.sink = create_case_sink (&storage_sink_class, mtf.dict, NULL);
882
883   mtf.seq_nums = xmalloc (dict_get_var_cnt (mtf.dict)
884                           * sizeof *mtf.seq_nums);
885   memset (mtf.seq_nums, 0,
886           dict_get_var_cnt (mtf.dict) * sizeof *mtf.seq_nums);
887   mtf.mtf_case = xmalloc (dict_get_case_size (mtf.dict));
888
889   mtf_read_nonactive_records (NULL);
890   if (seen & 2)
891     procedure (mtf_processing, NULL);
892   mtf_processing_finish (NULL);
893
894   dict_destroy (default_dict);
895   default_dict = mtf.dict;
896   mtf.dict = NULL;
897   vfm_source = mtf.sink->class->make_source (mtf.sink);
898   free_case_sink (mtf.sink);
899   
900   mtf_free (&mtf);
901   return CMD_SUCCESS;
902   
903 lossage:
904   mtf_free (&mtf);
905   return CMD_FAILURE;
906 }
907
908 /* Repeats 2...8 an arbitrary number of times. */
909 static void
910 mtf_processing_finish (void *mtf_)
911 {
912   struct mtf_proc *mtf = mtf_;
913   struct mtf_file *iter;
914
915   /* Find the active file and delete it. */
916   for (iter = mtf->head; iter; iter = iter->next)
917     if (iter->handle == NULL)
918       {
919         mtf_delete_file_in_place (mtf, &iter);
920         break;
921       }
922   
923   while (mtf->head && mtf->head->type == MTF_FILE)
924     if (!mtf_processing (NULL, mtf))
925       break;
926 }
927
928 /* Return a string in a static buffer describing V's variable type and
929    width. */
930 static char *
931 var_type_description (struct variable *v)
932 {
933   static char buf[2][32];
934   static int x = 0;
935   char *s;
936
937   x ^= 1;
938   s = buf[x];
939
940   if (v->type == NUMERIC)
941     strcpy (s, "numeric");
942   else
943     {
944       assert (v->type == ALPHA);
945       sprintf (s, "string with width %d", v->width);
946     }
947   return s;
948 }
949
950 /* Free FILE and associated data. */
951 static void
952 mtf_free_file (struct mtf_file *file)
953 {
954   fh_close_handle (file->handle);
955   if (file->dict != NULL && file->dict != default_dict)
956     dict_destroy (file->dict);
957   free (file->by);
958   if (file->handle)
959     free (file->input);
960   free (file);
961 }
962
963 /* Free all the data for the MATCH FILES procedure. */
964 static void
965 mtf_free (struct mtf_proc *mtf)
966 {
967   struct mtf_file *iter, *next;
968
969   for (iter = mtf->head; iter; iter = next)
970     {
971       next = iter->next;
972
973       mtf_free_file (iter);
974     }
975   
976   free (mtf->by);
977   if (mtf->dict)
978     dict_destroy (mtf->dict);
979   free (mtf->seq_nums);
980 }
981
982 /* Remove *FILE from the mtf_file chain.  Make *FILE point to the next
983    file in the chain, or to NULL if was the last in the chain. */
984 static void
985 mtf_delete_file_in_place (struct mtf_proc *mtf, struct mtf_file **file)
986 {
987   struct mtf_file *f = *file;
988
989   if (f->prev)
990     f->prev->next = f->next;
991   if (f->next)
992     f->next->prev = f->prev;
993   if (f == mtf->head)
994     mtf->head = f->next;
995   if (f == mtf->tail)
996     mtf->tail = f->prev;
997   *file = f->next;
998
999   {
1000     int i;
1001
1002     for (i = 0; i < dict_get_var_cnt (f->dict); i++)
1003       {
1004         struct variable *v = dict_get_var (f->dict, i);
1005           
1006         if (v->type == NUMERIC)
1007           mtf->mtf_case->data[v->p.mtf.master->fv].f = SYSMIS;
1008         else
1009           memset (mtf->mtf_case->data[v->p.mtf.master->fv].s, ' ', v->width);
1010       }
1011   }
1012
1013   mtf_free_file (f);
1014 }
1015
1016 /* Read a record from every input file except the active file. */
1017 static void
1018 mtf_read_nonactive_records (void *mtf_ UNUSED)
1019 {
1020   struct mtf_proc *mtf = mtf_;
1021   struct mtf_file *iter;
1022
1023   for (iter = mtf->head; iter; )
1024     {
1025       if (iter->handle)
1026         {
1027           assert (iter->input == NULL);
1028           iter->input = xmalloc (dict_get_case_size (iter->dict));
1029           
1030           if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1031             mtf_delete_file_in_place (mtf, &iter);
1032           else
1033             iter = iter->next;
1034         }
1035       else
1036         iter = iter->next;
1037     }
1038 }
1039
1040 /* Compare the BY variables for files A and B; return -1 if A < B, 0
1041    if A == B, 1 if A > B. */
1042 static inline int
1043 mtf_compare_BY_values (struct mtf_proc *mtf,
1044                        struct mtf_file *a, struct mtf_file *b,
1045                        struct ccase *c)
1046 {
1047   union value *a_input, *b_input;
1048   int i;
1049
1050   assert ((a == NULL) + (b == NULL) + (c == NULL) <= 1);
1051   a_input = a->input != NULL ? a->input : c->data;
1052   b_input = b->input != NULL ? b->input : c->data;
1053   for (i = 0; i < mtf->by_cnt; i++)
1054     {
1055       assert (a->by[i]->type == b->by[i]->type);
1056       assert (a->by[i]->width == b->by[i]->width);
1057       
1058       if (a->by[i]->type == NUMERIC)
1059         {
1060           double af = a_input[a->by[i]->fv].f;
1061           double bf = b_input[b->by[i]->fv].f;
1062
1063           if (af < bf)
1064             return -1;
1065           else if (af > bf)
1066             return 1;
1067         }
1068       else 
1069         {
1070           int result;
1071           
1072           assert (a->by[i]->type == ALPHA);
1073           result = memcmp (a_input[a->by[i]->fv].s,
1074                            b_input[b->by[i]->fv].s,
1075                            a->by[i]->width);
1076           if (result < 0)
1077             return -1;
1078           else if (result > 0)
1079             return 1;
1080         }
1081     }
1082   return 0;
1083 }
1084
1085 /* Perform one iteration of steps 3...7 above. */
1086 static int
1087 mtf_processing (struct ccase *c, void *mtf_ UNUSED)
1088 {
1089   struct mtf_proc *mtf = mtf_;
1090   struct mtf_file *min_head, *min_tail; /* Files with minimum BY values. */
1091   struct mtf_file *max_head, *max_tail; /* Files with non-minimum BY values. */
1092   struct mtf_file *iter;                /* Iterator. */
1093
1094   for (;;)
1095     {
1096       /* If the active file doesn't have the minimum BY values, don't
1097          return because that would cause a record to be skipped. */
1098       int advance = 1;
1099
1100       if (mtf->head->type == MTF_TABLE)
1101         return 0;
1102       
1103       /* 3. Find the FILE input record with minimum BY values.  Store
1104          all the values from this input record into the output record.
1105
1106          4. Find all the FILE input records with BY values identical
1107          to the minimums.  Store all the values from these input
1108          records into the output record. */
1109       min_head = min_tail = mtf->head;
1110       max_head = max_tail = NULL;
1111       for (iter = mtf->head->next; iter && iter->type == MTF_FILE;
1112            iter = iter->next)
1113         switch (mtf_compare_BY_values (mtf, min_head, iter, c))
1114           {
1115           case -1:
1116             if (max_head)
1117               max_tail = max_tail->next_min = iter;
1118             else
1119               max_head = max_tail = iter;
1120             break;
1121
1122           case 0:
1123             min_tail = min_tail->next_min = iter;
1124             break;
1125
1126           case 1:
1127             if (max_head)
1128               {
1129                 max_tail->next_min = min_head;
1130                 max_tail = min_tail;
1131               }
1132             else
1133               {
1134                 max_head = min_head;
1135                 max_tail = min_tail;
1136               }
1137             min_head = min_tail = iter;
1138             break;
1139
1140           default:
1141             assert (0);
1142           }
1143
1144       /* 5. For every TABLE, read another record as long as the BY
1145          values on the TABLE's input record are less than the FILEs'
1146          BY values.  If an exact match is found, store all the values
1147          from the TABLE input record into the output record. */
1148       while (iter)
1149         {
1150           struct mtf_file *next = iter->next;
1151           
1152           assert (iter->type == MTF_TABLE);
1153       
1154           if (iter->handle == NULL)
1155             advance = 0;
1156
1157         again:
1158           switch (mtf_compare_BY_values (mtf, min_head, iter, c))
1159             {
1160             case -1:
1161               if (max_head)
1162                 max_tail = max_tail->next_min = iter;
1163               else
1164                 max_head = max_tail = iter;
1165               break;
1166
1167             case 0:
1168               min_tail = min_tail->next_min = iter;
1169               break;
1170
1171             case 1:
1172               if (iter->handle == NULL)
1173                 return 1;
1174               if (sfm_read_case (iter->handle, iter->input, iter->dict))
1175                 goto again;
1176               mtf_delete_file_in_place (mtf, &iter);
1177               break;
1178
1179             default:
1180               assert (0);
1181             }
1182
1183           iter = next;
1184         }
1185
1186       /* Next sequence number. */
1187       mtf->seq_num++;
1188   
1189       /* Store data to all the records we are using. */
1190       if (min_tail)
1191         min_tail->next_min = NULL;
1192       for (iter = min_head; iter; iter = iter->next_min)
1193         {
1194           int i;
1195
1196           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1197             {
1198               struct variable *v = dict_get_var (iter->dict, i);
1199               union value *record;
1200           
1201               if (mtf->seq_nums[v->p.mtf.master->index] == mtf->seq_num)
1202                 continue;
1203               mtf->seq_nums[v->p.mtf.master->index] = mtf->seq_num;
1204
1205               record = iter->input != NULL ? iter->input : c->data;
1206
1207               assert (v->type == NUMERIC || v->type == ALPHA);
1208               if (v->type == NUMERIC)
1209                 mtf->mtf_case->data[v->p.mtf.master->fv].f = record[v->fv].f;
1210               else
1211                 memcpy (mtf->mtf_case->data[v->p.mtf.master->fv].s,
1212                         record[v->fv].s, v->width);
1213             }
1214         }
1215
1216       /* Store missing values to all the records we're not using. */
1217       if (max_tail)
1218         max_tail->next_min = NULL;
1219       for (iter = max_head; iter; iter = iter->next_min)
1220         {
1221           int i;
1222
1223           for (i = 0; i < dict_get_var_cnt (iter->dict); i++)
1224             {
1225               struct variable *v = dict_get_var (iter->dict, i);
1226           
1227               if (mtf->seq_nums[v->p.mtf.master->index] == mtf->seq_num)
1228                 continue;
1229               mtf->seq_nums[v->p.mtf.master->index] = mtf->seq_num;
1230
1231 #if 0
1232               printf ("%s/%s: dest-fv=%d\n",
1233                       fh_handle_name (iter->handle),
1234                       v->name,
1235                       v->p.mtf.master->fv);
1236 #endif
1237               if (v->type == NUMERIC)
1238                 mtf->mtf_case->data[v->p.mtf.master->fv].f = SYSMIS;
1239               else
1240                 memset (mtf->mtf_case->data[v->p.mtf.master->fv].s, ' ',
1241                         v->width);
1242             }
1243
1244           if (iter->handle == NULL)
1245             advance = 0;
1246         }
1247
1248       /* 6. Write the output record. */
1249       mtf->sink->class->write (mtf->sink, mtf->mtf_case);
1250
1251       /* 7. Read another record from each input file FILE and TABLE
1252          that we stored values from above.  If we come to the end of
1253          one of the input files, remove it from the list of input
1254          files. */
1255       for (iter = min_head; iter && iter->type == MTF_FILE; )
1256         {
1257           struct mtf_file *next = iter->next_min;
1258           
1259           if (iter->handle)
1260             {
1261               assert (iter->input != NULL);
1262
1263               if (!sfm_read_case (iter->handle, iter->input, iter->dict))
1264                 mtf_delete_file_in_place (mtf, &iter);
1265             }
1266
1267           iter = next;
1268         }
1269       
1270       if (advance)
1271         break;
1272     }
1273
1274   return (mtf->head && mtf->head->type != MTF_TABLE);
1275 }
1276
1277 /* Merge the dictionary for file F into the master dictionary
1278    mtf_dict. */
1279 static int
1280 mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
1281 {
1282   struct dictionary *d = f->dict;
1283   const char *d_docs, *m_docs;
1284
1285   if (dict_get_label (m) == NULL)
1286     dict_set_label (m, dict_get_label (d));
1287
1288   d_docs = dict_get_documents (d);
1289   m_docs = dict_get_documents (m);
1290   if (d_docs != NULL) 
1291     {
1292       if (m_docs == NULL)
1293         dict_set_documents (m, d_docs);
1294       else
1295         {
1296           char *new_docs;
1297           size_t new_len;
1298
1299           new_len = strlen (m_docs) + strlen (d_docs);
1300           new_docs = xmalloc (new_len + 1);
1301           strcpy (new_docs, m_docs);
1302           strcat (new_docs, d_docs);
1303           dict_set_documents (m, new_docs);
1304           free (new_docs);
1305         }
1306     }
1307   
1308   dict_compact_values (d);
1309
1310   {
1311     int i;
1312
1313     for (i = 0; i < dict_get_var_cnt (d); i++)
1314       {
1315         struct variable *dv = dict_get_var (d, i);
1316         struct variable *mv = dict_lookup_var (m, dv->name);
1317
1318         assert (dv->type == ALPHA || dv->width == 0);
1319         assert (!mv || mv->type == ALPHA || mv->width == 0);
1320         if (mv && dv->width == mv->width)
1321           {
1322             if (val_labs_count (dv->val_labs)
1323                 && !val_labs_count (mv->val_labs))
1324               mv->val_labs = val_labs_copy (dv->val_labs);
1325             if (dv->miss_type != MISSING_NONE
1326                 && mv->miss_type == MISSING_NONE)
1327               copy_missing_values (mv, dv);
1328           }
1329         if (mv && dv->label && !mv->label)
1330           mv->label = xstrdup (dv->label);
1331         if (!mv) 
1332           {
1333             mv = dict_clone_var (m, dv, dv->name);
1334             assert (mv != NULL);
1335           }
1336         else if (mv->width != dv->width)
1337           {
1338             msg (SE, _("Variable %s in file %s (%s) has different "
1339                        "type or width from the same variable in "
1340                        "earlier file (%s)."),
1341                  dv->name, handle_get_name (f->handle),
1342                  var_type_description (dv), var_type_description (mv));
1343             return 0;
1344           }
1345         dv->p.mtf.master = mv;
1346       }
1347   }
1348
1349   return 1;
1350 }
1351 \f
1352 /* IMPORT command. */
1353
1354 /* Parses the IMPORT command. */
1355 int
1356 cmd_import (void)
1357 {
1358   struct file_handle *handle = NULL;
1359   struct dictionary *dict;
1360   struct get_pgm *pgm;
1361   int options = GTSV_OPT_NONE;
1362   int type;
1363
1364   for (;;)
1365     {
1366       lex_match ('/');
1367       
1368       if (lex_match_id ("FILE") || token == T_STRING)
1369         {
1370           lex_match ('=');
1371
1372           handle = fh_parse_file_handle ();
1373           if (handle == NULL)
1374             return CMD_FAILURE;
1375         }
1376       else if (lex_match_id ("TYPE"))
1377         {
1378           lex_match ('=');
1379
1380           if (lex_match_id ("COMM"))
1381             type = PFM_COMM;
1382           else if (lex_match_id ("TAPE"))
1383             type = PFM_TAPE;
1384           else
1385             {
1386               lex_error (_("expecting COMM or TAPE"));
1387               return CMD_FAILURE;
1388             }
1389         }
1390       else break;
1391     }
1392   if (!lex_match ('/') && token != '.')
1393     {
1394       lex_error (NULL);
1395       return CMD_FAILURE;
1396     }
1397
1398   discard_variables ();
1399
1400   dict = pfm_read_dictionary (handle, NULL);
1401   if (dict == NULL)
1402     return CMD_FAILURE;
1403
1404 #if DEBUGGING
1405   dump_dict_variables (dict);
1406 #endif
1407   if (0 == trim_dictionary (dict, &options))
1408     {
1409       fh_close_handle (handle);
1410       return CMD_FAILURE;
1411     }
1412 #if DEBUGGING
1413   dump_dict_variables (dict);
1414 #endif
1415
1416   dict_compact_values (dict);
1417
1418 #if DEBUGGING
1419   printf (_("IMPORT translation table from file to memory:\n"));
1420   for (i = 0; i < dict->nvar; i++)
1421     {
1422       struct variable *v = dict->var[i];
1423
1424       printf (_("  %8s from %3d,%3d to %3d,%3d\n"), v->name,
1425               v->get.fv, v->get.nv, v->fv, v->nv);
1426     }
1427 #endif
1428
1429   dict_destroy (default_dict);
1430   default_dict = dict;
1431
1432   pgm = xmalloc (sizeof *pgm);
1433   pgm->handle = handle;
1434   pgm->case_size = dict_get_case_size (default_dict);
1435   vfm_source = create_case_source (&import_source_class, default_dict, pgm);
1436
1437   return CMD_SUCCESS;
1438 }
1439
1440 /* Reads all the cases from the data file and passes them to
1441    write_case(). */
1442 static void
1443 import_source_read (struct case_source *source,
1444                     struct ccase *c,
1445                     write_case_func *write_case, write_case_data wc_data)
1446 {
1447   struct get_pgm *pgm = source->aux;
1448   
1449   while (pfm_read_case (pgm->handle, c->data, default_dict))
1450     if (!write_case (wc_data))
1451       break;
1452 }
1453
1454 const struct case_source_class import_source_class =
1455   {
1456     "IMPORT",
1457     NULL,
1458     import_source_read,
1459     get_source_destroy,
1460   };
1461 \f
1462 static int export_write_case_func (struct ccase *c, void *);
1463      
1464 /* Parses the EXPORT command.  */
1465 /* FIXME: same as cmd_save_internal(). */
1466 int
1467 cmd_export (void)
1468 {
1469   struct file_handle *handle;
1470   struct dictionary *dict;
1471   int options = GTSV_OPT_SAVE;
1472
1473   struct save_trns *t;
1474
1475   int i;
1476
1477   lex_match ('/');
1478   if (lex_match_id ("OUTFILE"))
1479     lex_match ('=');
1480
1481   handle = fh_parse_file_handle ();
1482   if (handle == NULL)
1483     return CMD_FAILURE;
1484
1485   dict = dict_clone (default_dict);
1486 #if DEBUGGING
1487   dump_dict_variables (dict);
1488 #endif
1489   for (i = 0; i < dict_get_var_cnt (dict); i++)
1490     dict_get_var (dict, i)->aux = dict_get_var (default_dict, i);
1491   if (0 == trim_dictionary (dict, &options))
1492     {
1493       fh_close_handle (handle);
1494       return CMD_FAILURE;
1495     }
1496
1497 #if DEBUGGING
1498   dump_dict_variables (dict);
1499 #endif
1500
1501   /* Write dictionary. */
1502   if (!pfm_write_dictionary (handle, dict))
1503     {
1504       dict_destroy (dict);
1505       fh_close_handle (handle);
1506       return CMD_FAILURE;
1507     }
1508
1509   /* Fill in transformation structure. */
1510   t = xmalloc (sizeof *t);
1511   t->h.proc = save_trns_proc;
1512   t->h.free = save_trns_free;
1513   t->f = handle;
1514   t->nvar = dict_get_var_cnt (dict);
1515   t->var = xmalloc (sizeof *t->var * t->nvar);
1516   for (i = 0; i < t->nvar; i++)
1517     t->var[i] = dict_get_var (dict, i)->aux;
1518   t->case_buf = xmalloc (sizeof *t->case_buf * t->nvar);
1519   dict_destroy (dict);
1520
1521   procedure (export_write_case_func, t);
1522   save_trns_free (&t->h);
1523
1524   return CMD_SUCCESS;
1525 }
1526
1527 /* Writes case C to the EXPORT file. */
1528 static int
1529 export_write_case_func (struct ccase *c, void *aux)
1530 {
1531   struct save_trns *t = aux;
1532   union value *p = (union value *) t->case_buf;
1533   int i;
1534
1535   for (i = 0; i < t->nvar; i++)
1536     {
1537       struct variable *v = t->var[i];
1538
1539       if (v->type == NUMERIC)
1540         *p++ = c->data[v->fv];
1541       else
1542         (*p++).c = c->data[v->fv].s;
1543     }
1544
1545   pfm_write_case (t->f, (union value *) t->case_buf);
1546   return 1;
1547 }