22ae6feb601579f02e0ef96b78b5fc4c82e7b8e9
[pspp-builds.git] / src / language / data-io / get.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2006, 2007 Free Software Foundation, Inc.
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
16
17 #include <config.h>
18
19 #include <stdlib.h>
20
21 #include <data/any-reader.h>
22 #include <data/any-writer.h>
23 #include <data/case.h>
24 #include <data/case-map.h>
25 #include <data/casereader.h>
26 #include <data/casewriter.h>
27 #include <data/format.h>
28 #include <data/dictionary.h>
29 #include <data/por-file-writer.h>
30 #include <data/procedure.h>
31 #include <data/settings.h>
32 #include <data/sys-file-writer.h>
33 #include <data/transformations.h>
34 #include <data/value-labels.h>
35 #include <data/variable.h>
36 #include <language/command.h>
37 #include <language/data-io/file-handle.h>
38 #include <language/lexer/lexer.h>
39 #include <language/lexer/variable-parser.h>
40 #include <libpspp/alloc.h>
41 #include <libpspp/assertion.h>
42 #include <libpspp/compiler.h>
43 #include <libpspp/hash.h>
44 #include <libpspp/message.h>
45 #include <libpspp/misc.h>
46 #include <libpspp/str.h>
47 #include <libpspp/taint.h>
48
49 #include "gettext.h"
50 #define _(msgid) gettext (msgid)
51
52 static bool parse_dict_trim (struct lexer *, struct dictionary *);
53 \f
54 /* Reading system and portable files. */
55
56 /* Type of command. */
57 enum reader_command
58   {
59     GET_CMD,
60     IMPORT_CMD
61   };
62
63 static void get_translate_case (const struct ccase *, struct ccase *,
64                                 void *map_);
65 static bool get_destroy_case_map (void *map_);
66
67 /* Parses a GET or IMPORT command. */
68 static int
69 parse_read_command (struct lexer *lexer, struct dataset *ds, enum reader_command type)
70 {
71   struct casereader *reader = NULL;
72   struct file_handle *fh = NULL;
73   struct dictionary *dict = NULL;
74   struct case_map *map = NULL;
75
76   for (;;)
77     {
78       lex_match (lexer, '/');
79
80       if (lex_match_id (lexer, "FILE") || lex_token (lexer) == T_STRING)
81         {
82           lex_match (lexer, '=');
83
84           fh = fh_parse (lexer, FH_REF_FILE | FH_REF_SCRATCH);
85           if (fh == NULL)
86             goto error;
87         }
88       else if (type == IMPORT_CMD && lex_match_id (lexer, "TYPE"))
89         {
90           lex_match (lexer, '=');
91
92           if (lex_match_id (lexer, "COMM"))
93             type = PFM_COMM;
94           else if (lex_match_id (lexer, "TAPE"))
95             type = PFM_TAPE;
96           else
97             {
98               lex_error (lexer, _("expecting COMM or TAPE"));
99               goto error;
100             }
101         }
102       else
103         break;
104     }
105
106   if (fh == NULL)
107     {
108       lex_sbc_missing (lexer, "FILE");
109       goto error;
110     }
111
112   reader = any_reader_open (fh, &dict);
113   if (reader == NULL)
114     goto error;
115
116   case_map_prepare_dict (dict);
117
118   while (lex_token (lexer) != '.')
119     {
120       lex_match (lexer, '/');
121       if (!parse_dict_trim (lexer, dict))
122         goto error;
123     }
124   dict_compact_values (dict);
125
126   map = case_map_from_dict (dict);
127   if (map != NULL)
128     reader = casereader_create_translator (reader,
129                                            dict_get_next_value_idx (dict),
130                                            get_translate_case,
131                                            get_destroy_case_map,
132                                            map);
133
134   proc_set_active_file (ds, reader, dict);
135
136   return CMD_SUCCESS;
137
138  error:
139   casereader_destroy (reader);
140   if (dict != NULL)
141     dict_destroy (dict);
142   return CMD_CASCADING_FAILURE;
143 }
144
145 static void
146 get_translate_case (const struct ccase *input, struct ccase *output,
147                     void *map_)
148 {
149   struct case_map *map = map_;
150   case_map_execute (map, input, output);
151 }
152
153 static bool
154 get_destroy_case_map (void *map_)
155 {
156   struct case_map *map = map_;
157   case_map_destroy (map);
158   return true;
159 }
160 \f
161 /* GET. */
162 int
163 cmd_get (struct lexer *lexer, struct dataset *ds)
164 {
165   return parse_read_command (lexer, ds, GET_CMD);
166 }
167
168 /* IMPORT. */
169 int
170 cmd_import (struct lexer *lexer, struct dataset *ds)
171 {
172   return parse_read_command (lexer, ds, IMPORT_CMD);
173 }
174 \f
175 /* Writing system and portable files. */
176
177 /* Type of output file. */
178 enum writer_type
179   {
180     SYSFILE_WRITER,     /* System file. */
181     PORFILE_WRITER      /* Portable file. */
182   };
183
184 /* Type of a command. */
185 enum command_type
186   {
187     XFORM_CMD,          /* Transformation. */
188     PROC_CMD            /* Procedure. */
189   };
190
191 /* Parses SAVE or XSAVE or EXPORT or XEXPORT command.
192    WRITER_TYPE identifies the type of file to write,
193    and COMMAND_TYPE identifies the type of command.
194
195    On success, returns a writer.
196    For procedures only, sets *RETAIN_UNSELECTED to true if cases
197    that would otherwise be excluded by FILTER or USE should be
198    included.
199
200    On failure, returns a null pointer. */
201 static struct casewriter *
202 parse_write_command (struct lexer *lexer, struct dataset *ds,
203                      enum writer_type writer_type,
204                      enum command_type command_type,
205                      bool *retain_unselected)
206 {
207   /* Common data. */
208   struct file_handle *handle; /* Output file. */
209   struct dictionary *dict;    /* Dictionary for output file. */
210   struct casewriter *writer;  /* Writer. */
211   struct case_map *map;       /* Map from input data to data for writer. */
212
213   /* Common options. */
214   bool print_map;             /* Print map?  TODO. */
215   bool print_short_names;     /* Print long-to-short name map.  TODO. */
216   struct sfm_write_options sysfile_opts;
217   struct pfm_write_options porfile_opts;
218
219   assert (writer_type == SYSFILE_WRITER || writer_type == PORFILE_WRITER);
220   assert (command_type == XFORM_CMD || command_type == PROC_CMD);
221   assert ((retain_unselected != NULL) == (command_type == PROC_CMD));
222
223   if (command_type == PROC_CMD)
224     *retain_unselected = true;
225
226   handle = NULL;
227   dict = dict_clone (dataset_dict (ds));
228   writer = NULL;
229   map = NULL;
230   print_map = false;
231   print_short_names = false;
232   sysfile_opts = sfm_writer_default_options ();
233   porfile_opts = pfm_writer_default_options ();
234
235   case_map_prepare_dict (dict);
236   dict_delete_scratch_vars (dict);
237
238   lex_match (lexer, '/');
239   for (;;)
240     {
241       if (lex_match_id (lexer, "OUTFILE"))
242         {
243           if (handle != NULL)
244             {
245               lex_sbc_only_once ("OUTFILE");
246               goto error;
247             }
248
249           lex_match (lexer, '=');
250
251           handle = fh_parse (lexer, FH_REF_FILE | FH_REF_SCRATCH);
252           if (handle == NULL)
253             goto error;
254         }
255       else if (lex_match_id (lexer, "NAMES"))
256         print_short_names = true;
257       else if (lex_match_id (lexer, "PERMISSIONS"))
258         {
259           bool cw;
260
261           lex_match (lexer, '=');
262           if (lex_match_id (lexer, "READONLY"))
263             cw = false;
264           else if (lex_match_id (lexer, "WRITEABLE"))
265             cw = true;
266           else
267             {
268               lex_error (lexer, _("expecting %s or %s"), "READONLY", "WRITEABLE");
269               goto error;
270             }
271           sysfile_opts.create_writeable = porfile_opts.create_writeable = cw;
272         }
273       else if (command_type == PROC_CMD && lex_match_id (lexer, "UNSELECTED"))
274         {
275           lex_match (lexer, '=');
276           if (lex_match_id (lexer, "RETAIN"))
277             *retain_unselected = true;
278           else if (lex_match_id (lexer, "DELETE"))
279             *retain_unselected = false;
280           else
281             {
282               lex_error (lexer, _("expecting %s or %s"), "RETAIN", "DELETE");
283               goto error;
284             }
285         }
286       else if (writer_type == SYSFILE_WRITER && lex_match_id (lexer, "COMPRESSED"))
287         sysfile_opts.compress = true;
288       else if (writer_type == SYSFILE_WRITER && lex_match_id (lexer, "UNCOMPRESSED"))
289         sysfile_opts.compress = false;
290       else if (writer_type == SYSFILE_WRITER && lex_match_id (lexer, "VERSION"))
291         {
292           lex_match (lexer, '=');
293           if (!lex_force_int (lexer))
294             goto error;
295           sysfile_opts.version = lex_integer (lexer);
296           lex_get (lexer);
297         }
298       else if (writer_type == PORFILE_WRITER && lex_match_id (lexer, "TYPE"))
299         {
300           lex_match (lexer, '=');
301           if (lex_match_id (lexer, "COMMUNICATIONS"))
302             porfile_opts.type = PFM_COMM;
303           else if (lex_match_id (lexer, "TAPE"))
304             porfile_opts.type = PFM_TAPE;
305           else
306             {
307               lex_error (lexer, _("expecting %s or %s"), "COMM", "TAPE");
308               goto error;
309             }
310         }
311       else if (writer_type == PORFILE_WRITER && lex_match_id (lexer, "DIGITS"))
312         {
313           lex_match (lexer, '=');
314           if (!lex_force_int (lexer))
315             goto error;
316           porfile_opts.digits = lex_integer (lexer);
317           lex_get (lexer);
318         }
319       else if (!parse_dict_trim (lexer, dict))
320         goto error;
321
322       if (!lex_match (lexer, '/'))
323         break;
324     }
325   if (lex_end_of_command (lexer) != CMD_SUCCESS)
326     goto error;
327
328   if (handle == NULL)
329     {
330       lex_sbc_missing (lexer, "OUTFILE");
331       goto error;
332     }
333
334   dict_delete_scratch_vars (dict);
335   dict_compact_values (dict);
336
337   if (fh_get_referent (handle) == FH_REF_FILE)
338     {
339       switch (writer_type)
340         {
341         case SYSFILE_WRITER:
342           writer = sfm_open_writer (handle, dict, sysfile_opts);
343           break;
344         case PORFILE_WRITER:
345           writer = pfm_open_writer (handle, dict, porfile_opts);
346           break;
347         }
348     }
349   else
350     writer = any_writer_open (handle, dict);
351   if (writer == NULL)
352     goto error;
353
354   map = case_map_from_dict (dict);
355   if (map != NULL)
356     writer = casewriter_create_translator (writer,
357                                            case_map_get_value_cnt (map),
358                                            get_translate_case,
359                                            get_destroy_case_map,
360                                            map);
361   dict_destroy (dict);
362
363   return writer;
364
365  error:
366   casewriter_destroy (writer);
367   dict_destroy (dict);
368   case_map_destroy (map);
369   return NULL;
370 }
371 \f
372 /* SAVE and EXPORT. */
373
374 /* Parses and performs the SAVE or EXPORT procedure. */
375 static int
376 parse_output_proc (struct lexer *lexer, struct dataset *ds, enum writer_type writer_type)
377 {
378   bool retain_unselected;
379   struct variable *saved_filter_variable;
380   struct casewriter *output;
381   bool ok;
382
383   output = parse_write_command (lexer, ds, writer_type, PROC_CMD,
384                                 &retain_unselected);
385   if (output == NULL)
386     return CMD_CASCADING_FAILURE;
387
388   saved_filter_variable = dict_get_filter (dataset_dict (ds));
389   if (retain_unselected)
390     dict_set_filter (dataset_dict (ds), NULL);
391
392   casereader_transfer (proc_open (ds), output);
393   ok = casewriter_destroy (output);
394   ok = proc_commit (ds) && ok;
395
396   dict_set_filter (dataset_dict (ds), saved_filter_variable);
397
398   return ok ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
399 }
400
401 int
402 cmd_save (struct lexer *lexer, struct dataset *ds)
403 {
404   return parse_output_proc (lexer, ds, SYSFILE_WRITER);
405 }
406
407 int
408 cmd_export (struct lexer *lexer, struct dataset *ds)
409 {
410   return parse_output_proc (lexer, ds, PORFILE_WRITER);
411 }
412 \f
413 /* XSAVE and XEXPORT. */
414
415 /* Transformation. */
416 struct output_trns
417   {
418     struct casewriter *writer;          /* Writer. */
419   };
420
421 static trns_proc_func output_trns_proc;
422 static trns_free_func output_trns_free;
423
424 /* Parses the XSAVE or XEXPORT transformation command. */
425 static int
426 parse_output_trns (struct lexer *lexer, struct dataset *ds, enum writer_type writer_type)
427 {
428   struct output_trns *t = xmalloc (sizeof *t);
429   t->writer = parse_write_command (lexer, ds, writer_type, XFORM_CMD, NULL);
430   if (t->writer == NULL)
431     {
432       free (t);
433       return CMD_CASCADING_FAILURE;
434     }
435
436   add_transformation (ds, output_trns_proc, output_trns_free, t);
437   return CMD_SUCCESS;
438 }
439
440 /* Writes case C to the system file specified on XSAVE or XEXPORT. */
441 static int
442 output_trns_proc (void *trns_, struct ccase *c, casenumber case_num UNUSED)
443 {
444   struct output_trns *t = trns_;
445   struct ccase tmp;
446   case_clone (&tmp, c);
447   casewriter_write (t->writer, &tmp);
448   return TRNS_CONTINUE;
449 }
450
451 /* Frees an XSAVE or XEXPORT transformation.
452    Returns true if successful, false if an I/O error occurred. */
453 static bool
454 output_trns_free (void *trns_)
455 {
456   struct output_trns *t = trns_;
457   bool ok = casewriter_destroy (t->writer);
458   free (t);
459   return ok;
460 }
461
462 /* XSAVE command. */
463 int
464 cmd_xsave (struct lexer *lexer, struct dataset *ds)
465 {
466   return parse_output_trns (lexer, ds, SYSFILE_WRITER);
467 }
468
469 /* XEXPORT command. */
470 int
471 cmd_xexport (struct lexer *lexer, struct dataset *ds)
472 {
473   return parse_output_trns (lexer, ds, PORFILE_WRITER);
474 }
475 \f
476 static bool rename_variables (struct lexer *lexer, struct dictionary *dict);
477 static bool drop_variables (struct lexer *, struct dictionary *dict);
478 static bool keep_variables (struct lexer *, struct dictionary *dict);
479
480 /* Commands that read and write system files share a great deal
481    of common syntactic structure for rearranging and dropping
482    variables.  This function parses this syntax and modifies DICT
483    appropriately.  Returns true on success, false on failure. */
484 static bool
485 parse_dict_trim (struct lexer *lexer, struct dictionary *dict)
486 {
487   if (lex_match_id (lexer, "MAP"))
488     {
489       /* FIXME. */
490       return true;
491     }
492   else if (lex_match_id (lexer, "DROP"))
493     return drop_variables (lexer, dict);
494   else if (lex_match_id (lexer, "KEEP"))
495     return keep_variables (lexer, dict);
496   else if (lex_match_id (lexer, "RENAME"))
497     return rename_variables (lexer, dict);
498   else
499     {
500       lex_error (lexer, _("expecting a valid subcommand"));
501       return false;
502     }
503 }
504
505 /* Parses and performs the RENAME subcommand of GET and SAVE. */
506 static bool
507 rename_variables (struct lexer *lexer, struct dictionary *dict)
508 {
509   size_t i;
510
511   int success = 0;
512
513   struct variable **v;
514   char **new_names;
515   size_t nv, nn;
516   char *err_name;
517
518   int group;
519
520   lex_match (lexer, '=');
521   if (lex_token (lexer) != '(')
522     {
523       struct variable *v;
524
525       v = parse_variable (lexer, dict);
526       if (v == NULL)
527         return 0;
528       if (!lex_force_match (lexer, '=')
529           || !lex_force_id (lexer))
530         return 0;
531       if (dict_lookup_var (dict, lex_tokid (lexer)) != NULL)
532         {
533           msg (SE, _("Cannot rename %s as %s because there already exists "
534                      "a variable named %s.  To rename variables with "
535                      "overlapping names, use a single RENAME subcommand "
536                      "such as \"/RENAME (A=B)(B=C)(C=A)\", or equivalently, "
537                      "\"/RENAME (A B C=B C A)\"."),
538                var_get_name (v), lex_tokid (lexer), lex_tokid (lexer));
539           return 0;
540         }
541
542       dict_rename_var (dict, v, lex_tokid (lexer));
543       lex_get (lexer);
544       return 1;
545     }
546
547   nv = nn = 0;
548   v = NULL;
549   new_names = 0;
550   group = 1;
551   while (lex_match (lexer, '('))
552     {
553       size_t old_nv = nv;
554
555       if (!parse_variables (lexer, dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
556         goto done;
557       if (!lex_match (lexer, '='))
558         {
559           msg (SE, _("`=' expected after variable list."));
560           goto done;
561         }
562       if (!parse_DATA_LIST_vars (lexer, &new_names, &nn, PV_APPEND | PV_NO_SCRATCH))
563         goto done;
564       if (nn != nv)
565         {
566           msg (SE, _("Number of variables on left side of `=' (%d) does not "
567                      "match number of variables on right side (%d), in "
568                      "parenthesized group %d of RENAME subcommand."),
569                (unsigned) (nv - old_nv), (unsigned) (nn - old_nv), group);
570           goto done;
571         }
572       if (!lex_force_match (lexer, ')'))
573         goto done;
574       group++;
575     }
576
577   if (!dict_rename_vars (dict, v, new_names, nv, &err_name))
578     {
579       msg (SE, _("Requested renaming duplicates variable name %s."), err_name);
580       goto done;
581     }
582   success = 1;
583
584  done:
585   for (i = 0; i < nn; i++)
586     free (new_names[i]);
587   free (new_names);
588   free (v);
589
590   return success;
591 }
592
593 /* Parses and performs the DROP subcommand of GET and SAVE.
594    Returns true if successful, false on failure.*/
595 static bool
596 drop_variables (struct lexer *lexer, struct dictionary *dict)
597 {
598   struct variable **v;
599   size_t nv;
600
601   lex_match (lexer, '=');
602   if (!parse_variables (lexer, dict, &v, &nv, PV_NONE))
603     return false;
604   dict_delete_vars (dict, v, nv);
605   free (v);
606
607   if (dict_get_var_cnt (dict) == 0)
608     {
609       msg (SE, _("Cannot DROP all variables from dictionary."));
610       return false;
611     }
612   return true;
613 }
614
615 /* Parses and performs the KEEP subcommand of GET and SAVE.
616    Returns true if successful, false on failure.*/
617 static bool
618 keep_variables (struct lexer *lexer, struct dictionary *dict)
619 {
620   struct variable **v;
621   size_t nv;
622   size_t i;
623
624   lex_match (lexer, '=');
625   if (!parse_variables (lexer, dict, &v, &nv, PV_NONE))
626     return false;
627
628   /* Move the specified variables to the beginning. */
629   dict_reorder_vars (dict, v, nv);
630
631   /* Delete the remaining variables. */
632   v = xnrealloc (v, dict_get_var_cnt (dict) - nv, sizeof *v);
633   for (i = nv; i < dict_get_var_cnt (dict); i++)
634     v[i - nv] = dict_get_var (dict, i);
635   dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
636   free (v);
637
638   return true;
639 }
640 \f
641 /* MATCH FILES. */
642
643 /* File types. */
644 enum mtf_type
645   {
646     MTF_FILE,                   /* Specified on FILE= subcommand. */
647     MTF_TABLE                   /* Specified on TABLE= subcommand. */
648   };
649
650 /* One of the FILEs or TABLEs on MATCH FILES. */
651 struct mtf_file
652   {
653     struct ll ll;               /* In list of all files and tables. */
654
655     enum mtf_type type;
656     int sequence;
657
658     const struct variable **by; /* List of BY variables for this file. */
659     struct mtf_variable *vars;  /* Variables to copy to output. */
660     size_t var_cnt;             /* Number of other variables. */
661
662     struct file_handle *handle; /* Input file handle. */
663     struct dictionary *dict;    /* Input file dictionary. */
664     struct casereader *reader;  /* Input reader. */
665     struct ccase input;         /* Input record (null at end of file). */
666
667     /* IN subcommand. */
668     char *in_name;              /* Variable name. */
669     struct variable *in_var;    /* Variable (in master dictionary). */
670   };
671
672 struct mtf_variable
673   {
674     struct variable *in_var;
675     struct variable *out_var;
676   };
677
678 /* MATCH FILES procedure. */
679 struct mtf_proc
680   {
681     struct ll_list files;       /* List of "struct mtf_file"s. */
682     int nonempty_files;         /* FILEs that are not at end-of-file. */
683
684     bool ok;                    /* False if I/O error occurs. */
685
686     struct dictionary *dict;    /* Dictionary of output file. */
687     struct casewriter *output;  /* MATCH FILES output. */
688
689     size_t by_cnt;              /* Number of variables on BY subcommand. */
690
691     /* FIRST, LAST.
692        Only if "first" or "last" is nonnull are the remaining
693        members used. */
694     struct variable *first;     /* Variable specified on FIRST (if any). */
695     struct variable *last;      /* Variable specified on LAST (if any). */
696     struct ccase buffered_case; /* Case ready for output except that we don't
697                                    know the value for the LAST variable yet. */
698     struct ccase prev_BY_case;  /* Case with values of last set of BY vars. */
699     const struct variable **prev_BY;  /* Last set of BY variables. */
700   };
701
702 static void mtf_free (struct mtf_proc *);
703
704 static bool mtf_close_all_files (struct mtf_proc *);
705 static bool mtf_merge_dictionary (struct dictionary *const, struct mtf_file *);
706 static bool mtf_read_record (struct mtf_proc *mtf, struct mtf_file *);
707
708 static void mtf_process_case (struct mtf_proc *);
709
710 static bool create_flag_var (const char *subcommand_name, const char *var_name,
711                              struct dictionary *, struct variable **);
712 static char *var_type_description (struct variable *);
713
714 /* Parse and execute the MATCH FILES command. */
715 int
716 cmd_match_files (struct lexer *lexer, struct dataset *ds)
717 {
718   struct mtf_proc mtf;
719   struct ll *first_table;
720   struct mtf_file *file, *next;
721
722   bool saw_in = false;
723   struct casereader *active_file = NULL;
724
725   char first_name[LONG_NAME_LEN + 1] = "";
726   char last_name[LONG_NAME_LEN + 1] = "";
727
728   struct taint *taint = NULL;
729
730   size_t i;
731
732   ll_init (&mtf.files);
733   mtf.nonempty_files = 0;
734   first_table = ll_null (&mtf.files);
735   mtf.dict = dict_create ();
736   mtf.output = NULL;
737   mtf.by_cnt = 0;
738   mtf.first = mtf.last = NULL;
739   case_nullify (&mtf.buffered_case);
740   case_nullify (&mtf.prev_BY_case);
741   mtf.prev_BY = NULL;
742
743   dict_set_case_limit (mtf.dict, dict_get_case_limit (dataset_dict (ds)));
744
745   lex_match (lexer, '/');
746   while (lex_token (lexer) == T_ID
747          && (lex_id_match (ss_cstr ("FILE"), ss_cstr (lex_tokid (lexer)))
748              || lex_id_match (ss_cstr ("TABLE"), ss_cstr (lex_tokid (lexer)))))
749     {
750       struct mtf_file *file = xmalloc (sizeof *file);
751       file->by = NULL;
752       file->handle = NULL;
753       file->reader = NULL;
754       file->dict = NULL;
755       file->in_name = NULL;
756       file->in_var = NULL;
757       file->var_cnt = 0;
758       file->vars = NULL;
759       case_nullify (&file->input);
760
761       if (lex_match_id (lexer, "FILE"))
762         {
763           file->type = MTF_FILE;
764           ll_insert (first_table, &file->ll);
765           mtf.nonempty_files++;
766         }
767       else if (lex_match_id (lexer, "TABLE"))
768         {
769           file->type = MTF_TABLE;
770           ll_push_tail (&mtf.files, &file->ll);
771           if (first_table == ll_null (&mtf.files))
772             first_table = &file->ll;
773         }
774       else
775         NOT_REACHED ();
776       lex_match (lexer, '=');
777
778       if (lex_match (lexer, '*'))
779         {
780           if (!proc_has_active_file (ds))
781             {
782               msg (SE, _("Cannot specify the active file since no active "
783                          "file has been defined."));
784               goto error;
785             }
786
787           if (proc_make_temporary_transformations_permanent (ds))
788             msg (SE,
789                  _("MATCH FILES may not be used after TEMPORARY when "
790                    "the active file is an input source.  "
791                    "Temporary transformations will be made permanent."));
792
793           file->dict = dict_clone (dataset_dict (ds));
794         }
795       else
796         {
797           file->handle = fh_parse (lexer, FH_REF_FILE | FH_REF_SCRATCH);
798           if (file->handle == NULL)
799             goto error;
800
801           file->reader = any_reader_open (file->handle, &file->dict);
802           if (file->reader == NULL)
803             goto error;
804         }
805
806       while (lex_match (lexer, '/'))
807         if (lex_match_id (lexer, "RENAME"))
808           {
809             if (!rename_variables (lexer, file->dict))
810               goto error;
811           }
812         else if (lex_match_id (lexer, "IN"))
813           {
814             lex_match (lexer, '=');
815             if (lex_token (lexer) != T_ID)
816               {
817                 lex_error (lexer, NULL);
818                 goto error;
819               }
820
821             if (file->in_name != NULL)
822               {
823                 msg (SE, _("Multiple IN subcommands for a single FILE or "
824                            "TABLE."));
825                 goto error;
826               }
827             file->in_name = xstrdup (lex_tokid (lexer));
828             lex_get (lexer);
829             saw_in = true;
830           }
831
832       mtf_merge_dictionary (mtf.dict, file);
833     }
834
835   while (lex_token (lexer) != '.')
836     {
837       if (lex_match (lexer, T_BY))
838         {
839           struct mtf_file *file;
840           struct variable **by;
841           bool ok;
842
843           if (mtf.by_cnt)
844             {
845               lex_sbc_only_once ("BY");
846               goto error;
847             }
848
849           lex_match (lexer, '=');
850           if (!parse_variables (lexer, mtf.dict, &by, &mtf.by_cnt,
851                                 PV_NO_DUPLICATE | PV_NO_SCRATCH))
852             goto error;
853
854           ok = true;
855           ll_for_each (file, struct mtf_file, ll, &mtf.files)
856             {
857               size_t i;
858
859               file->by = xnmalloc (mtf.by_cnt, sizeof *file->by);
860               for (i = 0; i < mtf.by_cnt; i++)
861                 {
862                   const char *var_name = var_get_name (by[i]);
863                   file->by[i] = dict_lookup_var (file->dict, var_name);
864                   if (file->by[i] == NULL)
865                     {
866                       if (file->handle != NULL)
867                         msg (SE, _("File %s lacks BY variable %s."),
868                              fh_get_name (file->handle), var_name);
869                       else
870                         msg (SE, _("Active file lacks BY variable %s."),
871                              var_name);
872                       ok = false;
873                     }
874                 }
875             }
876           free (by);
877
878           if (!ok)
879             goto error;
880         }
881       else if (lex_match_id (lexer, "FIRST"))
882         {
883           if (first_name[0] != '\0')
884             {
885               lex_sbc_only_once ("FIRST");
886               goto error;
887             }
888
889           lex_match (lexer, '=');
890           if (!lex_force_id (lexer))
891             goto error;
892           strcpy (first_name, lex_tokid (lexer));
893           lex_get (lexer);
894         }
895       else if (lex_match_id (lexer, "LAST"))
896         {
897           if (last_name[0] != '\0')
898             {
899               lex_sbc_only_once ("LAST");
900               goto error;
901             }
902
903           lex_match (lexer, '=');
904           if (!lex_force_id (lexer))
905             goto error;
906           strcpy (last_name, lex_tokid (lexer));
907           lex_get (lexer);
908         }
909       else if (lex_match_id (lexer, "MAP"))
910         {
911           /* FIXME. */
912         }
913       else if (lex_match_id (lexer, "DROP"))
914         {
915           if (!drop_variables (lexer, mtf.dict))
916             goto error;
917         }
918       else if (lex_match_id (lexer, "KEEP"))
919         {
920           if (!keep_variables (lexer, mtf.dict))
921             goto error;
922         }
923       else
924         {
925           lex_error (lexer, NULL);
926           goto error;
927         }
928
929       if (!lex_match (lexer, '/') && lex_token (lexer) != '.')
930         {
931           lex_end_of_command (lexer);
932           goto error;
933         }
934     }
935
936   if (mtf.by_cnt == 0)
937     {
938       if (first_table != ll_null (&mtf.files))
939         {
940           msg (SE, _("BY is required when TABLE is specified."));
941           goto error;
942         }
943       if (saw_in)
944         {
945           msg (SE, _("BY is required when IN is specified."));
946           goto error;
947         }
948     }
949
950   /* Set up mapping from each file's variables to master
951      variables. */
952   ll_for_each (file, struct mtf_file, ll, &mtf.files)
953     {
954       size_t in_var_cnt = dict_get_var_cnt (file->dict);
955
956       file->vars = xnmalloc (in_var_cnt, sizeof *file->vars);
957       file->var_cnt = 0;
958       for (i = 0; i < in_var_cnt; i++)
959         {
960           struct variable *in_var = dict_get_var (file->dict, i);
961           struct variable *out_var = dict_lookup_var (mtf.dict,
962                                                       var_get_name (in_var));
963
964           if (out_var != NULL)
965             {
966               struct mtf_variable *mv = &file->vars[file->var_cnt++];
967               mv->in_var = in_var;
968               mv->out_var = out_var;
969             }
970         }
971     }
972
973   /* Add IN, FIRST, and LAST variables to master dictionary. */
974   ll_for_each (file, struct mtf_file, ll, &mtf.files)
975     if (!create_flag_var ("IN", file->in_name, mtf.dict, &file->in_var))
976       goto error;
977   if (!create_flag_var ("FIRST", first_name, mtf.dict, &mtf.first)
978       || !create_flag_var ("LAST", last_name, mtf.dict, &mtf.last))
979     goto error;
980
981   dict_delete_scratch_vars (mtf.dict);
982   dict_compact_values (mtf.dict);
983   mtf.output = autopaging_writer_create (dict_get_next_value_idx (mtf.dict));
984   taint = taint_clone (casewriter_get_taint (mtf.output));
985
986   ll_for_each (file, struct mtf_file, ll, &mtf.files)
987     {
988       if (file->reader == NULL)
989         {
990           if (active_file == NULL)
991             {
992               proc_discard_output (ds);
993               file->reader = active_file = proc_open (ds);
994             }
995           else
996             file->reader = casereader_clone (active_file);
997         }
998       taint_propagate (casereader_get_taint (file->reader), taint);
999     }
1000
1001   ll_for_each_safe (file, next, struct mtf_file, ll, &mtf.files)
1002     mtf_read_record (&mtf, file);
1003   while (mtf.nonempty_files > 0)
1004     mtf_process_case (&mtf);
1005   if ((mtf.first != NULL || mtf.last != NULL) && mtf.prev_BY != NULL)
1006     {
1007       if (mtf.last != NULL)
1008         case_data_rw (&mtf.buffered_case, mtf.last)->f = 1.0;
1009       casewriter_write (mtf.output, &mtf.buffered_case);
1010       case_nullify (&mtf.buffered_case);
1011     }
1012   mtf_close_all_files (&mtf);
1013   if (active_file != NULL)
1014     proc_commit (ds);
1015
1016   proc_set_active_file (ds, casewriter_make_reader (mtf.output), mtf.dict);
1017   mtf.dict = NULL;
1018   mtf.output = NULL;
1019
1020   mtf_free (&mtf);
1021
1022   return taint_destroy (taint) ? CMD_SUCCESS : CMD_CASCADING_FAILURE;
1023
1024  error:
1025   if (active_file != NULL)
1026     proc_commit (ds);
1027   mtf_free (&mtf);
1028   taint_destroy (taint);
1029   return CMD_CASCADING_FAILURE;
1030 }
1031
1032 /* If VAR_NAME is a nonnull pointer to a non-empty string,
1033    attempts to create a variable named VAR_NAME, with format
1034    F1.0, in DICT, and stores a pointer to the variable in *VAR.
1035    Returns true if successful, false if the variable name is a
1036    duplicate (in which case a message saying that the variable
1037    specified on the given SUBCOMMAND is a duplicate is emitted).
1038    Also returns true, without doing anything, if VAR_NAME is null
1039    or empty. */
1040 static bool
1041 create_flag_var (const char *subcommand, const char *var_name,
1042                  struct dictionary *dict, struct variable **var)
1043 {
1044   if (var_name != NULL && var_name[0] != '\0')
1045     {
1046       struct fmt_spec format = fmt_for_output (FMT_F, 1, 0);
1047       *var = dict_create_var (dict, var_name, 0);
1048       if (*var == NULL)
1049         {
1050           msg (SE, _("Variable name %s specified on %s subcommand "
1051                      "duplicates an existing variable name."),
1052                subcommand, var_name);
1053           return false;
1054         }
1055       var_set_both_formats (*var, &format);
1056     }
1057   else
1058     *var = NULL;
1059   return true;
1060 }
1061
1062 /* Return a string in an allocated buffer describing V's variable
1063    type and width. */
1064 static char *
1065 var_type_description (struct variable *v)
1066 {
1067   if (var_is_numeric (v))
1068     return xstrdup ("numeric");
1069   else
1070     return xasprintf ("string with width %d", var_get_width (v));
1071 }
1072
1073 /* Closes all the files in MTF and frees their associated data.
1074    Returns true if successful, false if an I/O error occurred on
1075    any of the files. */
1076 static bool
1077 mtf_close_all_files (struct mtf_proc *mtf)
1078 {
1079   struct mtf_file *file;
1080   bool ok = true;
1081
1082   ll_for_each_preremove (file, struct mtf_file, ll, &mtf->files)
1083     {
1084       casereader_destroy (file->reader);
1085       free (file->by);
1086       dict_destroy (file->dict);
1087       free (file->in_name);
1088       case_destroy (&file->input);
1089       free (file->vars);
1090       free (file);
1091     }
1092
1093   return ok;
1094 }
1095
1096 /* Frees all the data for the MATCH FILES procedure. */
1097 static void
1098 mtf_free (struct mtf_proc *mtf)
1099 {
1100   mtf_close_all_files (mtf);
1101   dict_destroy (mtf->dict);
1102   casewriter_destroy (mtf->output);
1103   case_destroy (&mtf->buffered_case);
1104   case_destroy (&mtf->prev_BY_case);
1105 }
1106
1107 /* Reads the next record into FILE, if possible, and update MTF's
1108    nonempty_files count if not. */
1109 static bool
1110 mtf_read_record (struct mtf_proc *mtf, struct mtf_file *file)
1111 {
1112   case_destroy (&file->input);
1113   if (!casereader_read (file->reader, &file->input))
1114     {
1115       mtf->nonempty_files--;
1116       return false;
1117     }
1118   else
1119     return true;
1120 }
1121
1122 /* Compare the BY variables for files A and B; return -1 if A <
1123    B, 0 if A == B, 1 if A > B.  (If there are no BY variables,
1124    then all records are equal.) */
1125 static inline int
1126 mtf_compare_BY_values (struct mtf_proc *mtf,
1127                        struct mtf_file *a, struct mtf_file *b)
1128 {
1129   return case_compare_2dict (&a->input, &b->input, a->by, b->by, mtf->by_cnt);
1130 }
1131
1132 /* Processes input files and write one case to the output file. */
1133 static void
1134 mtf_process_case (struct mtf_proc *mtf)
1135 {
1136   struct ccase c;
1137   struct mtf_file *min;
1138   struct mtf_file *file;
1139   int min_sequence;
1140   size_t i;
1141
1142   /* Find the set of one or more FILEs whose BY values are
1143      minimal, as well as the set of zero or more TABLEs whose BY
1144      values equal those of the minimum FILEs.
1145
1146      After each iteration of the loop, this invariant holds: the
1147      FILEs with minimum BY values thus far have "sequence"
1148      members equal to min_sequence, and "min" points to one of
1149      the mtf_files whose case has those minimum BY values, and
1150      similarly for TABLEs. */
1151   min_sequence = 0;
1152   min = NULL;
1153   ll_for_each (file, struct mtf_file, ll, &mtf->files)
1154     if (case_is_null (&file->input))
1155       file->sequence = -1;
1156     else if (file->type == MTF_FILE)
1157       {
1158         int cmp = min != NULL ? mtf_compare_BY_values (mtf, min, file) : 1;
1159         if (cmp <= 0)
1160           file->sequence = cmp < 0 ? -1 : min_sequence;
1161         else
1162           {
1163             file->sequence = ++min_sequence;
1164             min = file;
1165           }
1166       }
1167     else
1168       {
1169         int cmp;
1170         assert (min != NULL);
1171         do
1172           {
1173             cmp = mtf_compare_BY_values (mtf, min, file);
1174           }
1175         while (cmp > 0 && mtf_read_record (mtf, file));
1176         file->sequence = cmp == 0 ? min_sequence : -1;
1177       }
1178
1179   /* Form the output case from the input cases. */
1180   case_create (&c, dict_get_next_value_idx (mtf->dict));
1181   for (i = 0; i < dict_get_var_cnt (mtf->dict); i++)
1182     {
1183       struct variable *v = dict_get_var (mtf->dict, i);
1184       value_set_missing (case_data_rw (&c, v), var_get_width (v));
1185     }
1186   ll_for_each_reverse (file, struct mtf_file, ll, &mtf->files)
1187     {
1188       bool include_file = file->sequence == min_sequence;
1189       if (include_file)
1190         for (i = 0; i < file->var_cnt; i++)
1191           {
1192             const struct mtf_variable *mv = &file->vars[i];
1193             const union value *in = case_data (&file->input, mv->in_var);
1194             union value *out = case_data_rw (&c, mv->out_var);
1195             value_copy (out, in, var_get_width (mv->in_var));
1196           }
1197       if (file->in_var != NULL)
1198         case_data_rw (&c, file->in_var)->f = include_file;
1199     }
1200
1201   /* Write the output case. */
1202   if (mtf->first == NULL && mtf->last == NULL)
1203     {
1204       /* With no FIRST or LAST variables, it's trivial. */
1205       casewriter_write (mtf->output, &c);
1206     }
1207   else
1208     {
1209       /* It's harder with LAST, because we can't know whether
1210          this case is the last in a group until we've prepared
1211          the *next* case also.  Thus, we buffer the previous
1212          output case until the next one is ready.
1213
1214          We also have to save a copy of one of the previous input
1215          cases, so that we can compare the BY variables.  We
1216          can't compare the BY variables between the current
1217          output case and the saved one because the BY variables
1218          might not be in the output (the user is allowed to drop
1219          them). */
1220       bool new_BY;
1221       if (mtf->prev_BY != NULL)
1222         {
1223           new_BY = case_compare_2dict (&min->input, &mtf->prev_BY_case,
1224                                        min->by, mtf->prev_BY,
1225                                        mtf->by_cnt);
1226           if (mtf->last != NULL)
1227             case_data_rw (&mtf->buffered_case, mtf->last)->f = new_BY;
1228           casewriter_write (mtf->output, &mtf->buffered_case);
1229         }
1230       else
1231         new_BY = true;
1232
1233       case_move (&mtf->buffered_case, &c);
1234       if (mtf->first != NULL)
1235         case_data_rw (&mtf->buffered_case, mtf->first)->f = new_BY;
1236
1237       if (new_BY)
1238         {
1239           mtf->prev_BY = min->by;
1240           case_destroy (&mtf->prev_BY_case);
1241           case_clone (&mtf->prev_BY_case, &min->input);
1242         }
1243     }
1244
1245   /* Read another record from each input file FILE with minimum
1246      values. */
1247   ll_for_each (file, struct mtf_file, ll, &mtf->files)
1248     if (file->type == MTF_FILE)
1249       {
1250         if (file->sequence == min_sequence)
1251           mtf_read_record (mtf, file);
1252       }
1253     else
1254       break;
1255 }
1256
1257 /* Merge the dictionary for file F into master dictionary M. */
1258 static bool
1259 mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
1260 {
1261   struct dictionary *d = f->dict;
1262   const char *d_docs, *m_docs;
1263   int i;
1264
1265   if (dict_get_label (m) == NULL)
1266     dict_set_label (m, dict_get_label (d));
1267
1268   d_docs = dict_get_documents (d);
1269   m_docs = dict_get_documents (m);
1270   if (d_docs != NULL)
1271     {
1272       if (m_docs == NULL)
1273         dict_set_documents (m, d_docs);
1274       else
1275         {
1276           char *new_docs = xasprintf ("%s%s", m_docs, d_docs);
1277           dict_set_documents (m, new_docs);
1278           free (new_docs);
1279         }
1280     }
1281
1282   for (i = 0; i < dict_get_var_cnt (d); i++)
1283     {
1284       struct variable *dv = dict_get_var (d, i);
1285       struct variable *mv = dict_lookup_var (m, var_get_name (dv));
1286
1287       if (dict_class_from_id (var_get_name (dv)) == DC_SCRATCH)
1288         continue;
1289
1290       if (mv != NULL)
1291         {
1292           if (var_get_width (mv) != var_get_width (dv))
1293             {
1294               char *dv_description = var_type_description (dv);
1295               char *mv_description = var_type_description (mv);
1296               msg (SE, _("Variable %s in file %s (%s) has different "
1297                          "type or width from the same variable in "
1298                          "earlier file (%s)."),
1299                    var_get_name (dv), fh_get_name (f->handle),
1300                    dv_description, mv_description);
1301               free (dv_description);
1302               free (mv_description);
1303               return false;
1304             }
1305
1306           if (var_get_width (dv) == var_get_width (mv))
1307             {
1308               if (var_has_value_labels (dv) && !var_has_value_labels (mv))
1309                 var_set_value_labels (mv, var_get_value_labels (dv));
1310               if (var_has_missing_values (dv) && !var_has_missing_values (mv))
1311                 var_set_missing_values (mv, var_get_missing_values (dv));
1312             }
1313
1314           if (var_get_label (dv) && !var_get_label (mv))
1315             var_set_label (mv, var_get_label (dv));
1316         }
1317       else
1318         mv = dict_clone_var_assert (m, dv, var_get_name (dv));
1319     }
1320
1321   return true;
1322 }