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