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