dc2e707d8723217f6780fee14c3f8ac3e0cefed7
[pspp] / src / data-in.c
1 /* PSPP - computes sample statistics.
2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3    Written by Ben Pfaff <blp@gnu.org>.
4
5    This program is free software; you can redistribute it and/or
6    modify it under the terms of the GNU General Public License as
7    published by the Free Software Foundation; either version 2 of the
8    License, or (at your option) any later version.
9
10    This program is distributed in the hope that it will be useful, but
11    WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    General Public License for more details.
14
15    You should have received a copy of the GNU General Public License
16    along with this program; if not, write to the Free Software
17    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
18    02111-1307, USA. */
19
20 #include <config.h>
21 #include <assert.h>
22 #include <math.h>
23 #include <ctype.h>
24 #include <stdarg.h>
25 #include <stddef.h>
26 #include <stdio.h>
27 #include <stdlib.h>
28 #include "data-in.h"
29 #include "error.h"
30 #include "getline.h"
31 #include "julcal/julcal.h"
32 #include "lexer.h"
33 #include "magic.h"
34 #include "misc.h"
35 #include "settings.h"
36 #include "str.h"
37 #include "var.h"
38 \f
39 #undef DEBUGGING
40 /*#define DEBUGGING 1 */
41 #include "debug-print.h"
42
43 \f
44 /* Specialized error routine. */
45
46 static void dls_error (const struct data_in *, const char *format, ...)
47      __attribute__ ((format (printf, 2, 3)));
48
49 static void
50 dls_error (const struct data_in *i, const char *format, ...)
51 {
52   char buf[1024];
53
54   if (i->flags & DI_IGNORE_ERROR)
55     return;
56
57   {
58     va_list args;
59
60     va_start (args, format);
61     snprintf (buf, 1024, format, args);
62     va_end (args);
63   }
64   
65   {
66     struct error e;
67     struct string title;
68
69     ds_init (NULL, &title, 64);
70     if (!getl_reading_script)
71       ds_concat (&title, _("data-file error: "));
72     if (i->f1 == i->f2)
73       ds_printf (&title, _("(column %d"), i->f1);
74     else
75       ds_printf (&title, _("(columns %d-%d"), i->f1, i->f2);
76     ds_printf (&title, _(", field type %s) "), fmt_to_string (&i->format));
77     
78     e.class = DE;
79     err_location (&e.where);
80     e.title = ds_value (&title);
81     e.text = buf;
82
83     err_vmsg (&e);
84
85     ds_destroy (&title);
86   }
87 }
88
89 /* Excludes leading and trailing whitespace from I by adjusting
90    pointers. */
91 static void
92 trim_whitespace (struct data_in *i)
93 {
94   while (i->s < i->e && isspace (i->s[0])) 
95     i->s++;
96
97   while (i->s < i->e && isspace (i->e[-1]))
98     i->e--;
99 }
100
101 /* Returns nonzero if we're not at the end of the string being
102    parsed. */
103 static inline int
104 have_char (struct data_in *i)
105 {
106   return i->s < i->e;
107 }
108 \f
109 /* Format parsers. */ 
110
111 static int parse_int (struct data_in *i, long *result);
112
113 /* This function is based on strtod() from the GNU C library. */
114 static int
115 parse_numeric (struct data_in *i)
116 {
117   short int sign;               /* +1 or -1. */
118   double num;                   /* The number so far.  */
119
120   int got_dot;                  /* Found a decimal point.  */
121   int got_digit;                /* Count of digits.  */
122
123   int decimal;                  /* Decimal point character. */
124   int grouping;                 /* Grouping character. */
125
126   long int exponent;            /* Number's exponent. */
127   int type;                     /* Usually same as i->format.type. */
128
129   trim_whitespace (i);
130
131   type = i->format.type;
132   if (type == FMT_DOLLAR && have_char (i) && *i->s == '$')
133     {
134       i->s++;
135       type = FMT_COMMA;
136     }
137
138   /* Get the sign.  */
139   if (have_char (i))
140     {
141       sign = *i->s == '-' ? -1 : 1;
142       if (*i->s == '-' || *i->s == '+')
143         i->s++;
144     }
145   
146   if (type != FMT_DOT)
147     {
148       decimal = set_decimal;
149       grouping = set_grouping;
150     }
151   else
152     {
153       decimal = set_grouping;
154       grouping = set_decimal;
155     }
156
157   i->v->f = SYSMIS;
158   num = 0.0;
159   got_dot = 0;
160   got_digit = 0;
161   exponent = 0;
162   for (; have_char (i); i->s++)
163     {
164       if (isdigit (*i->s))
165         {
166           got_digit++;
167
168           /* Make sure that multiplication by 10 will not overflow.  */
169           if (num > DBL_MAX * 0.1)
170             /* The value of the digit doesn't matter, since we have already
171                gotten as many digits as can be represented in a `double'.
172                This doesn't necessarily mean the result will overflow.
173                The exponent may reduce it to within range.
174
175                We just need to record that there was another
176                digit so that we can multiply by 10 later.  */
177             ++exponent;
178           else
179             num = (num * 10.0) + (*i->s - '0');
180
181           /* Keep track of the number of digits after the decimal point.
182              If we just divided by 10 here, we would lose precision.  */
183           if (got_dot)
184             --exponent;
185         }
186       else if (!got_dot && *i->s == decimal)
187         /* Record that we have found the decimal point.  */
188         got_dot = 1;
189       else if ((type != FMT_COMMA && type != FMT_DOT) || *i->s != grouping)
190         /* Any other character terminates the number.  */
191         break;
192     }
193
194   if (!got_digit)
195     {
196       if (got_dot)
197         {
198           i->v->f = SYSMIS;
199           return 1;
200         }
201       goto noconv;
202     }
203   
204   if (have_char (i)
205       && (tolower (*i->s) == 'e' || tolower (*i->s) == 'd'
206           || (type == FMT_E && (*i->s == '+' || *i->s == '-'))))
207     {
208       /* Get the exponent specified after the `e' or `E'.  */
209       long exp;
210
211       if (isalpha (*i->s))
212         i->s++;
213       if (!parse_int (i, &exp))
214         goto noconv;
215
216       exponent += exp;
217     }
218   else if (!got_dot)
219     exponent -= i->format.d;
220
221   if (type == FMT_PCT && have_char (i) && *i->s == '%')
222     i->s++;
223   if (i->s < i->e)
224     {
225       dls_error (i, _("Field contents followed by garbage."));
226       i->v->f = SYSMIS;
227       return 0;
228     }
229
230   if (num == 0.0)
231     {
232       i->v->f = 0.0;
233       return 1;
234     }
235
236   /* Multiply NUM by 10 to the EXPONENT power, checking for overflow
237      and underflow.  */
238
239   if (exponent < 0)
240     {
241       if (-exponent + got_digit > -(DBL_MIN_10_EXP) + 5
242           || num < DBL_MIN * pow (10.0, (double) -exponent))
243         goto underflow;
244       num *= pow (10.0, (double) exponent);
245     }
246   else if (exponent > 0)
247     {
248       if (num > DBL_MAX * pow (10.0, (double) -exponent))
249         goto overflow;
250       num *= pow (10.0, (double) exponent);
251     }
252
253   i->v->f = sign * num;
254   return 1;
255
256 overflow:
257   /* Return an overflow error.  */
258   dls_error (i, _("Overflow in floating-point constant."));
259   i->v->f = SYSMIS;
260   return 0;
261
262 underflow:
263   /* Return an underflow error.  */
264   dls_error (i, _("Underflow in floating-point constant."));
265   i->v->f = 0.0;
266   return 0;
267
268 noconv:
269   /* There was no number.  */
270   dls_error (i, _("Field does not form a valid floating-point constant."));
271   i->v->f = SYSMIS;
272   return 0;
273 }
274
275 /* Returns the integer value of hex digit C. */
276 static inline int
277 hexit_value (int c)
278 {
279   const char s[] = "0123456789abcdef";
280   const char *cp = strchr (s, tolower ((unsigned char) c));
281
282   assert (cp != NULL);
283   return cp - s;
284 }
285
286 static inline int
287 parse_N (struct data_in *i)
288 {
289   const unsigned char *cp;
290
291   for (cp = i->s; cp < i->e; cp++)
292     {
293       if (!isdigit (*cp))
294         {
295           dls_error (i, _("All characters in field must be digits."));
296           return 0;
297         }
298
299       i->v->f = i->v->f * 10.0 + *cp - '0';
300     }
301
302   if (i->format.d)
303     i->v->f /= pow (10.0, i->format.d);
304   return 1;
305 }
306
307 static inline int
308 parse_PIBHEX (struct data_in *i)
309 {
310   double n;
311   const unsigned char *cp;
312
313   trim_whitespace (i);
314
315   n = 0.0;
316   for (cp = i->s; cp < i->e; cp++)
317     {
318       if (!isxdigit (*cp))
319         {
320           dls_error (i, _("Unrecognized character in field."));
321           return 0;
322         }
323
324       n = n * 16.0 + hexit_value (*cp);
325     }
326   
327   i->v->f = n;
328   return 1;
329 }
330
331 static inline int
332 parse_RBHEX (struct data_in *i)
333 {
334   /* Validate input. */
335   trim_whitespace (i);
336   if ((i->e - i->s) % 2)
337     {
338       dls_error (i, _("Field must have even length."));
339       return 0;
340     }
341   
342   {
343     const unsigned char *cp;
344     
345     for (cp = i->s; cp < i->e; cp++)
346       if (!isxdigit (*cp))
347         {
348           dls_error (i, _("Field must contain only hex digits."));
349           return 0;
350         }
351   }
352   
353   /* Parse input. */
354   {
355     union
356       {
357         double d;
358         unsigned char c[sizeof (double)];
359       }
360     u;
361
362     int j;
363
364     memset (u.c, 0, sizeof u.c);
365     for (j = 0; j < min ((i->e - i->s) / 2, sizeof u.d); j++)
366       u.c[j] = 16 * hexit_value (i->s[j * 2]) + hexit_value (i->s[j * 2 + 1]);
367
368     i->v->f = u.d;
369   }
370   
371   return 1;
372 }
373
374 static inline int
375 parse_Z (struct data_in *i)
376 {
377   char buf[64];
378
379   /* Warn user that we suck. */
380   {
381     static int warned;
382
383     if (!warned)
384       {
385         msg (MW, _("Quality of zoned decimal (Z) input format code is "
386                    "suspect.  Check your results three times, report bugs "
387                    "to author."));
388         warned = 1;
389       }
390   }
391
392   /* Validate input. */
393   trim_whitespace (i);
394
395   if (i->e - i->s < 2)
396     {
397       dls_error (i, _("Zoned decimal field contains fewer than 2 "
398                       "characters."));
399       return 0;
400     }
401
402   /* Copy sign into buf[0]. */
403   if ((i->e[-1] & 0xc0) != 0xc0)
404     {
405       dls_error (i, _("Bad sign byte in zoned decimal number."));
406       return 0;
407     }
408   buf[0] = (i->e[-1] ^ (i->e[-1] >> 1)) & 0x10 ? '-' : '+';
409
410   /* Copy digits into buf[1 ... len - 1] and terminate string. */
411   {
412     const unsigned char *sp;
413     char *dp;
414
415     for (sp = i->s, dp = buf + 1; sp < i->e - 1; sp++, dp++)
416       if (*sp == '.')
417         *dp = '.';
418       else if ((*sp & 0xf0) == 0xf0 && (*sp & 0xf) < 10)
419         *dp = (*sp & 0xf) + '0';
420       else
421         {
422           dls_error (i, _("Format error in zoned decimal number."));
423           return 0;
424         }
425
426     *dp = '\0';
427   }
428
429   /* Parse as number. */
430   {
431     char *tail;
432     
433     i->v->f = strtod ((char *) buf, (char **) &tail);
434     if ((unsigned char *) tail != i->e)
435       {
436         dls_error (i, _("Error in syntax of zoned decimal number."));
437         return 0;
438       }
439   }
440   
441   return 1;
442 }
443
444 static inline int
445 parse_IB (struct data_in *i)
446 {
447   char buf[64];
448   const char *p;
449
450   unsigned char xor;
451
452   /* We want the data to be in big-endian format.  If this is a
453      little-endian machine, reverse the byte order. */
454 #ifdef WORDS_BIGENDIAN
455   p = i->s;
456 #else
457   memcpy (buf, i->s, i->e - i->s);
458   mm_reverse (buf, i->e - i->s);
459   p = buf;
460 #endif
461
462   /* If the value is negative, we need to logical-NOT each value
463      before adding it. */
464   if (p[0] & 0x80)
465     xor = 0xff;
466   else
467     xor = 0x00;
468   
469   {
470     int j;
471
472     i->v->f = 0.0;
473     for (j = 0; j < i->e - i->s; j++)
474       i->v->f = i->v->f * 256.0 + (p[j] ^ xor);
475   }
476
477   /* If the value is negative, add 1 and set the sign, to complete a
478      two's-complement negation. */
479   if (p[0] & 0x80)
480     i->v->f = -(i->v->f + 1.0);
481
482   if (i->format.d)
483     i->v->f /= pow (10.0, i->format.d);
484
485   return 1;
486 }
487
488 static inline int
489 parse_PIB (struct data_in *i)
490 {
491   int j;
492
493   i->v->f = 0.0;
494 #if WORDS_BIGENDIAN
495   for (j = 0; j < i->e - i->s; j++)
496     i->v->f = i->v->f * 256.0 + i->s[j];
497 #else
498   for (j = i->e - i->s - 1; j >= 0; j--)
499     i->v->f = i->v->f * 256.0 + i->s[j];
500 #endif
501
502   if (i->format.d)
503     i->v->f /= pow (10.0, i->format.d);
504
505   return 1;
506 }
507
508 static inline int
509 parse_P (struct data_in *i)
510 {
511   const unsigned char *cp;
512
513   i->v->f = 0.0;
514   for (cp = i->s; cp < i->e - 1; cp++)
515     {
516       i->v->f = i->v->f * 10 + (*cp >> 4);
517       i->v->f = i->v->f * 10 + (*cp & 15);
518     }
519   i->v->f = i->v->f * 10 + (*cp >> 4);
520   if ((*cp ^ (*cp >> 1)) & 0x10)
521       i->v->f = -i->v->f;
522
523   if (i->format.d)
524     i->v->f /= pow (10.0, i->format.d);
525
526   return 1;
527 }
528
529 static inline int
530 parse_PK (struct data_in *i)
531 {
532   const unsigned char *cp;
533
534   i->v->f = 0.0;
535   for (cp = i->s; cp < i->e; cp++)
536     {
537       i->v->f = i->v->f * 10 + (*cp >> 4);
538       i->v->f = i->v->f * 10 + (*cp & 15);
539     }
540
541   if (i->format.d)
542     i->v->f /= pow (10.0, i->format.d);
543
544   return 1;
545 }
546
547 static inline int
548 parse_RB (struct data_in *i)
549 {
550   union
551     {
552       double d;
553       unsigned char c[sizeof (double)];
554     }
555   u;
556
557   memset (u.c, 0, sizeof u.c);
558   memcpy (u.c, i->s, min ((int) sizeof (u.c), i->e - i->s));
559   i->v->f = u.d;
560
561   return 1;
562 }
563
564 static inline int
565 parse_A (struct data_in *i)
566 {
567   ptrdiff_t len = i->e - i->s;
568   
569   if (len >= i->format.w)
570     memcpy (i->v->s, i->s, i->format.w);
571   else
572     {
573       memcpy (i->v->s, i->s, len);
574       memset (i->v->s + len, ' ', i->format.w - len);
575     }
576
577   return 1;
578 }
579
580 static inline int
581 parse_AHEX (struct data_in *i)
582 {
583   /* Validate input. */
584   trim_whitespace (i);
585   if ((i->e - i->s) % 2)
586     {
587       dls_error (i, _("Field must have even length."));
588       return 0;
589     }
590
591   {
592     const unsigned char *cp;
593     
594     for (cp = i->s; cp < i->e; cp++)
595       if (!isxdigit (*cp))
596         {
597           dls_error (i, _("Field must contain only hex digits."));
598           return 0;
599         }
600   }
601   
602   {
603     int j;
604     
605     /* Parse input. */
606     for (j = 0; j < min (i->e - i->s, i->format.w); j += 2)
607       i->v->s[j / 2] = hexit_value (i->s[j]) * 16 + hexit_value (i->s[j + 1]);
608     memset (i->v->s + (i->e - i->s) / 2, ' ', (i->format.w - (i->e - i->s)) / 2);
609   }
610   
611   return 1;
612 }
613 \f
614 /* Date & time format components. */
615
616 /* Advances *CP past any whitespace characters. */
617 static inline void
618 skip_whitespace (struct data_in *i)
619 {
620   while (isspace ((unsigned char) *i->s))
621     i->s++;
622 }
623
624 static inline int
625 parse_leader (struct data_in *i)
626 {
627   skip_whitespace (i);
628   return 1;
629 }
630
631 static inline int
632 force_have_char (struct data_in *i)
633 {
634   if (have_char (i))
635     return 1;
636
637   dls_error (i, _("Unexpected end of field."));
638   return 0;
639 }
640
641 static int
642 parse_int (struct data_in *i, long *result)
643 {
644   int negative = 0;
645   
646   if (!force_have_char (i))
647     return 0;
648
649   if (*i->s == '+')
650     {
651       i->s++;
652       force_have_char (i);
653     }
654   else if (*i->s == '-')
655     {
656       negative = 1;
657       i->s++;
658       force_have_char (i);
659     }
660   
661   if (!isdigit (*i->s))
662     {
663       dls_error (i, _("Digit expected in field."));
664       return 0;
665     }
666
667   *result = 0;
668   for (;;)
669     {
670       *result = *result * 10 + *i->s++ - '0';
671       if (!have_char (i) || !isdigit (*i->s))
672         break;
673     }
674
675   if (negative)
676     *result = -*result;
677   return 1;
678 }
679
680 static int
681 parse_day (struct data_in *i, long *day)
682 {
683   if (!parse_int (i, day))
684     return 0;
685   if (*day >= 1 && *day <= 31)
686     return 1;
687
688   dls_error (i, _("Day (%ld) must be between 1 and 31."), *day);
689   return 0;
690 }
691
692 static int
693 parse_day_count (struct data_in *i, long *day_count)
694 {
695   return parse_int (i, day_count);
696 }
697
698 static int
699 parse_date_delimiter (struct data_in *i)
700 {
701   int delim = 0;
702
703   while (have_char (i)
704          && (*i->s == '-' || *i->s == '/' || isspace (*i->s)
705              || *i->s == '.' || *i->s == ','))
706     {
707       delim = 1;
708       i->s++;
709     }
710   if (delim)
711     return 1;
712
713   dls_error (i, _("Delimiter expected between fields in date."));
714   return 0;
715 }
716
717 /* Formats NUMBER as Roman numerals in ROMAN, or as Arabic numerals if
718    the Roman expansion would be too long. */
719 static void
720 to_roman (int number, char roman[32])
721 {
722   int save_number = number;
723
724   struct roman_digit
725     {
726       int value;                /* Value corresponding to this digit. */
727       char name;                /* Digit name. */
728     };
729
730   static const struct roman_digit roman_tab[7] =
731   {
732     {1000, 'M'},
733     {500, 'D'},
734     {100, 'C'},
735     {50, 'L'},
736     {10, 'X'},
737     {5, 'V'},
738     {1, 'I'},
739   };
740
741   char *cp = roman;
742
743   int i, j;
744
745   assert (32 >= INT_DIGITS + 1);
746   if (number == 0)
747     goto arabic;
748
749   if (number < 0)
750     {
751       *cp++ = '-';
752       number = -number;
753     }
754
755   for (i = 0; i < 7; i++)
756     {
757       int digit = roman_tab[i].value;
758       while (number >= digit)
759         {
760           number -= digit;
761           if (cp > &roman[30])
762             goto arabic;
763           *cp++ = roman_tab[i].name;
764         }
765
766       for (j = i + 1; j < 7; j++)
767         {
768           if (i == 4 && j == 5) /* VX is not a shortened form of V. */
769             break;
770
771           digit = roman_tab[i].value - roman_tab[j].value;
772           while (number >= digit)
773             {
774               number -= digit;
775               if (cp > &roman[29])
776                 goto arabic;
777               *cp++ = roman_tab[j].name;
778               *cp++ = roman_tab[i].name;
779             }
780         }
781     }
782   *cp = 0;
783   return;
784
785 arabic:
786   sprintf (roman, "%d", save_number);
787 }
788
789 /* Returns true if C is a (lowercase) roman numeral. */
790 #define CHAR_IS_ROMAN(C)                                \
791         ((C) == 'x' || (C) == 'v' || (C) == 'i')
792
793 /* Returns the value of a single (lowercase) roman numeral. */
794 #define ROMAN_VALUE(C)                          \
795         ((C) == 'x' ? 10 : ((C) == 'v' ? 5 : 1))
796
797 static int
798 parse_month (struct data_in *i, long *month)
799 {
800   if (!force_have_char (i))
801     return 0;
802   
803   if (isdigit (*i->s))
804     {
805       if (!parse_int (i, month))
806         return 0;
807       if (*month >= 1 && *month <= 12)
808         return 1;
809       
810       dls_error (i, _("Month (%ld) must be between 1 and 12."), *month);
811       return 0;
812     }
813
814   if (CHAR_IS_ROMAN (tolower (*i->s)))
815     {
816       int last = ROMAN_VALUE (tolower (*i->s));
817
818       *month = 0;
819       for (;;)
820         {
821           int value;
822
823           i->s++;
824           if (!have_char || !CHAR_IS_ROMAN (tolower (*i->s)))
825             {
826               if (last != INT_MAX)
827                 *month += last;
828               break;
829             }
830
831           value = ROMAN_VALUE (tolower (*i->s));
832           if (last == INT_MAX)
833             *month += value;
834           else if (value > last)
835             {
836               *month += value - last;
837               last = INT_MAX;
838             }
839           else
840             {
841               *month += last;
842               last = value;
843             }
844         }
845
846       if (*month < 1 || *month > 12)
847         {
848           char buf[32];
849
850           to_roman (*month, buf);
851           dls_error (i, _("Month (%s) must be between I and XII."), buf);
852           return 0;
853         }
854       
855       return 1;
856     }
857   
858   {
859     static const char *months[12] =
860       {
861         "january", "february", "march", "april", "may", "june",
862         "july", "august", "september", "october", "november", "december",
863       };
864
865     char month_buf[32];
866     char *mp;
867
868     int j;
869
870     for (mp = month_buf;
871          have_char (i) && isalpha (*i->s) && mp < &month_buf[31];
872          i->s++)
873       *mp++ = tolower (*i->s);
874     *mp = '\0';
875
876     if (have_char (i) && isalpha (*i->s))
877       {
878         dls_error (i, _("Month name (%s...) is too long."), month_buf);
879         return 0;
880       }
881
882     for (j = 0; j < 12; j++)
883       if (lex_id_match (months[j], month_buf))
884         {
885           *month = j + 1;
886           return 1;
887         }
888
889     dls_error (i, _("Bad month name (%s)."), month_buf);
890     return 0;
891   }
892 }
893
894 static int
895 parse_year (struct data_in *i, long *year)
896 {
897   if (!parse_int (i, year))
898     return 0;
899   
900   if (*year >= 0 && *year <= 199)
901     *year += 1900;
902   if (*year >= 1582 || *year <= 19999)
903     return 1;
904
905   dls_error (i, _("Year (%ld) must be between 1582 and 19999."), *year);
906   return 0;
907 }
908
909 static int
910 parse_trailer (struct data_in *i)
911 {
912   skip_whitespace (i);
913   if (!have_char (i))
914     return 1;
915   
916   dls_error (i, _("Trailing garbage \"%s\" following date."), i->s);
917   return 0;
918 }
919
920 static int
921 parse_julian (struct data_in *i, long *julian)
922 {
923   if (!parse_int (i, julian))
924     return 0;
925    
926   {
927     int day = *julian % 1000;
928
929     if (day < 1 || day > 366)
930       {
931         dls_error (i, _("Julian day (%d) must be between 1 and 366."), day);
932         return 0;
933       }
934   }
935   
936   {
937     int year = *julian / 1000;
938
939     if (year >= 0 && year <= 199)
940       *julian += 1900000L;
941     else if (year < 1582 || year > 19999)
942       {
943         dls_error (i, _("Year (%d) must be between 1582 and 19999."), year);
944         return 0;
945       }
946   }
947
948   return 1;
949 }
950
951 static int
952 parse_quarter (struct data_in *i, long *quarter)
953 {
954   if (!parse_int (i, quarter))
955     return 0;
956   if (*quarter >= 1 && *quarter <= 4)
957     return 1;
958
959   dls_error (i, _("Quarter (%ld) must be between 1 and 4."), *quarter);
960   return 0;
961 }
962
963 static int
964 parse_q_delimiter (struct data_in *i)
965 {
966   skip_whitespace (i);
967   if (!have_char (i) || tolower (*i->s) != 'q')
968     {
969       dls_error (i, _("`Q' expected between quarter and year."));
970       return 0;
971     }
972   i->s++;
973   skip_whitespace (i);
974   return 1;
975 }
976
977 static int
978 parse_week (struct data_in *i, long *week)
979 {
980   if (!parse_int (i, week))
981     return 0;
982   if (*week >= 1 && *week <= 53)
983     return 1;
984
985   dls_error (i, _("Week (%ld) must be between 1 and 53."), *week);
986   return 0;
987 }
988
989 static int
990 parse_wk_delimiter (struct data_in *i)
991 {
992   skip_whitespace (i);
993   if (i->s + 1 >= i->e
994       || tolower (i->s[0]) != 'w' || tolower (i->s[1]) != 'k')
995     {
996       dls_error (i, _("`WK' expected between week and year."));
997       return 0;
998     }
999   i->s += 2;
1000   skip_whitespace (i);
1001   return 1;
1002 }
1003
1004 static int
1005 parse_time_delimiter (struct data_in *i)
1006 {
1007   int delim = 0;
1008
1009   while (have_char (i)
1010          && (*i->s == ':' || *i->s == '.' || isspace (*i->s)))
1011     {
1012       delim = 1;
1013       i->s++;
1014     }
1015
1016   if (delim)
1017     return 1;
1018   
1019   dls_error (i, _("Delimiter expected between fields in time."));
1020   return 0;
1021 }
1022
1023 static int
1024 parse_hour (struct data_in *i, long *hour)
1025 {
1026   if (!parse_int (i, hour))
1027     return 0;
1028   if (*hour >= 0)
1029     return 1;
1030   
1031   dls_error (i, _("Hour (%ld) must be positive."), *hour);
1032   return 0;
1033 }
1034
1035 static int
1036 parse_minute (struct data_in *i, long *minute)
1037 {
1038   if (!parse_int (i, minute))
1039     return 0;
1040   if (*minute >= 0 && *minute <= 59)
1041     return 1;
1042   
1043   dls_error (i, _("Minute (%ld) must be between 0 and 59."), *minute);
1044   return 0;
1045 }
1046
1047 static int
1048 parse_opt_second (struct data_in *i, double *second)
1049 {
1050   int delim = 0;
1051
1052   char buf[64];
1053   char *cp;
1054
1055   while (have_char (i)
1056          && (*i->s == ':' || *i->s == '.' || isspace (*i->s)))
1057     {
1058       delim = 1;
1059       i->s++;
1060     }
1061   
1062   if (!delim || !isdigit (*i->s))
1063     {
1064       *second = 0.0;
1065       return 1;
1066     }
1067
1068   cp = buf;
1069   while (have_char (i) && isdigit (*i->s))
1070     *cp++ = *i->s++;
1071   if (have_char (i) && *i->s == '.')
1072     *cp++ = *i->s++;
1073   while (have_char (i) && isdigit (*i->s))
1074     *cp++ = *i->s++;
1075   *cp = '\0';
1076   
1077   *second = strtod (buf, NULL);
1078
1079   return 1;
1080 }
1081
1082 static int
1083 parse_hour24 (struct data_in *i, long *hour24)
1084 {
1085   if (!parse_int (i, hour24))
1086     return 0;
1087   if (*hour24 >= 0 && *hour24 <= 23)
1088     return 1;
1089   
1090   dls_error (i, _("Hour (%ld) must be between 0 and 23."), *hour24);
1091   return 0;
1092 }
1093
1094      
1095 static int
1096 parse_weekday (struct data_in *i, int *weekday)
1097 {
1098   /* PORTME */
1099   #define TUPLE(A,B)                            \
1100           (((A) << 8) + (B))
1101
1102   if (i->s + 1 >= i->e)
1103     {
1104       dls_error (i, _("Day of the week expected in date value."));
1105       return 0;
1106     }
1107
1108   switch (TUPLE (tolower (i->s[0]), tolower (i->s[1])))
1109     {
1110     case TUPLE ('s', 'u'):
1111       *weekday = 1;
1112       break;
1113
1114     case TUPLE ('m', 'o'):
1115       *weekday = 2;
1116       break;
1117
1118     case TUPLE ('t', 'u'):
1119       *weekday = 3;
1120       break;
1121
1122     case TUPLE ('w', 'e'):
1123       *weekday = 4;
1124       break;
1125
1126     case TUPLE ('t', 'h'):
1127       *weekday = 5;
1128       break;
1129
1130     case TUPLE ('f', 'r'):
1131       *weekday = 6;
1132       break;
1133
1134     case TUPLE ('s', 'a'):
1135       *weekday = 7;
1136       break;
1137
1138     default:
1139       dls_error (i, _("Day of the week expected in date value."));
1140       return 0;
1141     }
1142
1143   while (have_char (i) && isalpha (*i->s))
1144     i->s++;
1145
1146   return 1;
1147
1148   #undef TUPLE
1149 }
1150
1151 static int
1152 parse_spaces (struct data_in *i)
1153 {
1154   skip_whitespace (i);
1155   return 1;
1156 }
1157
1158 static int
1159 parse_sign (struct data_in *i, int *sign)
1160 {
1161   if (!force_have_char (i))
1162     return 0;
1163
1164   switch (*i->s)
1165     {
1166     case '-':
1167       i->s++;
1168       *sign = 1;
1169       break;
1170
1171     case '+':
1172       i->s++;
1173       /* fall through */
1174
1175     default:
1176       *sign = 0;
1177       break;
1178     }
1179
1180   return 1;
1181 }
1182 \f
1183 /* Date & time formats. */
1184
1185 static int
1186 valid_date (struct data_in *i)
1187 {
1188   if (i->v->f == SYSMIS)
1189     {
1190       dls_error (i, _("Date is not in valid range between "
1191                    "15 Oct 1582 and 31 Dec 19999."));
1192       return 0;
1193     }
1194   else
1195     return 1;
1196 }
1197
1198 static int
1199 parse_DATE (struct data_in *i)
1200 {
1201   long day, month, year;
1202
1203   if (!parse_leader (i)
1204       || !parse_day (i, &day)
1205       || !parse_date_delimiter (i)
1206       || !parse_month (i, &month)
1207       || !parse_date_delimiter (i)
1208       || !parse_year (i, &year)
1209       || !parse_trailer (i))
1210     return 0;
1211
1212   i->v->f = calendar_to_julian (year, month, day);
1213   if (!valid_date (i))
1214     return 0;
1215   i->v->f *= 60. * 60. * 24.;
1216
1217   return 1;
1218 }
1219
1220 static int
1221 parse_ADATE (struct data_in *i)
1222 {
1223   long month, day, year;
1224
1225   if (!parse_leader (i)
1226       || !parse_month (i, &month)
1227       || !parse_date_delimiter (i)
1228       || !parse_day (i, &day)
1229       || !parse_date_delimiter (i)
1230       || !parse_year (i, &year)
1231       || !parse_trailer (i))
1232     return 0;
1233
1234   i->v->f = calendar_to_julian (year, month, day);
1235   if (!valid_date (i))
1236     return 0;
1237   i->v->f *= 60. * 60. * 24.;
1238
1239   return 1;
1240 }
1241
1242 static int
1243 parse_EDATE (struct data_in *i)
1244 {
1245   long month, day, year;
1246
1247   if (!parse_leader (i)
1248       || !parse_day (i, &day)
1249       || !parse_date_delimiter (i)
1250       || !parse_month (i, &month)
1251       || !parse_date_delimiter (i)
1252       || !parse_year (i, &year)
1253       || !parse_trailer (i))
1254     return 0;
1255
1256   i->v->f = calendar_to_julian (year, month, day);
1257   if (!valid_date (i))
1258     return 0;
1259   i->v->f *= 60. * 60. * 24.;
1260
1261   return 1;
1262 }
1263
1264 static int
1265 parse_SDATE (struct data_in *i)
1266 {
1267   long month, day, year;
1268
1269   if (!parse_leader (i)
1270       || !parse_year (i, &year)
1271       || !parse_date_delimiter (i)
1272       || !parse_month (i, &month)
1273       || !parse_date_delimiter (i)
1274       || !parse_day (i, &day)
1275       || !parse_trailer (i))
1276     return 0;
1277
1278   i->v->f = calendar_to_julian (year, month, day);
1279   if (!valid_date (i))
1280     return 0;
1281   i->v->f *= 60. * 60. * 24.;
1282
1283   return 1;
1284 }
1285
1286 static int
1287 parse_JDATE (struct data_in *i)
1288 {
1289   long julian;
1290   
1291   if (!parse_leader (i)
1292       || !parse_julian (i, &julian)
1293       || !parse_trailer (i))
1294     return 0;
1295
1296   if (julian / 1000 == 1582)
1297     i->v->f = calendar_to_julian (1583, 1, 1) - 365;
1298   else
1299     i->v->f = calendar_to_julian (julian / 1000, 1, 1);
1300
1301   if (valid_date (i))
1302     {
1303       i->v->f = (i->v->f + julian % 1000 - 1) * 60. * 60. * 24.;
1304       if (i->v->f < 0.)
1305         i->v->f = SYSMIS;
1306     }
1307
1308   return valid_date (i);
1309 }
1310
1311 static int
1312 parse_QYR (struct data_in *i)
1313 {
1314   long quarter, year;
1315
1316   if (!parse_leader (i)
1317       || !parse_quarter (i, &quarter)
1318       || !parse_q_delimiter (i)
1319       || !parse_year (i, &year)
1320       || !parse_trailer (i))
1321     return 0;
1322
1323   i->v->f = calendar_to_julian (year, (quarter - 1) * 3 + 1, 1);
1324   if (!valid_date (i))
1325     return 0;
1326   i->v->f *= 60. * 60. * 24.;
1327
1328   return 1;
1329 }
1330
1331 static int
1332 parse_MOYR (struct data_in *i)
1333 {
1334   long month, year;
1335
1336   if (!parse_leader (i)
1337       || !parse_month (i, &month)
1338       || !parse_date_delimiter (i)
1339       || !parse_year (i, &year)
1340       || !parse_trailer (i))
1341     return 0;
1342
1343   i->v->f = calendar_to_julian (year, month, 1);
1344   if (!valid_date (i))
1345     return 0;
1346   i->v->f *= 60. * 60. * 24.;
1347
1348   return 1;
1349 }
1350
1351 static int
1352 parse_WKYR (struct data_in *i)
1353 {
1354   long week, year;
1355
1356   if (!parse_leader (i)
1357       || !parse_week (i, &week)
1358       || !parse_wk_delimiter (i)
1359       || !parse_year (i, &year)
1360       || !parse_trailer (i))
1361     return 0;
1362
1363   i->v->f = calendar_to_julian (year, 1, 1);
1364   if (!valid_date (i))
1365     return 0;
1366   i->v->f = (i->v->f + (week - 1) * 7) * 60. * 60. * 24.;
1367
1368   return 1;
1369 }
1370
1371 static int
1372 parse_TIME (struct data_in *i)
1373 {
1374   int sign;
1375   double second;
1376   long hour, minute;
1377
1378   if (!parse_leader (i)
1379       || !parse_sign (i, &sign)
1380       || !parse_spaces (i)
1381       || !parse_hour (i, &hour)
1382       || !parse_time_delimiter (i)
1383       || !parse_minute (i, &minute)
1384       || !parse_opt_second (i, &second))
1385     return 0;
1386
1387   i->v->f = hour * 60. * 60. + minute * 60. + second;
1388   if (sign)
1389     i->v->f = -i->v->f;
1390   return 1;
1391 }
1392
1393 static int
1394 parse_DTIME (struct data_in *i)
1395 {
1396   int sign;
1397   long day_count, hour;
1398   double second;
1399   long minute;
1400
1401   if (!parse_leader (i)
1402       || !parse_sign (i, &sign)
1403       || !parse_spaces (i)
1404       || !parse_day_count (i, &day_count)
1405       || !parse_time_delimiter (i)
1406       || !parse_hour (i, &hour)
1407       || !parse_time_delimiter (i)
1408       || !parse_minute (i, &minute)
1409       || !parse_opt_second (i, &second))
1410     return 0;
1411
1412   i->v->f = (day_count * 60. * 60. * 24.
1413              + hour * 60. * 60.
1414              + minute * 60.
1415              + second);
1416   if (sign)
1417     i->v->f = -i->v->f;
1418   return 1;
1419 }
1420
1421 static int
1422 parse_DATETIME (struct data_in *i)
1423 {
1424   long day, month, year;
1425   long hour24;
1426   double second;
1427   long minute;
1428
1429   if (!parse_leader (i)
1430       || !parse_day (i, &day)
1431       || !parse_date_delimiter (i)
1432       || !parse_month (i, &month)
1433       || !parse_date_delimiter (i)
1434       || !parse_year (i, &year)
1435       || !parse_time_delimiter (i)
1436       || !parse_hour24 (i, &hour24)
1437       || !parse_time_delimiter (i)
1438       || !parse_minute (i, &minute)
1439       || !parse_opt_second (i, &second))
1440     return 0;
1441
1442   i->v->f = calendar_to_julian (year, month, day);
1443   if (!valid_date (i))
1444     return 0;
1445   i->v->f = (i->v->f * 60. * 60. * 24.
1446              + hour24 * 60. * 60.
1447              + minute * 60.
1448              + second);
1449
1450   return 1;
1451 }
1452
1453 static int
1454 parse_WKDAY (struct data_in *i)
1455 {
1456   int weekday;
1457
1458   if (!parse_leader (i)
1459       || !parse_weekday (i, &weekday)
1460       || !parse_trailer (i))
1461     return 0;
1462
1463   i->v->f = weekday;
1464   return 1;
1465 }
1466
1467 static int
1468 parse_MONTH (struct data_in *i)
1469 {
1470   long month;
1471
1472   if (!parse_leader (i)
1473       || !parse_month (i, &month)
1474       || !parse_trailer (i))
1475     return 0;
1476
1477   i->v->f = month;
1478   return 1;
1479 }
1480 \f
1481 /* Main dispatcher. */
1482
1483 static void
1484 default_result (struct data_in *i)
1485 {
1486   const struct fmt_desc *const fmt = &formats[i->format.type];
1487
1488   /* Default to SYSMIS or blanks. */
1489   if (fmt->cat & FCAT_STRING)
1490     memset (i->v->s, ' ', i->format.w);
1491   else
1492     i->v->f = set_blanks;
1493 }
1494
1495 int
1496 data_in (struct data_in *i)
1497 {
1498   const struct fmt_desc *const fmt = &formats[i->format.type];
1499
1500   /* Check that we've got a string to work with. */
1501   if (i->e == i->s || i->format.w <= 0)
1502     {
1503       default_result (i);
1504       return 1;
1505     }
1506
1507   i->f2 = i->f1 + (i->e - i->s) - 1;
1508
1509   /* Make sure that the string isn't too long. */
1510   if (i->format.w > fmt->Imax_w)
1511     {
1512       dls_error (i, _("Field too long (%d characters).  Truncated after "
1513                    "character %d."),
1514                  i->format.w, fmt->Imax_w);
1515       i->format.w = fmt->Imax_w;
1516     }
1517
1518   if (fmt->cat & FCAT_BLANKS_SYSMIS)
1519     {
1520       const unsigned char *cp;
1521
1522       cp = i->s;
1523       for (;;)
1524         {
1525           if (!isspace (*cp))
1526             break;
1527
1528           if (++cp == i->e)
1529             {
1530               i->v->f = set_blanks;
1531               return 1;
1532             }
1533         }
1534     }
1535   
1536   {
1537     static int (*const handlers[FMT_NUMBER_OF_FORMATS])(struct data_in *) = 
1538       {
1539         parse_numeric, parse_N, parse_numeric, parse_numeric,
1540         parse_numeric, parse_numeric, parse_numeric,
1541         parse_Z, parse_A, parse_AHEX, parse_IB, parse_P, parse_PIB,
1542         parse_PIBHEX, parse_PK, parse_RB, parse_RBHEX,
1543         NULL, NULL, NULL, NULL, NULL,
1544         parse_DATE, parse_EDATE, parse_SDATE, parse_ADATE, parse_JDATE,
1545         parse_QYR, parse_MOYR, parse_WKYR,
1546         parse_DATETIME, parse_TIME, parse_DTIME,
1547         parse_WKDAY, parse_MONTH,
1548       };
1549
1550     int (*handler)(struct data_in *);
1551     int success;
1552
1553     handler = handlers[i->format.type];
1554     assert (handler != NULL);
1555
1556     success = handler (i);
1557     if (!success)
1558       default_result (i);
1559
1560     return success;
1561   }
1562 }
1563 \f
1564 /* Utility function. */
1565
1566 /* Sets DI->{s,e} appropriately given that LINE has length LEN and the
1567    field starts at one-based column FC and ends at one-based column
1568    LC, inclusive. */
1569 void
1570 data_in_finite_line (struct data_in *di, const char *line, size_t len,
1571                      int fc, int lc)
1572 {
1573   di->s = line + ((size_t) fc <= len ? fc - 1 : len);
1574   di->e = line + ((size_t) lc <= len ? lc : len);
1575 }