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