1 /*
2 * gretl -- Gnu Regression, Econometrics and Time-series Library
3 * Copyright (C) 2001 Allin Cottrell and Riccardo "Jack" Lucchetti
4 *
5 * This program is free software: you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU 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, see <http://www.gnu.org/licenses/>.
17 *
18 */
19
20 /* interact.c for gretl */
21
22 #include "libgretl.h"
23 #include "monte_carlo.h"
24 #include "var.h"
25 #include "johansen.h"
26 #include "gretl_func.h"
27 #include "compat.h"
28 #include "system.h"
29 #include "forecast.h"
30 #include "cmd_private.h"
31 #include "libset.h"
32 #include "uservar.h"
33 #include "gretl_panel.h"
34 #include "texprint.h"
35 #include "gretl_join.h"
36 #include "gretl_xml.h"
37 #include "gretl_string_table.h"
38 #include "gretl_typemap.h"
39 #include "gretl_midas.h"
40 #include "dbread.h"
41 #include "gretl_foreign.h"
42 #include "boxplots.h"
43 #include "gretl_plot.h"
44 #include "flow_control.h"
45 #include "libglue.h"
46 #include "csvdata.h"
47 #include "gretl_zip.h"
48 #include "matrix_extra.h"
49 #include "addons_utils.h"
50 #ifdef USE_CURL
51 # include "gretl_www.h"
52 #endif
53 #ifdef HAVE_MPI
54 # include "gretl_mpi.h"
55 #endif
56
57 #include <errno.h>
58
59 /* for the "shell" command */
60 #ifdef WIN32
61 # include "gretl_win32.h"
62 #else
63 # ifdef HAVE_PATHS_H
64 # include <paths.h>
65 # endif
66 #endif
67
68 #define CMD_DEBUG 0
69 #define ECHO_DEBUG 0
70
71 #include "tokenize.c"
72
73 #define bare_quote(p,s) (*p == '"' && (p-s==0 || *(p-1) != '\\'))
74 #define starts_comment(p) (*p == '/' && *(p+1) == '*')
75 #define ends_comment(p) (*p == '*' && *(p+1) == '/')
76
77 static int install_function_package (const char *pkgname,
78 gretlopt opt,
79 ExecState *s,
80 PRN *prn);
81
strip_inline_comments(char * s)82 static int strip_inline_comments (char *s)
83 {
84 int ret = 0;
85
86 if (*s == '#') {
87 /* the entire line is a comment */
88 ret = 1;
89 } else if (strstr(s, "#")) {
90 int quoted = 0;
91 int braced = 0;
92 char *p = s;
93
94 while (*p) {
95 if (bare_quote(p, s)) {
96 quoted = !quoted;
97 } else if (!quoted) {
98 if (*p == '{') {
99 braced++;
100 } else if (*p == '}') {
101 braced--;
102 }
103 }
104 if (!quoted && !braced) {
105 if (*p == '#') {
106 *p = '\0';
107 break;
108 }
109 }
110 p++;
111 }
112 }
113
114 return ret;
115 }
116
117 /* filter_comments: strip comments out of line; return non-zero if
118 the whole line is a comment */
119
filter_comments(char * s,CMD * cmd)120 static int filter_comments (char *s, CMD *cmd)
121 {
122 char tmp[MAXLINE];
123 char *p = s;
124 int quoted = 0;
125 int ignore = (cmd->flags & CMD_IGNORE);
126 int j = 0, filt = 0;
127
128 if (strlen(s) >= MAXLINE) {
129 cmd->err = E_TOOLONG;
130 return 0;
131 }
132
133 while (*p) {
134 if (!quoted && !ignore && *p == '#') {
135 break;
136 }
137 if (!ignore && bare_quote(p, s)) {
138 quoted = !quoted;
139 }
140 if (!quoted) {
141 if (starts_comment(p)) {
142 ignore = 1;
143 p += 2;
144 } else if (ends_comment(p)) {
145 if (!ignore) {
146 cmd->err = E_PARSE;
147 return 0;
148 }
149 ignore = 0;
150 p += 2;
151 p += strspn(p, " ");
152 }
153 }
154 if (!ignore && *p != '\r') {
155 tmp[j++] = *p;
156 }
157 if (*p) {
158 p++;
159 }
160 }
161
162 tmp[j] = '\0';
163 strcpy(s, tmp);
164 tailstrip(s);
165
166 if (*s == '\0') {
167 filt = 1;
168 } else if (!ignore) {
169 /* '#' comments */
170 filt = strip_inline_comments(s);
171 tailstrip(s);
172 }
173
174 if (filt) {
175 /* the whole line is a comment */
176 cmd->ci = CMD_COMMENT;
177 }
178
179 if (ignore) {
180 /* the line ends in multi-line comment mode */
181 cmd->flags |= CMD_IGNORE;
182 } else {
183 cmd->flags &= ~CMD_IGNORE;
184 }
185
186 return filt;
187 }
188
189 #define MODIFIES_LIST(c) (c == DIFF || \
190 c == DUMMIFY || \
191 c == LDIFF || \
192 c == SDIFF || \
193 c == LAGS || \
194 c == LOGS || \
195 c == SQUARE || \
196 c == ORTHDEV || \
197 c == STDIZE)
198
has_param(const CMD * cmd)199 static int has_param (const CMD *cmd)
200 {
201 return cmd->param != NULL && *cmd->param != '\0';
202 }
203
204 /* Look for a line with an "implicit genr", such as
205 y = 3*x, x += 10, etc. This is used in nls.c to
206 assess auxiliary genrs in nls, mle, gmm.
207 */
208
plausible_genr_start(const char * s,const DATASET * dset)209 int plausible_genr_start (const char *s, const DATASET *dset)
210 {
211 int ret = 0;
212
213 if (strchr(s, '=') || strstr(s, "++") || strstr(s, "--")) {
214 const char *ok = ".+-*/%^~|=[";
215 char word[VNAMELEN] = {0};
216 char fmt[20];
217
218 sprintf(fmt, "%%%d[^[ .+*/%%^~|=-]", VNAMELEN - 1);
219
220 if (sscanf(s, fmt, word)) {
221 s += strlen(word);
222 while (*s == ' ') s++;
223 if (strspn(s, ok) > 0 && check_identifier(word) == 0) {
224 ret = 1;
225 }
226 }
227 } else if (gretl_type_from_name(s, dset) != 0) {
228 ret = 1;
229 }
230
231 return ret;
232 }
233
ends_foreign_block(const char * s)234 static int ends_foreign_block (const char *s)
235 {
236 s += strspn(s, " \t");
237
238 if (!strncmp(s, "end ", 4)) {
239 s += 3;
240 s += strspn(s, " \t");
241 if (!strncmp(s, "foreign", 7)) {
242 return 1;
243 } else if (!strncmp(s, "mpi", 3)) {
244 return 1;
245 }
246 }
247
248 return 0;
249 }
250
251 /**
252 * parse_command_line:
253 * @s: pointer to execution-state struct.
254 * @cmd: pointer to command struct.
255 * @dset: dataset struct.
256 * @ptr: pointer for use with "compilation" of
257 * conditionals in loops.
258 *
259 * Parses @line and fills out @cmd accordingly.
260 *
261 * Returns: 0 on success, non-zero code on error.
262 */
263
parse_command_line(ExecState * s,DATASET * dset,void * ptr)264 int parse_command_line (ExecState *s, DATASET *dset, void *ptr)
265 {
266 char *line = s->line;
267 CMD *cmd = s->cmd;
268
269 gretl_cmd_clear(cmd);
270 gretl_error_clear();
271
272 #if CMD_DEBUG
273 fprintf(stderr, "parse_command_line: '%s' (nosub=%d)\n",
274 line, cmd_nosub(cmd) ? 1 : 0);
275 #endif
276
277 if (cmd_nosub(cmd)) {
278 cmd->flags &= ~CMD_SUBST;
279 } else {
280 int subst = 0;
281
282 cmd->err = substitute_named_strings(line, &subst);
283 if (cmd->err) {
284 return cmd->err;
285 } else if (subst) {
286 /* record the fact that substitution has been done */
287 cmd->flags |= CMD_SUBST;
288 } else {
289 cmd->flags &= ~CMD_SUBST;
290 }
291 }
292
293 #if CMD_DEBUG
294 if (cmd->flags & CMD_SUBST) {
295 fprintf(stderr, "after substitution: '%s'\n", line);
296 }
297 #endif
298
299 if ((cmd->context == FOREIGN || cmd->context == MPI) &&
300 !ends_foreign_block(line)) {
301 cmd->opt = OPT_NONE;
302 cmd->ci = cmd->context;
303 return 0;
304 }
305
306 if ((cmd->flags & CMD_SUBST) || !gretl_looping_currently()) {
307 /* normalize line spaces */
308 compress_spaces(line);
309
310 /* trap lines that are nothing but comments */
311 if (filter_comments(line, cmd)) {
312 return 0;
313 }
314
315 /* catch errors associated with comment syntax */
316 if (cmd->err) {
317 return cmd->err;
318 }
319 }
320
321 cmd->err = real_parse_command(s, dset, 0, ptr);
322
323 if (cmd->err) {
324 gretl_cmd_destroy_context(cmd);
325 }
326
327 return cmd->err;
328 }
329
330 #ifndef WIN32
331
gretl_shell_async(const char * cmdline,PRN * prn)332 static int gretl_shell_async (const char *cmdline, PRN *prn)
333 {
334 GError *gerr = NULL;
335 gchar **argv = NULL;
336 gint argc = 0;
337 int err = 0;
338
339 g_shell_parse_argv(cmdline, &argc, &argv, &gerr);
340
341 if (gerr == NULL) {
342 g_spawn_async(gretl_workdir(), argv, NULL,
343 G_SPAWN_SEARCH_PATH,
344 NULL, NULL, NULL, &gerr);
345 g_strfreev(argv);
346 }
347
348 if (gerr != NULL) {
349 pprintf(prn, "%s\n", gerr->message);
350 g_error_free(gerr);
351 err = 1;
352 }
353
354 return err;
355 }
356
gretl_shell_sync(const char * arg,gchar ** psout,PRN * prn)357 static int gretl_shell_sync (const char *arg, gchar **psout,
358 PRN *prn)
359 {
360 gchar *sout = NULL;
361 gchar *serr = NULL;
362 GError *gerr = NULL;
363 int status;
364 gchar *argv[5];
365 const char *theshell = getenv("SHELL");
366 const char *namep;
367 char shellnam[40];
368 int err = 0;
369
370 if (theshell == NULL) {
371 #ifdef HAVE_PATHS_H
372 theshell =_PATH_BSHELL;
373 #else
374 theshell = "/bin/sh";
375 #endif
376 }
377
378 namep = strrchr(theshell, '/');
379 if (namep == NULL) {
380 namep = theshell;
381 }
382
383 strcpy(shellnam, "-");
384 strcat(shellnam, ++namep);
385 if (strcmp(namep, "sh") != 0) {
386 shellnam[0] = '+';
387 }
388
389 argv[0] = g_strdup(theshell);
390 argv[1] = shellnam;
391 argv[2] = g_strdup("-c");
392 argv[3] = g_strdup(arg);
393 argv[4] = NULL;
394
395 g_spawn_sync(gretl_workdir(), argv, NULL, 0, NULL, NULL,
396 &sout, &serr, &status, &gerr);
397
398 g_free(argv[0]);
399 g_free(argv[2]);
400 g_free(argv[3]);
401
402 if (gerr != NULL) {
403 if (prn != NULL) {
404 pprintf(prn, "%s\n", gerr->message);
405 } else {
406 gretl_errmsg_set(gerr->message);
407 }
408 g_error_free(gerr);
409 err = 1;
410 }
411
412 if (psout != NULL) {
413 *psout = sout;
414 } else if (sout != NULL) {
415 pputs(prn, sout);
416 g_free(sout);
417 }
418
419 if (serr != NULL) {
420 pputs(prn, serr);
421 g_free(serr);
422 }
423
424 return err;
425 }
426
427 /**
428 * gretl_shell_grab:
429 * @arg: command line to be executed.
430 * @sout: location to receive output from command.
431 *
432 * Calls the shell to execute @arg syncronously and captures the
433 * standard output, if any, in @sout.
434 *
435 * Returns: 0 on successful completion, non-zero on error.
436 */
437
gretl_shell_grab(const char * arg,char ** sout)438 int gretl_shell_grab (const char *arg, char **sout)
439 {
440 /* note: the win32 implementation of gretl_shell_grab()
441 is defined in gretl_win32.c
442 */
443 return gretl_shell_sync(arg, sout, NULL);
444 }
445
gretl_shell(const char * arg,gretlopt opt,PRN * prn)446 static int gretl_shell (const char *arg, gretlopt opt, PRN *prn)
447 {
448 int err = 0;
449
450 if (arg == NULL || *arg == '\0') {
451 return 0;
452 }
453
454 if (!libset_get_bool(SHELL_OK)) {
455 gretl_errmsg_set(_("The shell command is not activated."));
456 return 1;
457 }
458
459 arg += strspn(arg, " \t");
460
461 if (opt & OPT_A) {
462 /* "launch" */
463 err = gretl_shell_async(arg, prn);
464 } else {
465 err = gretl_shell_sync(arg, NULL, prn);
466 }
467
468 return err;
469 }
470
471 #endif /* ! WIN32 */
472
473 #define SAFELEN 78 /* ? */
474
trim_to_length(char * s)475 static void trim_to_length (char *s)
476 {
477 int i, n = strlen(s);
478
479 if (n < SAFELEN - 1) return;
480
481 for (i=n-1; i>0; i--) {
482 if (s[i] == ' ') {
483 s[i] = '\0';
484 break;
485 }
486 }
487 }
488
safe_print_line(const char * line,int * plen,PRN * prn)489 void safe_print_line (const char *line, int *plen, PRN *prn)
490 {
491 char tmp[SAFELEN];
492 const char *q, *p = line;
493 int n, m, rem, out = 0;
494 int len0 = *plen;
495
496 rem = n = strlen(line);
497
498 while (out < n) {
499 *tmp = 0;
500 q = p;
501 strncat(tmp, p, SAFELEN - 1);
502 len0 = 0;
503 trim_to_length(tmp - len0);
504 len0 = 0;
505 m = strlen(tmp);
506 out += m;
507 rem = n - out;
508 p = q + m;
509 if (rem > 0) {
510 pprintf(prn, "%s \\\n ", tmp);
511 *plen = 1;
512 } else {
513 pprintf(prn, "%s", tmp);
514 *plen += m;
515 }
516 }
517 }
518
new_trim_to_length(char * s,int len)519 static void new_trim_to_length (char *s, int len)
520 {
521 int n = strlen(s);
522
523 if (n > len) {
524 int i, quoted = 0;
525 int bp0 = 0, bp1 = 0;
526
527 for (i=1; i<n-1; i++) {
528 if (s[i] == '"' && s[i-1] != '\\') {
529 quoted = !quoted;
530 }
531 if (!quoted && s[i] == ' ') {
532 if (i < len) {
533 bp0 = i;
534 } else {
535 bp1 = i;
536 break;
537 }
538 }
539 }
540 if (bp0 > 0) {
541 s[bp0] = '\0';
542 } else if (bp1 > 0) {
543 s[bp1] = '\0';
544 }
545 }
546 }
547
basic_trim_to_length(char * s,int len)548 static void basic_trim_to_length (char *s, int len)
549 {
550 int n = strlen(s);
551
552 if (n > len) {
553 int i;
554 int bp0 = 0, bp1 = 0;
555
556 for (i=1; i<n-1; i++) {
557 if (s[i] == ' ') {
558 if (i < len) {
559 bp0 = i;
560 } else {
561 bp1 = i;
562 break;
563 }
564 }
565 }
566 if (bp0 > 0) {
567 s[bp0] = '\0';
568 } else if (bp1 > 0) {
569 s[bp1] = '\0';
570 }
571 }
572 }
573
574 #define TESTLEN 256
575 #define LINELEN 70
576
reflow_line(const char * line,const CMD * cmd,const char * leader,PRN * prn)577 static void reflow_line (const char *line, const CMD *cmd,
578 const char *leader, PRN *prn)
579 {
580 int maxline = LINELEN;
581
582 if (leader != NULL) {
583 maxline -= 2;
584 pputs(prn, leader);
585 }
586
587 if (cmd != NULL && (cmd->ciflags & CI_EXPR)) {
588 /* "genr"-type lines: be more generous? */
589 maxline += 10;
590 } else if (gretl_in_gui_mode()) {
591 /* we can handle a little more width */
592 maxline += 4;
593 }
594
595 if (strlen(line) < maxline) {
596 pputs(prn, line);
597 } else {
598 const char *p = line;
599 char buf[TESTLEN];
600 int linenum = 0;
601
602 while (*p) {
603 *buf = '\0';
604 strncat(buf, p, TESTLEN - 1);
605 if (linenum > 0 && leader == NULL) {
606 new_trim_to_length(buf, maxline - 2);
607 } else {
608 new_trim_to_length(buf, maxline);
609 }
610 p += strlen(buf);
611 if (!string_is_blank(buf)) {
612 if (linenum > 0) {
613 pputs(prn, " ");
614 }
615 pputs(prn, (*buf == ' ')? buf + 1 : buf);
616 if (*p) {
617 pputs(prn, " \\\n");
618 }
619 }
620 linenum++;
621 }
622 }
623 }
624
command_is_silent(const CMD * cmd,const char * line)625 static int command_is_silent (const CMD *cmd, const char *line)
626 {
627 if (cmd == NULL) {
628 return 0;
629 }
630
631 if (cmd->ci == FUNCERR || cmd->ci == PRINTF ||
632 (cmd->ci == PRINT && strchr(line, '"'))) {
633 return 1;
634 }
635
636 if (!strcmp(line, "set echo off") ||
637 !strcmp(line, "set verbose off") ||
638 !strcmp(line, "flush")) {
639 return 1;
640 }
641
642 if (!strncmp(line, "quit", 4) && string_is_blank(line + 4)) {
643 return 1;
644 }
645
646 if (cmd->ci == SET && cmd->param != NULL &&
647 !strcmp(cmd->param, "echo") &&
648 gretl_function_depth() > 0) {
649 return 1;
650 }
651
652 if ((cmd->ci == OUTFILE && cmd->opt == OPT_C) ||
653 (cmd->ci == END && cmd->param != NULL &&
654 !strcmp(cmd->param, "outfile"))) {
655 return 1;
656 }
657
658 if (*line == '!') {
659 return 1;
660 }
661
662 return 0;
663 }
664
665 /*
666 * real_echo_command:
667 * @cmd: pointer to #CMD struct.
668 * @line: "raw" command line associated with @cmd.
669 * @recording: echo is going to command log (0/1).
670 * @prn: pointer to gretl printing struct.
671 *
672 * Echoes the user command represented by @cmd and @line to
673 * @prn. This is used for two distinct purposes: to give
674 * visual feedback on the command supplied, and (in some
675 * contexts) to record a command that was executed interactively.
676 */
677
real_echo_command(CMD * cmd,const char * line,int recording,PRN * prn)678 static void real_echo_command (CMD *cmd, const char *line,
679 int recording, PRN *prn)
680 {
681 const char *leader = NULL;
682 int commented_store = 0;
683 int compiling = 0;
684
685 if (line == NULL || *line == '\0' || prn == NULL) {
686 return;
687 }
688
689 if (cmd != NULL && cmd->ci >= NC) {
690 return;
691 }
692
693 if (gretl_compiling_function() || gretl_compiling_loop()) {
694 compiling = 1;
695 }
696
697 #if ECHO_DEBUG
698 if (cmd != NULL) {
699 fprintf(stderr, "echo_cmd:\n*** line='%s'\n param='%s' parm2='%s'\n",
700 line, cmd->param, cmd->parm2);
701 fprintf(stderr, " cmd->opt=%d, recording=%d, compiling=%d\n",
702 cmd->opt, recording, compiling);
703 fprintf(stderr, " cmd->ci = %d (%s), context = %d\n", cmd->ci,
704 gretl_command_word(cmd->ci), cmd->context);
705 fprintf(stderr, " cmd->savename = '%s'\n", cmd->savename);
706 if (cmd->list != NULL) {
707 printlist(cmd->list, "cmd->list");
708 }
709 }
710 #endif
711
712 /* certain things don't get echoed at all, if not recording or
713 compiling a function or loop */
714 if (!recording && !compiling && command_is_silent(cmd, line)) {
715 #if ECHO_DEBUG
716 fprintf(stderr, " silent: no echo\n");
717 #endif
718 return;
719 }
720
721 /* print leading string before echo? */
722 if (recording) {
723 if (cmd != NULL && cmd->ci == STORE) {
724 commented_store = 1;
725 }
726 } else if (compiling) {
727 leader = "> ";
728 } else {
729 leader = "? ";
730 }
731
732 if (commented_store) {
733 pputs(prn, "# ");
734 pputs(prn, line);
735 } else if (cmd != NULL && (cmd->context == FOREIGN || cmd->context == MPI)) {
736 if (leader != NULL) {
737 pputs(prn, leader);
738 }
739 pputs(prn, line);
740 } else {
741 reflow_line(line, cmd, leader, prn);
742 }
743
744 pputc(prn, '\n');
745
746 gretl_print_flush_stream(prn);
747 }
748
gretl_echo_command(CMD * cmd,const char * line,PRN * prn)749 void gretl_echo_command (CMD *cmd, const char *line, PRN *prn)
750 {
751 real_echo_command(cmd, line, 0, prn);
752 }
753
gretl_record_command(CMD * cmd,const char * line,PRN * prn)754 void gretl_record_command (CMD *cmd, const char *line, PRN *prn)
755 {
756 real_echo_command(cmd, line, 1, prn);
757 }
758
set_var_info(const int * list,const char * parm1,const char * parm2,gretlopt opt,DATASET * dset)759 static int set_var_info (const int *list,
760 const char *parm1,
761 const char *parm2,
762 gretlopt opt,
763 DATASET *dset)
764 {
765 int vi, v = list[1];
766 int i, err = 0;
767
768 if (dset == NULL || dset->varinfo == NULL) {
769 return E_NODATA;
770 } else if (v <= 0 || v >= dset->v) {
771 return E_DATA;
772 }
773
774 if (opt & OPT_M) {
775 err = gretl_list_set_midas(list, dset);
776 if (err) {
777 return err;
778 }
779 }
780
781 for (i=1; i<=list[0]; i++) {
782 vi = list[i];
783 if (opt & OPT_D) {
784 series_set_discrete(dset, vi, 1);
785 } else if (opt & OPT_C) {
786 series_set_discrete(dset, vi, 0);
787 }
788 if (opt & OPT_F) {
789 /* --coded */
790 int ivals = series_is_integer_valued(dset, vi);
791 int isdum = gretl_isdummy(0, dset->n - 1, dset->Z[vi]);
792
793 if (ivals && !isdum) {
794 series_set_flag(dset, vi, VAR_CODED);
795 } else {
796 gretl_errmsg_sprintf("%s cannot be set as 'coded' (%s)",
797 dset->varname[vi], ivals ?
798 _("is a 0/1 variable") :
799 _("not integer-valued"));
800 err = E_TYPES;
801 }
802 } else if (opt & OPT_N) {
803 /* -- numeric (i.e. not-coded) */
804 series_unset_flag(dset, vi, VAR_CODED);
805 }
806 }
807
808 if (err) {
809 return err;
810 }
811
812 /* below: we'll accept multi-series lists, but the
813 string-setting facility will apply to just the
814 first member, as "representative" of the list
815 */
816
817 if (opt & OPT_I) {
818 const char *s = get_optval_string(SETINFO, OPT_I);
819
820 if (s == NULL) {
821 err = E_ARGS;
822 } else {
823 series_record_label(dset, v, s);
824 }
825 } else if (parm1 != NULL) {
826 /* backward compatibility */
827 series_record_label(dset, v, parm1);
828 }
829
830 if (opt & OPT_G) {
831 const char *s = get_optval_string(SETINFO, OPT_G);
832
833 if (s == NULL) {
834 err = E_ARGS;
835 } else {
836 series_record_display_name(dset, v, s);
837 }
838 } else if (parm2 != NULL) {
839 /* backward compatibility */
840 series_record_display_name(dset, v, parm2);
841 }
842
843 return err;
844 }
845
reflow_label(const char * line,PRN * prn)846 static void reflow_label (const char *line, PRN *prn)
847 {
848 int maxline = 72;
849
850 if (strlen(line) < maxline) {
851 pputc(prn, ' ');
852 pputs(prn, line);
853 pputc(prn, '\n');
854 } else {
855 const char *p = line;
856 char buf[TESTLEN];
857 int lnum = 0;
858
859 while (*p) {
860 *buf = '\0';
861 strncat(buf, p, TESTLEN - 1);
862 if (lnum == 1) {
863 maxline -= 2;
864 }
865 basic_trim_to_length(buf, maxline);
866 p += strlen(buf);
867 if (!string_is_blank(buf)) {
868 if (lnum == 0) {
869 pputc(prn, ' ');
870 } else {
871 pputs(prn, " ");
872 }
873 pputs(prn, (*buf == ' ')? buf + 1 : buf);
874 pputc(prn, '\n');
875 } else {
876 pputc(prn, '\n');
877 }
878 lnum++;
879 }
880 }
881 }
882
showlabels(const int * list,gretlopt opt,const DATASET * dset,PRN * prn)883 static void showlabels (const int *list, gretlopt opt,
884 const DATASET *dset, PRN *prn)
885 {
886 const char *label;
887 gchar *tmp;
888 int i, v, vmax, nl = 0;
889
890 if (dset == NULL || dset->v == 0) {
891 pprintf(prn, _("No series are defined\n"));
892 return;
893 }
894
895 vmax = list == NULL ? dset->v - 1 : list[0];
896
897 for (i=1; i<=vmax; i++) {
898 v = list == NULL ? i : list[i];
899 if (v >= 0 && v < dset->v) {
900 label = series_get_label(dset, v);
901 if (label != NULL && *label != '\0') {
902 nl++;
903 }
904 }
905 }
906
907 if (nl == 0) {
908 pprintf(prn, _("No series labels are defined\n"));
909 return;
910 }
911
912 pputc(prn, '\n');
913 for (i=1; i<=vmax; i++) {
914 v = list == NULL ? i : list[i];
915 if (v >= 0 && v < dset->v) {
916 label = series_get_label(dset, v);
917 if (label != NULL && *label != '\0') {
918 if (opt & OPT_Q) {
919 pprintf(prn, "%s: %s\n", dset->varname[v], label);
920 } else {
921 tmp = g_strdup_printf("%s: %s", dset->varname[v], label);
922 reflow_label(tmp, prn);
923 g_free(tmp);
924 }
925 }
926 }
927 }
928 pputc(prn, '\n');
929 }
930
outfile_redirect(PRN * prn,FILE * fp,const char * strvar,const char * fname,gretlopt opt,int * parms)931 static int outfile_redirect (PRN *prn, FILE *fp, const char *strvar,
932 const char *fname, gretlopt opt,
933 int *parms)
934 {
935 int err;
936
937 err = print_start_redirection(prn, fp, fname, strvar);
938 if (err) {
939 return err;
940 }
941
942 if (opt & OPT_Q) {
943 parms[0] = gretl_echo_on();
944 parms[1] = gretl_messages_on();
945 set_gretl_echo(0);
946 set_gretl_messages(0);
947 } else {
948 parms[0] = parms[1] = -1;
949 }
950
951 return 0;
952 }
953
maybe_restore_vparms(int * parms)954 static void maybe_restore_vparms (int *parms)
955 {
956 if (parms[0] == 1) {
957 set_gretl_echo(1);
958 }
959 if (parms[1] == 1) {
960 set_gretl_messages(1);
961 }
962 parms[0] = parms[1] = -1;
963 }
964
cwd_is_workdir(void)965 static int cwd_is_workdir (void)
966 {
967 gchar *thisdir = g_get_current_dir();
968 int ret = 0;
969
970 if (thisdir != NULL) {
971 int n = strlen(thisdir);
972
973 ret = (strncmp(thisdir, gretl_workdir(), n) == 0);
974 g_free(thisdir);
975 }
976
977 return ret;
978 }
979
redirection_ok(PRN * prn)980 static int redirection_ok (PRN *prn)
981 {
982 int fd = gretl_function_depth();
983
984 if (fd == 0) {
985 return 0;
986 } else if (print_redirected_at_level(prn, fd)) {
987 /* we may want to lift this ban in future? */
988 return 0;
989 } else {
990 return 1;
991 }
992 }
993
outname_check(const char * name,int backward,const DATASET * dset)994 static int outname_check (const char *name, int backward,
995 const DATASET *dset)
996 {
997 GretlType t = gretl_type_from_name(name, dset);
998 int err = 0;
999
1000 if (t != GRETL_TYPE_NONE && t != GRETL_TYPE_STRING) {
1001 err = E_TYPES;
1002 } else if (t == GRETL_TYPE_NONE) {
1003 if (backward) {
1004 /* compatibility: create the variable if possible */
1005 err = check_identifier(name);
1006 if (!err) {
1007 err = create_user_var(name, GRETL_TYPE_STRING);
1008 }
1009 } else {
1010 /* we now require that the variable already exists */
1011 gretl_errmsg_sprintf(_("'%s' : not a string variable"), name);
1012 err = E_DATA;
1013 }
1014 }
1015
1016 return err;
1017 }
1018
1019 /* We come here in the --tempfile and --buffer cases of
1020 "outfile". The @strvar argument, which names a string
1021 variable, plays a different role in each case: with
1022 --tempfile (OPT_T) the variable should get as its
1023 value the _name_ of the temporary file, but with --buffer
1024 (OPT_B) it should get the _content_ of that file when
1025 redirection ends. We accomplish the former effect here,
1026 but arrange for the latter effect by passing @strvar
1027 to outfile_redirect().
1028 */
1029
redirect_to_tempfile(const char * strvar,PRN * prn,gretlopt opt,int * vparms)1030 static int redirect_to_tempfile (const char *strvar, PRN *prn,
1031 gretlopt opt, int *vparms)
1032 {
1033 gchar *tempname = NULL;
1034 FILE *fp = NULL;
1035 int err = 0;
1036
1037 tempname = gretl_make_dotpath("outfile.XXXXXX");
1038 if (opt & OPT_B) {
1039 fp = gretl_mktemp(tempname, "wb+");
1040 } else {
1041 fp = gretl_mktemp(tempname, "wb");
1042 }
1043
1044 if (fp == NULL) {
1045 err = E_FOPEN;
1046 } else if (opt & OPT_B) {
1047 err = outfile_redirect(prn, fp, strvar, tempname, opt, vparms);
1048 } else {
1049 err = outfile_redirect(prn, fp, NULL, tempname, opt, vparms);
1050 }
1051 if (!err && (opt & OPT_T)) {
1052 /* write the tempfile name into strvar */
1053 user_string_reset(strvar, tempname, &err);
1054 if (err) {
1055 fclose(fp);
1056 }
1057 }
1058
1059 g_free(tempname);
1060
1061 return err;
1062 }
1063
maybe_get_string_name(gretlopt opt)1064 static const char *maybe_get_string_name (gretlopt opt)
1065 {
1066 if (opt & (OPT_B | OPT_T)) {
1067 gretlopt active = (opt & OPT_T)? OPT_T : OPT_B;
1068
1069 return get_optval_string(OUTFILE, active);
1070 } else {
1071 return NULL;
1072 }
1073 }
1074
1075 static int
do_outfile_command(gretlopt opt,const char * fname,const DATASET * dset,PRN * prn)1076 do_outfile_command (gretlopt opt, const char *fname,
1077 const DATASET *dset, PRN *prn)
1078 {
1079 static char savename[MAXLEN];
1080 static int vparms[2];
1081 const char *strvar = NULL;
1082 const char *check = NULL;
1083 int rlevel = 0;
1084 int err = 0;
1085
1086 if (prn == NULL) {
1087 return 0;
1088 }
1089
1090 /* make --write the default in the absence of a
1091 contrary option (--append or --close)
1092 */
1093 if (!(opt & (OPT_A | OPT_C))) {
1094 opt |= OPT_W;
1095 }
1096
1097 /* allow at most one of --append, --buffer, --tempfile, --close */
1098 err = incompatible_options(opt, (OPT_A | OPT_B | OPT_T | OPT_C));
1099 if (err) {
1100 return err;
1101 }
1102
1103 rlevel = print_redirection_level(prn);
1104
1105 if (opt & OPT_C) {
1106 /* command to close outfile */
1107 if (rlevel == 0) {
1108 pputs(prn, _("Output is not currently diverted to file\n"));
1109 err = 1;
1110 } else {
1111 print_end_redirection(prn);
1112 maybe_restore_vparms(vparms);
1113 if (gretl_messages_on() && *savename != '\0') {
1114 pprintf(prn, _("Closed output file '%s'\n"), savename);
1115 }
1116 }
1117 return err;
1118 }
1119
1120 /* pre-check: in the buffer or tempfile cases, did we
1121 get a string-name attached to the option flag?
1122 */
1123 strvar = maybe_get_string_name(opt);
1124 check = strvar != NULL ? strvar : fname;
1125
1126 /* below: diverting output to a file or buffer: first
1127 check that this is feasible */
1128
1129 if (check == NULL || *check == '\0') {
1130 return E_ARGS;
1131 } else if (rlevel > 0 && !redirection_ok(prn)) {
1132 gretl_errmsg_sprintf(_("Output is already diverted to '%s'"),
1133 savename);
1134 return 1;
1135 }
1136
1137 /* Handle the cases where we're going via a temporary
1138 file (and the @fname that was passed in is really the
1139 name of a string variable).
1140 */
1141 if (opt & (OPT_B | OPT_T)) {
1142 int backward = 0;
1143
1144 if (strvar == NULL) {
1145 /* backward compatibility */
1146 strvar = fname;
1147 backward = 1;
1148 }
1149 err = outname_check(strvar, backward, dset);
1150 if (!err) {
1151 err = redirect_to_tempfile(strvar, prn, opt, vparms);
1152 }
1153 *savename = '\0';
1154 return err; /* we're done */
1155 }
1156
1157 /* Handle the remaining file-based cases */
1158
1159 if (!strcmp(fname, "null")) {
1160 if (gretl_messages_on()) {
1161 pputs(prn, _("Now discarding output\n"));
1162 }
1163 err = outfile_redirect(prn, NULL, NULL, "null", opt, vparms);
1164 *savename = '\0';
1165 } else if (!strcmp(fname, "stderr")) {
1166 err = outfile_redirect(prn, stderr, NULL, "stderr", opt, vparms);
1167 *savename = '\0';
1168 } else if (!strcmp(fname, "stdout")) {
1169 err = outfile_redirect(prn, stdout, NULL, "stdout", opt, vparms);
1170 *savename = '\0';
1171 } else {
1172 /* Should the stream be opened in binary mode on Windows?
1173 2020-12-12: it seems this may be better.
1174 */
1175 char outname[FILENAME_MAX];
1176 const char *targ;
1177 FILE *fp;
1178
1179 /* switch to workdir if needed */
1180 strcpy(outname, fname);
1181 gretl_maybe_prepend_dir(outname);
1182 if (opt & OPT_A) {
1183 /* appending */
1184 fp = gretl_fopen(outname, "ab");
1185 } else {
1186 /* writing */
1187 fp = gretl_fopen(outname, "wb");
1188 }
1189
1190 if (fp == NULL) {
1191 pprintf(prn, _("Couldn't open %s for writing\n"), outname);
1192 return E_FOPEN;
1193 }
1194
1195 /* string to identify the output stream for display */
1196 targ = cwd_is_workdir() ? fname : outname;
1197
1198 if (gretl_messages_on()) {
1199 /* print message before actual redirection! */
1200 if (opt & OPT_A) {
1201 pprintf(prn, _("Now appending output to '%s'\n"), targ);
1202 } else {
1203 pprintf(prn, _("Now writing output to '%s'\n"), targ);
1204 }
1205 }
1206
1207 err = outfile_redirect(prn, fp, NULL, targ, opt, vparms);
1208 if (err) {
1209 fclose(fp);
1210 remove(outname);
1211 } else {
1212 strcpy(savename, targ);
1213 }
1214 }
1215
1216 return err;
1217 }
1218
call_pca_plugin(VMatrix * cmat,DATASET * dset,gretlopt opt,PRN * prn)1219 int call_pca_plugin (VMatrix *cmat, DATASET *dset,
1220 gretlopt opt, PRN *prn)
1221 {
1222 int (*pca_from_cmatrix) (VMatrix *, DATASET *,
1223 gretlopt, PRN *);
1224
1225 gretl_error_clear();
1226
1227 pca_from_cmatrix = get_plugin_function("pca_from_cmatrix");
1228 if (pca_from_cmatrix == NULL) {
1229 return 1;
1230 }
1231
1232 return (*pca_from_cmatrix) (cmat, dset, opt, prn);
1233 }
1234
do_pca(int * list,DATASET * dset,gretlopt opt,PRN * prn)1235 static int do_pca (int *list, DATASET *dset,
1236 gretlopt opt, PRN *prn)
1237 {
1238 int freelist = 0;
1239 int err = 0;
1240
1241 if (list != NULL && list[0] == 0) {
1242 return 0;
1243 }
1244
1245 if (list == NULL) {
1246 list = full_var_list(dset, NULL);
1247 freelist = 1;
1248 }
1249
1250 if (list != NULL) {
1251 VMatrix *cmat = NULL;
1252
1253 /* adding OPT_U ensures a uniform sample for the
1254 correlation or covariance matrix */
1255 cmat = corrlist(PCA, list, dset, opt, &err);
1256 if (!err) {
1257 err = call_pca_plugin(cmat, dset, opt, prn);
1258 if (!err && (opt & (OPT_O | OPT_A))) {
1259 /* results saved as series */
1260 if (gretl_messages_on()) {
1261 pputs(prn, "Generated principal component series\n");
1262 }
1263 }
1264 free_vmatrix(cmat);
1265 }
1266 if (freelist) {
1267 free(list);
1268 }
1269 }
1270
1271 return err;
1272 }
1273
query_package(const char * pkgname,gretlopt opt,PRN * prn)1274 static void query_package (const char *pkgname,
1275 gretlopt opt, PRN *prn)
1276 {
1277 char path[MAXLEN];
1278 fnpkg *pkg = NULL;
1279 int err = 0;
1280
1281 pkg = get_function_package_by_name(pkgname);
1282
1283 if (pkg != NULL) {
1284 const char *p = function_package_get_string(pkg, "fname");
1285
1286 strcpy(path, p);
1287 } else if (has_suffix(pkgname, ".gfn")) {
1288 err = get_full_filename(pkgname, path, OPT_I);
1289 } else {
1290 gchar *gfn = g_strdup_printf("%s.gfn", pkgname);
1291
1292 err = get_full_filename(gfn, path, OPT_I);
1293 g_free(gfn);
1294 }
1295
1296 if (opt & OPT_Q) {
1297 /* --quiet */
1298 gretl_bundle *b = gretl_bundle_new();
1299
1300 if (b != NULL) {
1301 if (!err) {
1302 bundle_function_package_info(path, b);
1303 }
1304 set_last_result_data(b, GRETL_TYPE_BUNDLE);
1305 }
1306 } else {
1307 if (err) {
1308 pprintf(prn, "%s: not found\n\n", pkgname);
1309 } else {
1310 print_function_package_info(path, 0, prn);
1311 }
1312 }
1313 }
1314
do_pkg_command(const char * action,const char * pkgname,gretlopt opt,ExecState * s,PRN * prn)1315 static int do_pkg_command (const char *action,
1316 const char *pkgname,
1317 gretlopt opt,
1318 ExecState *s,
1319 PRN *prn)
1320 {
1321 int err = 0;
1322
1323 if (!strcmp(action, "install")) {
1324 err = install_function_package(pkgname, opt, s, prn);
1325 } else if (!strcmp(action, "unload")) {
1326 err = uninstall_function_package(pkgname, OPT_NONE, prn);
1327 } else if (!strcmp(action, "remove")) {
1328 err = uninstall_function_package(pkgname, OPT_P, prn);
1329 } else if (!strcmp(action, "query")) {
1330 query_package(pkgname, opt, prn);
1331 } else if (!strcmp(action, "index") && !strcmp(pkgname, "addons")) {
1332 update_addons_index((opt & OPT_V)? prn : NULL);
1333 } else {
1334 gretl_errmsg_sprintf("pkg: unknown action '%s'", action);
1335 err = E_PARSE;
1336 }
1337
1338 return err;
1339 }
1340
print_info(gretlopt opt,DATASET * dset,PRN * prn)1341 static void print_info (gretlopt opt, DATASET *dset, PRN *prn)
1342 {
1343 if (dset != NULL && dset->descrip != NULL) {
1344 pprintf(prn, "%s\n", dset->descrip);
1345 } else {
1346 pputs(prn, _("No data information is available.\n"));
1347 }
1348 }
1349
1350 /* After estimating a model, check its errcode member to see
1351 if anything went wrong, and reset gretl_errno to zero.
1352
1353 If we're looping (that is, if a loop is in progress at the
1354 current level of function execution) and @loop_force is 0,
1355 that's all, but if not then:
1356
1357 (a) print the model (this may require special handling inside
1358 loops);
1359
1360 (b) if the user has employed the "name <- command" mechanism,
1361 attach the supplied name to the model;
1362
1363 (c) conditionally add the model to the stack in objstack.c,
1364 and if this is done, signal the fact by setting the 'pmod'
1365 member of @ExecState.
1366
1367 (d) if we're called by the GUI program and the model has
1368 been assigned a name, activate the callback that adds the
1369 model to the GUI session.
1370 */
1371
print_save_model(MODEL * pmod,DATASET * dset,gretlopt opt,int loop_force,PRN * prn,ExecState * s)1372 static int print_save_model (MODEL *pmod, DATASET *dset,
1373 gretlopt opt, int loop_force,
1374 PRN *prn, ExecState *s)
1375 {
1376 int err = pmod->errcode;
1377
1378 if (!err) {
1379 set_gretl_errno(0);
1380 if (!gretl_looping_currently() || loop_force) {
1381 int havename = *s->cmd->savename != '\0';
1382 int window = (opt & OPT_W) != 0;
1383 gretlopt popt;
1384
1385 if (havename) {
1386 gretl_model_set_name(pmod, s->cmd->savename);
1387 }
1388
1389 popt = get_printmodel_opt(pmod, opt);
1390 printmodel(pmod, dset, popt, prn);
1391 attach_subsample_to_model(pmod, dset);
1392 s->pmod = maybe_stack_model(pmod, s->cmd, prn, &err);
1393 if (!err && gretl_in_gui_mode() && s->callback != NULL &&
1394 (havename || window)) {
1395 if (s->pmod != NULL && (opt & OPT_Q) && !window) {
1396 /* With OPT_Q (--quiet) and without the --window
1397 flag, this model will not have a unique ID;
1398 but that will be needed if it's going to be
1399 a fully fledged gui model, as requested by
1400 its having been given a "savename".
1401 */
1402 set_model_id(s->pmod, OPT_NONE);
1403 }
1404 s->callback(s, s->pmod, GRETL_OBJ_EQN);
1405 }
1406 }
1407 }
1408
1409 return err;
1410 }
1411
save_var_vecm(ExecState * s)1412 static void save_var_vecm (ExecState *s)
1413 {
1414 maybe_stack_var(s->var, s->cmd);
1415
1416 if (gretl_in_gui_mode() && s->callback != NULL) {
1417 int havename = *s->cmd->savename != '\0';
1418 int window = (s->cmd->opt & OPT_W) != 0;
1419
1420 if (havename || window) {
1421 s->callback(s, s->var, GRETL_OBJ_VAR);
1422 }
1423 }
1424 }
1425
gui_save_system(ExecState * s)1426 static void gui_save_system (ExecState *s)
1427 {
1428 equation_system *sys = s->sys;
1429
1430 if (!gretl_in_gui_mode() || s->callback == NULL) {
1431 return;
1432 }
1433 /* note: with GRETL_OBJ_SYS, the business of calling
1434 "maybe_stack" is handled within system.c, so here
1435 all we have to do is invoke the GUI callback, if
1436 appropriate
1437 */
1438 if (sys == NULL && s->cmd->ci == ESTIMATE && s->cmd->param != NULL) {
1439 sys = get_equation_system_by_name(s->cmd->param);
1440 }
1441 if (sys != NULL && (*s->cmd->savename != '\0' || (s->cmd->opt & OPT_W))) {
1442 s->callback(s, sys, GRETL_OBJ_SYS);
1443 }
1444 }
1445
model_test_check(CMD * cmd,DATASET * dset,PRN * prn)1446 static int model_test_check (CMD *cmd, DATASET *dset, PRN *prn)
1447 {
1448 int err = last_model_test_ok(cmd->ci, cmd->opt, dset, prn);
1449
1450 if (err == E_DATA && cmd->ci == RESTRICT && has_param(cmd)) {
1451 /* try for a not-yet estimated anonymous system */
1452 if (get_anonymous_equation_system() != NULL) {
1453 gretl_error_clear();
1454 err = 0;
1455 }
1456 }
1457
1458 return err;
1459 }
1460
get_line_continuation(char * line,FILE * fp,PRN * prn)1461 static int get_line_continuation (char *line, FILE *fp, PRN *prn)
1462 {
1463 char tmp[MAXLINE];
1464 int err = 0;
1465
1466 if (!strncmp(line, "quit", 4)) {
1467 return 0;
1468 }
1469
1470 while (top_n_tail(line, MAXLINE, &err)) {
1471 if (err) {
1472 break;
1473 }
1474 *tmp = '\0';
1475 if (fgets(tmp, sizeof tmp, fp) && *tmp != '\0') {
1476 if (strlen(line) + strlen(tmp) > MAXLINE - 1) {
1477 pprintf(prn, _("Maximum length of command line "
1478 "(%d bytes) exceeded"), MAXLINE);
1479 pputc(prn, '\n');
1480 err = E_TOOLONG;
1481 break;
1482 } else {
1483 strcat(line, tmp);
1484 compress_spaces(line);
1485 }
1486 }
1487 }
1488
1489 return err;
1490 }
1491
run_script(const char * fname,ExecState * s,DATASET * dset,gretlopt opt,PRN * prn)1492 static int run_script (const char *fname, ExecState *s,
1493 DATASET *dset, gretlopt opt,
1494 PRN *prn)
1495 {
1496 int indent = gretl_if_state_record();
1497 int echo = gretl_echo_on();
1498 int messages = gretl_messages_on();
1499 FILE *fp;
1500 int iferr, err = 0;
1501
1502 fp = gretl_fopen(fname, "r");
1503 if (fp == NULL) {
1504 gretl_errmsg_sprintf(_("Couldn't open %s"), fname);
1505 return E_FOPEN;
1506 }
1507
1508 strcpy(s->runfile, fname);
1509
1510 if (opt & OPT_Q) {
1511 set_gretl_echo(0);
1512 set_gretl_messages(0);
1513 }
1514
1515 if (gretl_echo_on()) {
1516 pprintf(prn, "run \"%s\"\n", fname);
1517 }
1518
1519 while (fgets(s->line, MAXLINE - 1, fp) && !err) {
1520 err = get_line_continuation(s->line, fp, prn);
1521 if (!err) {
1522 err = maybe_exec_line(s, dset, NULL);
1523 }
1524 }
1525
1526 fclose(fp);
1527
1528 if (opt & OPT_Q) {
1529 set_gretl_echo(echo);
1530 set_gretl_messages(messages);
1531 }
1532
1533 iferr = gretl_if_state_check(indent);
1534 if (iferr && !err) {
1535 err = iferr;
1536 }
1537
1538 return err;
1539 }
1540
lib_clear_data(ExecState * s,DATASET * dset)1541 static int lib_clear_data (ExecState *s, DATASET *dset)
1542 {
1543 int err = 0;
1544
1545 if (dset->Z != NULL) {
1546 err = restore_full_sample(dset, NULL);
1547 free_Z(dset);
1548 }
1549
1550 clear_model(s->model);
1551 clear_datainfo(dset, CLEAR_FULL);
1552 libgretl_session_cleanup(SESSION_CLEAR_DATASET);
1553 set_model_count(0);
1554 gretl_cmd_destroy_context(s->cmd);
1555
1556 return err;
1557 }
1558
join_aggregation_method(const char * s,int * seqval,char ** auxname,int * err)1559 static int join_aggregation_method (const char *s, int *seqval,
1560 char **auxname, int *err)
1561 {
1562 int ret = -1;
1563
1564 if (!strncmp(s, "seq:", 4)) {
1565 char *endptr;
1566
1567 *seqval = (int) strtol(s + 4, &endptr, 10);
1568 if (*endptr == '\0' && *seqval != 0) {
1569 ret = AGGR_SEQ;
1570 } else {
1571 gretl_errmsg_sprintf(_("%s: invalid input '%s'\n"), "--seq", s + 4);
1572 *err = E_DATA;
1573 }
1574 } else if (!strcmp(s, "count")) {
1575 ret = AGGR_COUNT;
1576 } else if (!strcmp(s, "avg")) {
1577 ret = AGGR_AVG;
1578 } else if (!strcmp(s, "sum")) {
1579 ret = AGGR_SUM;
1580 } else if (!strcmp(s, "min")) {
1581 ret = AGGR_MIN;
1582 } else if (!strcmp(s, "max")) {
1583 ret = AGGR_MAX;
1584 } else if (!strcmp(s, "none")) {
1585 ret = AGGR_NONE;
1586 } else if (!strcmp(s, "spread")) {
1587 ret = AGGR_MIDAS;
1588 } else if (!strncmp(s, "min(", 4) ||
1589 !strncmp(s, "max(", 4)) {
1590 const char *p = strchr(s + 4, ')');
1591
1592 if (p != NULL && strlen(p) == 1) {
1593 int len = p - (s + 4);
1594
1595 if (len > 0) {
1596 *auxname = gretl_strndup(s + 4, len);
1597 if (*auxname == NULL) {
1598 *err = E_ALLOC;
1599 } else {
1600 ret = (s[1] == 'a')? AGGR_MAX : AGGR_MIN;
1601 }
1602 }
1603 } else {
1604 *err = E_PARSE;
1605 }
1606 } else {
1607 *err = E_PARSE;
1608 }
1609
1610 return ret;
1611 }
1612
get_inner_key_id(const char * s,int n,const DATASET * dset,int * err)1613 static int get_inner_key_id (const char *s, int n,
1614 const DATASET *dset,
1615 int *err)
1616 {
1617 char vname[VNAMELEN];
1618 int id = -1;
1619
1620 if (n == 0 || n >= VNAMELEN) {
1621 *err = E_PARSE;
1622 } else {
1623 *vname = '\0';
1624 strncat(vname, s, n);
1625 if (gretl_namechar_spn(vname) != n) {
1626 gretl_errmsg_sprintf(_("field '%s' in command is invalid"), vname);
1627 *err = E_PARSE;
1628 } else {
1629 id = current_series_index(dset, vname);
1630 if (id < 0) {
1631 gretl_errmsg_sprintf("'%s': no such series", vname);
1632 *err = E_UNKVAR;
1633 }
1634 }
1635 }
1636
1637 return id;
1638 }
1639
get_inner_keys(const char * s,DATASET * dset,int * err)1640 static int *get_inner_keys (const char *s, DATASET *dset,
1641 int *err)
1642 {
1643 int *klist = NULL;
1644 int ikey1 = -1, ikey2 = -1;
1645 int nkeys = 0;
1646
1647 if (strchr(s, ',') == NULL) {
1648 /* just one key, fine */
1649 ikey1 = current_series_index(dset, s);
1650 if (ikey1 < 0) {
1651 gretl_errmsg_sprintf("'%s': no such series", s);
1652 *err = E_UNKVAR;
1653 } else {
1654 nkeys = 1;
1655 }
1656 } else {
1657 /* we should have a double key */
1658 int n = strcspn(s, ",");
1659
1660 ikey1 = get_inner_key_id(s, n, dset, err);
1661
1662 if (!*err) {
1663 s += n + 1;
1664 n = strlen(s);
1665 ikey2 = get_inner_key_id(s, n, dset, err);
1666 }
1667
1668 if (!*err) {
1669 nkeys = 2;
1670 }
1671 }
1672
1673 if (!*err) {
1674 klist = gretl_list_new(nkeys);
1675 if (klist == NULL) {
1676 *err = E_ALLOC;
1677 } else {
1678 klist[1] = ikey1;
1679 if (nkeys == 2) {
1680 klist[2] = ikey2;
1681 }
1682 }
1683 }
1684
1685 return klist;
1686 }
1687
check_import_names(char ** S,int ns,int ci,DATASET * dset)1688 static int check_import_names (char **S, int ns,
1689 int ci, DATASET *dset)
1690 {
1691 int i, err = 0;
1692
1693 for (i=0; i<ns && !err; i++) {
1694 if (S[i] == NULL || S[i][0] == '\0') {
1695 err = E_DATA;
1696 } else if (ci == JOIN && (strchr(S[i], '*') || strchr(S[i], '?'))) {
1697 ; /* wildcards: may be OK? */
1698 } else if (ci == JOIN && current_series_index(dset, S[i]) < 0) {
1699 err = check_varname(S[i]);
1700 if (!err && gretl_type_from_name(S[i], NULL)) {
1701 err = E_TYPES;
1702 }
1703 }
1704 }
1705
1706 return err;
1707 }
1708
names_from_array_arg(gretl_array * A,int * ns,int * err)1709 static char **names_from_array_arg (gretl_array *A,
1710 int *ns,
1711 int *err)
1712 {
1713 char **S = NULL;
1714
1715 if (gretl_array_get_type(A) != GRETL_TYPE_STRINGS) {
1716 *err = E_TYPES;
1717 } else {
1718 S = gretl_array_get_strings(A, ns);
1719 if (S == NULL) {
1720 *err = E_DATA;
1721 }
1722 }
1723
1724 return S;
1725 }
1726
strings_array_singleton(const char * s,int * err)1727 static char **strings_array_singleton (const char *s,
1728 int *err)
1729 {
1730 int len = strlen(s) + 1;
1731 char **S = strings_array_new_with_length(1, len);
1732
1733 if (S == NULL) {
1734 *err = E_ALLOC;
1735 } else {
1736 strcat(S[0], s);
1737 }
1738
1739 return S;
1740 }
1741
get_selected_import_names(const char * s,int ci,DATASET * dset,char *** pvnames,int * pnvars)1742 static int get_selected_import_names (const char *s,
1743 int ci,
1744 DATASET *dset,
1745 char ***pvnames,
1746 int *pnvars)
1747 {
1748 char **S = NULL;
1749 gretl_array *A = NULL;
1750 int ns = 0;
1751 int err = 0;
1752
1753 if (s == NULL) {
1754 return E_PARSE;
1755 }
1756
1757 if (strchr(s, ' ') != NULL) {
1758 /* @s should hold two or more names */
1759 S = gretl_string_split(s, &ns, NULL);
1760 if (S == NULL) {
1761 err = E_DATA;
1762 }
1763 } else if ((A = get_array_by_name(s)) != NULL) {
1764 /* @s should be the name of an array of strings */
1765 S = names_from_array_arg(A, &ns, &err);
1766 } else {
1767 /* @s should be a legit series name */
1768 S = strings_array_singleton(s, &err);
1769 ns = 1;
1770 }
1771
1772 if (S != NULL) {
1773 err = check_import_names(S, ns, ci, dset);
1774 }
1775
1776 if (!err) {
1777 if (A != NULL) {
1778 /* copy strings "borrowed" from array */
1779 *pvnames = strings_array_dup(S, ns);
1780 if (*pvnames == NULL) {
1781 err = E_ALLOC;
1782 }
1783 } else {
1784 /* grab strings allocated here */
1785 *pvnames = S;
1786 }
1787 *pnvars = ns;
1788 }
1789
1790 return err;
1791 }
1792
lib_join_data(const char * param,const char * filename,DATASET * dset,gretlopt opt,PRN * prn)1793 int lib_join_data (const char *param,
1794 const char *filename,
1795 DATASET *dset,
1796 gretlopt opt,
1797 PRN *prn)
1798 {
1799 gretlopt opts[] = {
1800 OPT_I, /* ikey: inner key(s) */
1801 OPT_O, /* okey: outer key(s) */
1802 OPT_F, /* filter: filter expression */
1803 OPT_A, /* aggr: aggregation method */
1804 OPT_D, /* data: "payload" spec */
1805 OPT_K, /* tkey: outer time-key name,format */
1806 OPT_X, /* tconvert: date columns for conversion */
1807 OPT_T, /* tconv-fmt: format for "tconvert" */
1808 OPT_P, /* pd: outer data frequency */
1809 0
1810 };
1811 char *okey = NULL, *filter = NULL;
1812 char **vnames = NULL;
1813 char *dataname = NULL;
1814 char *auxname = NULL;
1815 char *tconvstr = NULL;
1816 char *tconvfmt = NULL;
1817 int *ikeyvars = NULL;
1818 int aggr = 0, seqval = 0;
1819 int midas_pd = 0;
1820 int tseries = 0;
1821 int nvars = 1;
1822 int i, err = 0;
1823
1824 if (opt & OPT_K) {
1825 /* --tkey implies special handling of keys */
1826 if (opt & (OPT_I | OPT_O)) {
1827 return E_BADOPT;
1828 } else if (!dataset_is_time_series(dset)) {
1829 return E_PDWRONG;
1830 }
1831 }
1832
1833 tseries = dataset_is_time_series(dset);
1834
1835 err = get_selected_import_names(param, JOIN, dset, &vnames, &nvars);
1836
1837 if (!err && nvars > 1) {
1838 /* multiple series: we can't handle the --data option */
1839 if (opt & OPT_D) {
1840 err = E_BADOPT;
1841 }
1842 }
1843
1844 for (i=0; opts[i] && !err; i++) {
1845 gretlopt jopt = opts[i];
1846 const char *param;
1847
1848 if (opt & jopt) {
1849 param = get_optval_string(JOIN, jopt);
1850 if (param == NULL) {
1851 gretl_errmsg_set("Missing option parameter");
1852 err = E_DATA;
1853 } else if (jopt == OPT_I) {
1854 /* --ikey: the inner key(s) string */
1855 ikeyvars = get_inner_keys(param, dset, &err);
1856 } else if (jopt == OPT_O) {
1857 /* --okey: the outer key(s) string */
1858 okey = gretl_strdup(param);
1859 } else if (jopt == OPT_F) {
1860 /* --filter: string specifying a row filter */
1861 filter = gretl_strdup(param);
1862 } else if (jopt == OPT_A) {
1863 /* --aggr: aggregation */
1864 aggr = join_aggregation_method(param, &seqval,
1865 &auxname, &err);
1866 } else if (jopt == OPT_D) {
1867 /* --data: string specifying the outer data series */
1868 dataname = gretl_strdup(param);
1869 } else if (jopt == OPT_K) {
1870 /* --tkey: string specifying outer time key */
1871 okey = gretl_strdup(param);
1872 } else if (jopt == OPT_X) {
1873 /* --tconvert: list of time/date cols */
1874 tconvstr = gretl_strdup(param);
1875 } else if (jopt == OPT_T) {
1876 /* --tconv-fmt: format for tconvert columns */
1877 tconvfmt = gretl_strdup(param);
1878 } else if (jopt == OPT_P) {
1879 midas_pd = atoi(param);
1880 }
1881 }
1882 }
1883
1884 if (!err && okey != NULL && ikeyvars == NULL && !(opt & OPT_K)) {
1885 /* We can't have an outer key but no inner one, unless
1886 we're matching by the time-series structure of the
1887 left-hand dataset (implied by OPT_K)
1888 */
1889 gretl_errmsg_set(_("Inner key is missing"));
1890 err = E_PARSE;
1891 }
1892
1893 if (!err && aggr != 0 && ikeyvars == NULL && !tseries) {
1894 /* aggregation requires ikeyvars, unless there's
1895 an implicit time-series inner key
1896 */
1897 gretl_errmsg_set(_("Inner key is missing"));
1898 err = E_ARGS;
1899 }
1900
1901 if (!err) {
1902 err = gretl_join_data(filename,
1903 (const char **) vnames,
1904 nvars, dset,
1905 ikeyvars, okey, filter,
1906 dataname, aggr, seqval,
1907 auxname, tconvstr,
1908 tconvfmt, midas_pd,
1909 opt, prn);
1910 }
1911
1912 strings_array_free(vnames, nvars);
1913 free(ikeyvars);
1914 free(okey);
1915 free(filter);
1916 free(dataname);
1917 free(auxname);
1918 free(tconvstr);
1919 free(tconvfmt);
1920
1921 return err;
1922 }
1923
is_http(const char * s)1924 static int is_http (const char *s)
1925 {
1926 return (strncmp(s, "http://", 7) == 0 ||
1927 strncmp(s, "https://", 8) == 0);
1928 }
1929
open_op_init(CMD * cmd,OpenOp * op)1930 static void open_op_init (CMD *cmd, OpenOp *op)
1931 {
1932 op->fname[0] = '\0';
1933 op->quiet = (cmd->opt & OPT_Q)? 1 : 0;
1934 op->http = 0;
1935 op->dbdata = 0;
1936 op->ftype = -1;
1937 }
1938
1939 /* selection of series by name: applicable only for "open"
1940 for native gretl data files
1941 */
1942
check_import_subsetting(CMD * cmd,OpenOp * op)1943 static int check_import_subsetting (CMD *cmd, OpenOp *op)
1944 {
1945 if (cmd->ci != OPEN || (op->ftype != GRETL_XML_DATA &&
1946 op->ftype != GRETL_BINARY_DATA)) {
1947 return E_BADOPT;
1948 } else {
1949 const char *s = get_optval_string(OPEN, OPT_E);
1950
1951 if (get_array_by_name(s)) {
1952 /* protect array from deletion */
1953 cmd->opt |= OPT_P;
1954 }
1955 return 0;
1956 }
1957 }
1958
open_append_stage_1(CMD * cmd,DATASET * dset,OpenOp * op,PRN * prn)1959 static int open_append_stage_1 (CMD *cmd,
1960 DATASET *dset,
1961 OpenOp *op,
1962 PRN *prn)
1963 {
1964 gretlopt opt = cmd->opt;
1965 int pkgdata = 0;
1966 int err = 0;
1967
1968 open_op_init(cmd, op);
1969
1970 /* initial detection of some open/append variants */
1971
1972 if (opt & OPT_W) {
1973 /* --www: remote databases only, no other options
1974 applicable
1975 */
1976 if (opt != OPT_W) {
1977 return E_BADOPT;
1978 }
1979 op->ftype = GRETL_NATIVE_DB_WWW;
1980 op->dbdata = 1;
1981 strncat(op->fname, cmd->param, MAXLEN - 1);
1982 } else if (cmd->ci != JOIN && (opt & OPT_O)) {
1983 op->ftype = GRETL_ODBC;
1984 op->dbdata = 1;
1985 } else if (cmd->ci == OPEN && (opt & OPT_K)) {
1986 /* --frompkg=whatever */
1987 pkgdata = 1;
1988 } else if (!strcmp(cmd->param, "dbnomics")) {
1989 strcpy(op->fname, "dbnomics");
1990 op->ftype = GRETL_DBNOMICS;
1991 op->dbdata = 1;
1992 } else if (is_http(cmd->param)) {
1993 op->http = 1;
1994 }
1995
1996 if (!op->dbdata) {
1997 if (op->http) {
1998 err = try_http(cmd->param, op->fname, NULL);
1999 } else if (pkgdata) {
2000 err = get_package_data_path(cmd->param, op->fname);
2001 } else {
2002 err = get_full_filename(cmd->param, op->fname, OPT_NONE);
2003 }
2004 }
2005
2006 if (!err) {
2007 if (op->ftype < 0) {
2008 op->ftype = detect_filetype(op->fname, OPT_P);
2009 }
2010 if (opt & OPT_E) {
2011 err = check_import_subsetting(cmd, op);
2012 }
2013 }
2014
2015 if (err) {
2016 errmsg(err, prn);
2017 return err;
2018 }
2019
2020 if (cmd->ci == JOIN) {
2021 if (op->ftype == GRETL_CSV || op->ftype == GRETL_XML_DATA ||
2022 op->ftype == GRETL_BINARY_DATA) {
2023 set_dataset_is_changed(dset, 0);
2024 err = lib_join_data(cmd->parm2, op->fname, dset, opt, prn);
2025 } else {
2026 gretl_errmsg_set("join: only CSV and gdt[b] files are supported");
2027 err = E_DATA;
2028 }
2029 if (err) {
2030 errmsg(err, prn);
2031 }
2032 } else {
2033 if (!op->dbdata) {
2034 op->dbdata = (op->ftype == GRETL_NATIVE_DB ||
2035 op->ftype == GRETL_RATS_DB ||
2036 op->ftype == GRETL_PCGIVE_DB);
2037 }
2038 if (cmd->ci == OPEN && !op->dbdata && gretl_function_depth() > 0) {
2039 gretl_errmsg_sprintf(_("The \"%s\" command cannot be used in this context"),
2040 gretl_command_word(cmd->ci));
2041 err = E_DATA;
2042 }
2043 }
2044
2045 return err;
2046 }
2047
2048 /* respond to --select (select specific series) on OPEN
2049 for native gdt or gdtb data files
2050 */
2051
handle_gdt_selection(const char * fname,DATASET * dset,gretlopt opt,PRN * prn)2052 static int handle_gdt_selection (const char *fname,
2053 DATASET *dset,
2054 gretlopt opt,
2055 PRN *prn)
2056 {
2057 const char *s = get_optval_string(OPEN, OPT_E);
2058 char **S_sel = NULL;
2059 char **S_ok = NULL;
2060 int n_ok, n_sel = 0;
2061 int err = 0;
2062
2063 if (s == NULL || *s == '\0') {
2064 return E_BADOPT;
2065 }
2066
2067 err = get_selected_import_names(s, OPEN, dset, &S_sel, &n_sel);
2068 if (!err) {
2069 err = gretl_read_gdt_varnames(fname, &S_ok, &n_ok);
2070 }
2071
2072 if (!err) {
2073 int *list = gretl_list_new(n_sel);
2074 int i, j, k = 0;
2075
2076 for (j=0; j<n_sel; j++) {
2077 for (i=1; i<n_ok; i++) {
2078 if (!strcmp(S_sel[j], S_ok[i])) {
2079 list[++k] = i;
2080 break;
2081 }
2082 }
2083 }
2084 if (k != n_sel) {
2085 pputs(prn, "Invalid selection");
2086 pputc(prn, '\n');
2087 err = E_DATA;
2088 } else {
2089 err = gretl_read_gdt_subset(fname, dset, list, opt);
2090 }
2091 free(list);
2092 }
2093
2094 strings_array_free(S_ok, n_ok);
2095 strings_array_free(S_sel, n_sel);
2096
2097 return err;
2098 }
2099
lib_open_append(ExecState * s,DATASET * dset,char * newfile,PRN * prn)2100 static int lib_open_append (ExecState *s,
2101 DATASET *dset,
2102 char *newfile,
2103 PRN *prn)
2104 {
2105 CMD *cmd = s->cmd;
2106 gretlopt opt = cmd->opt;
2107 OpenOp op = {0};
2108 PRN *vprn = prn;
2109 int err;
2110
2111 *newfile = '\0';
2112
2113 err = open_append_stage_1(cmd, dset, &op, prn);
2114
2115 if (cmd->ci == JOIN) {
2116 /* handled by stage 1 */
2117 return err;
2118 } else if (err) {
2119 /* error at stage 1, don't proceed */
2120 return err;
2121 }
2122
2123 if (cmd->ci == OPEN && !op.dbdata) {
2124 if (s->callback != NULL) {
2125 /* allow aborting a destructive "open" */
2126 int stop = s->callback(s, dset, GRETL_OBJ_DSET);
2127
2128 if (stop) return 0;
2129 } else {
2130 lib_clear_data(s, dset);
2131 }
2132 }
2133
2134 if (op.quiet) {
2135 /* in case we hit any problems below... */
2136 vprn = gretl_print_new(GRETL_PRINT_BUFFER, NULL);
2137 }
2138
2139 if (op.ftype == GRETL_XML_DATA || op.ftype == GRETL_BINARY_DATA) {
2140 if (opt & OPT_E) {
2141 err = handle_gdt_selection(op.fname, dset, opt, vprn);
2142 } else {
2143 err = gretl_read_gdt(op.fname, dset, opt, vprn);
2144 }
2145 } else if (op.ftype == GRETL_CSV) {
2146 err = import_csv(op.fname, dset, opt, vprn);
2147 } else if (SPREADSHEET_IMPORT(op.ftype)) {
2148 err = import_spreadsheet(op.fname, op.ftype, cmd->list, cmd->parm2,
2149 dset, opt, vprn);
2150 } else if (OTHER_IMPORT(op.ftype)) {
2151 err = import_other(op.fname, op.ftype, dset, opt, vprn);
2152 } else if (op.ftype == GRETL_ODBC) {
2153 err = set_odbc_dsn(cmd->param, vprn);
2154 } else if (op.dbdata) {
2155 err = set_db_name(op.fname, op.ftype, vprn);
2156 } else {
2157 err = gretl_get_data(op.fname, dset, opt, vprn);
2158 }
2159
2160 if (vprn != prn) {
2161 if (err) {
2162 /* The user asked for --quiet operation, but something
2163 went wrong so let's print any info we got on
2164 @vprn.
2165 */
2166 const char *buf = gretl_print_get_buffer(vprn);
2167
2168 if (buf != NULL && *buf != '\0') {
2169 pputs(prn, buf);
2170 }
2171 } else if (op.ftype != GRETL_NATIVE_DB_WWW && op.ftype != GRETL_ODBC) {
2172 #ifdef HAVE_MPI
2173 /* print minimal success message? */
2174 if (!gretl_mpi_initialized() || gretl_mpi_rank() == 0) {
2175 pprintf(prn, _("Read datafile %s\n"), op.fname);
2176 }
2177 #else
2178 pprintf(prn, _("Read datafile %s\n"), op.fname);
2179 #endif
2180 }
2181 gretl_print_destroy(vprn);
2182 }
2183
2184
2185 if (err) {
2186 errmsg(err, prn);
2187 } else {
2188 if (dset->v > 0 && !op.dbdata && !op.quiet) {
2189 list_series(dset, OPT_NONE, prn);
2190 }
2191 if (op.http) {
2192 remove(op.fname);
2193 }
2194 if (!op.dbdata && !op.http) {
2195 /* redundant? */
2196 strcpy(newfile, op.fname);
2197 }
2198 if (cmd->ci == OPEN && !op.dbdata) {
2199 if (s->callback != NULL) {
2200 if (op.http) {
2201 op.fname[0] = '\0';
2202 }
2203 s->callback(s, &op, GRETL_OBJ_ANY);
2204 }
2205 }
2206 }
2207
2208 return err;
2209 }
2210
check_clear(gretlopt opt)2211 static int check_clear (gretlopt opt)
2212 {
2213 int err = 0;
2214
2215 if (gretl_function_depth() > 0) {
2216 gretl_errmsg_sprintf(_("The \"%s\" command cannot be used in this context"),
2217 gretl_command_word(CLEAR));
2218 err = E_DATA;
2219 } else {
2220 err = incompatible_options(opt, OPT_D | OPT_F);
2221 }
2222
2223 return err;
2224 }
2225
2226 static EXEC_CALLBACK gui_callback;
2227
schedule_callback(ExecState * s)2228 static void schedule_callback (ExecState *s)
2229 {
2230 if (s->callback != NULL) {
2231 s->flags |= CALLBACK_EXEC;
2232 }
2233 }
2234
maybe_schedule_set_callback(ExecState * s)2235 static void maybe_schedule_set_callback (ExecState *s)
2236 {
2237 if (s->callback != NULL && s->cmd->param != NULL) {
2238 if (!strcmp(s->cmd->param, "plot_collection")) {
2239 s->flags |= CALLBACK_EXEC;
2240 }
2241 }
2242 }
2243
callback_scheduled(ExecState * s)2244 static int callback_scheduled (ExecState *s)
2245 {
2246 return (s->flags & CALLBACK_EXEC) ? 1 : 0;
2247 }
2248
callback_exec(ExecState * s,char * fname,int err)2249 static void callback_exec (ExecState *s, char *fname, int err)
2250 {
2251 if (!err && s->callback != NULL) {
2252 if (s->cmd->ci == OPEN) {
2253 s->callback(s, fname, 0);
2254 } else {
2255 s->callback(s, NULL, 0);
2256 }
2257 }
2258
2259 s->flags &= ~CALLBACK_EXEC;
2260 *s->cmd->savename = '\0';
2261 }
2262
2263 /* for use in contexts where we don't have an
2264 ExecState (or CMD) to hand
2265 */
2266
manufacture_gui_callback(int ci)2267 void manufacture_gui_callback (int ci)
2268 {
2269 if (gui_callback != NULL) {
2270 ExecState s = {0};
2271 CMD cmd = {0};
2272
2273 cmd.ci = ci;
2274 if (ci == FLUSH) {
2275 cmd.opt = OPT_Q;
2276 }
2277 s.cmd = &cmd;
2278 gui_callback(&s, NULL, 0);
2279 }
2280 }
2281
2282 /* whether we're in gui or cli mode, try to ensure
2283 that printed output gets displayed
2284 */
2285
gretl_flush(PRN * prn)2286 void gretl_flush (PRN *prn)
2287 {
2288 if (gui_callback != NULL) {
2289 ExecState s = {0};
2290 CMD cmd = {0};
2291
2292 cmd.ci = FLUSH;
2293 cmd.opt = OPT_Q;
2294 s.cmd = &cmd;
2295 gui_callback(&s, NULL, 0);
2296 } else {
2297 gretl_print_flush_stream(prn);
2298 }
2299 }
2300
do_end_restrict(ExecState * s,DATASET * dset)2301 static int do_end_restrict (ExecState *s, DATASET *dset)
2302 {
2303 GretlObjType otype = gretl_restriction_get_type(s->rset);
2304 gretlopt ropt = gretl_restriction_get_options(s->rset);
2305 gretlopt opt = s->cmd->opt | ropt;
2306 int err = 0;
2307
2308 if (opt & OPT_F) {
2309 /* restrict --full */
2310 if (otype == GRETL_OBJ_VAR) {
2311 s->var = gretl_restricted_vecm(s->rset, dset,
2312 opt, s->prn, &err);
2313 if (!err && s->var != NULL) {
2314 save_var_vecm(s);
2315 }
2316 } else if (otype == GRETL_OBJ_EQN) {
2317 err = gretl_restriction_finalize_full(s, s->rset, dset,
2318 opt, s->prn);
2319 if (!err) {
2320 gretlopt printopt = OPT_NONE;
2321
2322 if (opt & (OPT_Q | OPT_S)) {
2323 printopt = OPT_Q;
2324 }
2325 print_save_model(s->pmod, dset, printopt, 1,
2326 s->prn, s);
2327 }
2328 }
2329 } else {
2330 err = gretl_restriction_finalize(s->rset, dset,
2331 opt, s->prn);
2332 }
2333
2334 s->rset = NULL;
2335
2336 return err;
2337 }
2338
do_debug_command(ExecState * state,const char * param,gretlopt opt)2339 static int do_debug_command (ExecState *state, const char *param,
2340 gretlopt opt)
2341 {
2342 int err = incompatible_options(opt, OPT_C | OPT_N | OPT_Q);
2343
2344 if (err) {
2345 return err;
2346 }
2347
2348 if (opt & (OPT_C | OPT_N)) {
2349 /* continue, next */
2350 if (!(state->flags & DEBUG_EXEC)) {
2351 gretl_errmsg_set("Debugging is not in progress");
2352 return E_DATA;
2353 } else {
2354 /* handled in debug_command_loop */
2355 return 0;
2356 }
2357 } else {
2358 /* OPT_Q quits debugging of the given function */
2359 return user_function_set_debug(param, !(opt & OPT_Q));
2360 }
2361 }
2362
2363 /* Given the name of a discrete variable, perform a command for each
2364 value of the discrete variable. Note that at present the only
2365 command supported in this way is SUMMARY.
2366 */
2367
do_command_by(CMD * cmd,DATASET * dset,PRN * prn)2368 static int do_command_by (CMD *cmd, DATASET *dset, PRN *prn)
2369 {
2370 const char *byname = get_optval_string(cmd->ci, OPT_B);
2371 int byvar;
2372 series_table *st = NULL;
2373 gretl_matrix *xvals = NULL;
2374 const double *x;
2375 int *list = cmd->list;
2376 int i, nvals = 0;
2377 int single, err = 0;
2378
2379 if (dset == NULL || byname == NULL) {
2380 return E_DATA;
2381 }
2382
2383 /* FIXME accept "unit" and "time"/"period" in place of actual
2384 variables for panel data? */
2385
2386 byvar = current_series_index(dset, byname);
2387 if (byvar < 0) {
2388 return E_UNKVAR;
2389 } else if (!accept_as_discrete(dset, byvar, 0)) {
2390 gretl_errmsg_sprintf(_("The variable '%s' is not discrete"), byname);
2391 return E_DATA;
2392 }
2393
2394 x = (const double *) dset->Z[byvar];
2395
2396 if (list == NULL) {
2397 /* compose full series list, but exclude the "by" variable */
2398 int pos;
2399
2400 list = full_var_list(dset, NULL);
2401 if (list == NULL) {
2402 return E_ALLOC;
2403 }
2404 pos = in_gretl_list(list, byvar);
2405 if (pos > 0) {
2406 gretl_list_delete_at_pos(list, pos);
2407 }
2408 if (list[0] == 0) {
2409 free(list);
2410 return E_DATA;
2411 }
2412 }
2413
2414 single = (list[0] == 1);
2415
2416 xvals = gretl_matrix_values(x + dset->t1, dset->t2 - dset->t1 + 1,
2417 OPT_S, &err);
2418
2419 if (!err) {
2420 nvals = gretl_vector_get_length(xvals);
2421 if (nvals == 0) {
2422 err = E_DATA;
2423 } else {
2424 st = series_get_string_table(dset, byvar);
2425 }
2426 }
2427
2428 if (!err && single) {
2429 pputc(prn, '\n');
2430 pprintf(prn, _("Summary statistics for %s, by value of %s"),
2431 dset->varname[list[1]], byname);
2432 pputc(prn, '\n');
2433 }
2434
2435 for (i=0; i<nvals && !err; i++) {
2436 Summary *summ = NULL;
2437 char genline[64];
2438 double xi = gretl_vector_get(xvals, i);
2439 double *rv = NULL;
2440
2441 gretl_push_c_numeric_locale();
2442 sprintf(genline, "%s == %g", byname, xi);
2443 gretl_pop_c_numeric_locale();
2444 rv = generate_series(genline, dset, prn, &err);
2445
2446 if (!err) {
2447 summ = get_summary_restricted(list, dset, rv,
2448 cmd->opt, prn, &err);
2449 }
2450
2451 if (!err) {
2452 if (i == 0) {
2453 pputc(prn, '\n');
2454 }
2455 if (single) {
2456 bufspace(2, prn);
2457 }
2458 if (st != NULL) {
2459 const char *s = series_table_get_string(st, xi);
2460
2461 pprintf(prn, "%s = %s (n = %d):\n", byname, s, summ->n);
2462 } else {
2463 pprintf(prn, "%s = %g (n = %d):\n", byname, xi, summ->n);
2464 }
2465 print_summary(summ, dset, prn);
2466 free_summary(summ);
2467 }
2468
2469 free(rv);
2470 }
2471
2472 gretl_matrix_free(xvals);
2473 if (list != cmd->list) {
2474 free(list);
2475 }
2476
2477 return err;
2478 }
2479
exec_state_prep(ExecState * s)2480 static void exec_state_prep (ExecState *s)
2481 {
2482 s->flags &= ~CALLBACK_EXEC;
2483 s->pmod = NULL;
2484 }
2485
gretl_delete_variables(int * list,const char * param,gretlopt opt,DATASET * dset,int * renumber,PRN * prn)2486 int gretl_delete_variables (int *list,
2487 const char *param,
2488 gretlopt opt,
2489 DATASET *dset,
2490 int *renumber,
2491 PRN *prn)
2492 {
2493 int err;
2494
2495 err = incompatible_options(opt, OPT_T | OPT_D | OPT_F);
2496
2497 if (!err) {
2498 if (opt & OPT_T) {
2499 /* delete all vars of given type */
2500 if (list != NULL || param != NULL) {
2501 err = E_BADOPT;
2502 }
2503 } else if (opt & OPT_D) {
2504 /* delete named vars from database */
2505 if (list != NULL || param == NULL) {
2506 err = E_BADOPT;
2507 }
2508 }
2509 }
2510
2511 if (err) {
2512 return err;
2513 }
2514
2515 if (opt & OPT_T) {
2516 const char *s = get_optval_string(DELEET, OPT_T);
2517
2518 if (s == NULL) {
2519 err = E_ARGS;
2520 } else {
2521 GretlType type = gretl_type_from_string(s);
2522
2523 err = delete_user_vars_of_type(type, prn);
2524 }
2525 } else if (opt & OPT_D) {
2526 err = db_delete_series_by_name(param, prn);
2527 } else if (param != NULL) {
2528 err = gretl_delete_var_by_name(param, prn);
2529 } else if (list != NULL) {
2530 /* delete listed series from dataset */
2531 if (renumber == NULL && !(opt & OPT_F)) {
2532 /* lacking the --force option */
2533 pputs(prn, _("You cannot delete series in this context\n"));
2534 err = E_DATA;
2535 } else {
2536 err = dataset_drop_listed_variables(list, dset,
2537 renumber, prn);
2538 }
2539 } else {
2540 err = E_DATA;
2541 }
2542
2543 return err;
2544 }
2545
2546 /* OMIT and ADD: if we're estimating a revised model, should
2547 we be saving it as the "last model", or are we just treating
2548 the command as a stand-alone test?
2549 */
2550
add_omit_save(CMD * cmd,MODEL * pmod)2551 static int add_omit_save (CMD *cmd, MODEL *pmod)
2552 {
2553 int ret = 1;
2554
2555 if (cmd->ci == ADD) {
2556 if (cmd->opt & OPT_L) {
2557 /* not saving if given the --lm option */
2558 ret = 0;
2559 }
2560 } else if (cmd->ci == OMIT) {
2561 if (cmd->opt & OPT_W) {
2562 /* not saving under the --test-only (Wald) option */
2563 ret = 0;
2564 } else if (!(cmd->opt & OPT_A)) {
2565 /* not in --auto mode */
2566 if (cmd->list != NULL && pmod->list != NULL &&
2567 cmd->list[0] == pmod->list[0] - 1) {
2568 /* omitting everything, can't save */
2569 ret = 0;
2570 }
2571 }
2572 }
2573
2574 return ret;
2575 }
2576
VAR_omit_driver(CMD * cmd,DATASET * dset,PRN * prn)2577 static int VAR_omit_driver (CMD *cmd, DATASET *dset, PRN *prn)
2578 {
2579 GRETL_VAR *var = get_last_model(NULL);
2580 int err = 0;
2581
2582 if (cmd->opt & OPT_W) {
2583 /* Wald test using VCV */
2584 err = gretl_VAR_wald_omit_test(var, cmd->list, dset,
2585 cmd->opt, prn);
2586 } else {
2587 /* the full deal: estimate reduced system */
2588 GRETL_VAR *vnew;
2589
2590 vnew = gretl_VAR_omit_test(var, cmd->list, dset, cmd->opt,
2591 prn, &err);
2592 if (!err) {
2593 err = maybe_stack_var(vnew, cmd);
2594 }
2595 }
2596
2597 return err;
2598 }
2599
model_print_driver(MODEL * pmod,DATASET * dset,int ci,const char * param,gretlopt opt,PRN * prn)2600 static int model_print_driver (MODEL *pmod, DATASET *dset,
2601 int ci, const char *param,
2602 gretlopt opt, PRN *prn)
2603 {
2604 int err = incompatible_options(opt, OPT_R | OPT_C);
2605
2606 if (!err) {
2607 char fname[FILENAME_MAX];
2608
2609 *fname = '\0';
2610
2611 if (param != NULL) {
2612 /* the legacy mechanism */
2613 strcpy(fname, param);
2614 } else if (opt & OPT_U) {
2615 /* try for --output=filename, and if found let
2616 the suffix determine the output type
2617 */
2618 const char *s = get_optval_string(ci, OPT_U);
2619
2620 if (s != NULL && *s != '\0') {
2621 strcpy(fname, s);
2622 if (has_suffix(fname, ".rtf")) {
2623 opt |= OPT_R;
2624 } else if (has_suffix(fname, ".csv")) {
2625 opt |= OPT_C;
2626 }
2627 }
2628 }
2629
2630 if (*fname == '\0') {
2631 /* fallback */
2632 const char *sfx = (opt & OPT_R)? "rtf" :
2633 (opt & OPT_C)? "csv" : "tex";
2634
2635 if (pmod->ID > 0) {
2636 sprintf(fname, "model_%d.%s", pmod->ID, sfx);
2637 } else {
2638 /* FIXME: this needs to be checked! */
2639 sprintf(fname, "model_%" G_GINT64_FORMAT ".%s",
2640 pmod->esttime, sfx);
2641 }
2642 }
2643
2644 if (opt & OPT_R) {
2645 err = rtfprint(pmod, dset, fname, opt);
2646 } else if (opt & OPT_C) {
2647 err = csvprint(pmod, dset, fname, opt);
2648 } else {
2649 gretlopt texopt = opt;
2650
2651 if (ci == EQNPRINT) {
2652 texopt |= OPT_E;
2653 }
2654 err = texprint(pmod, dset, fname, texopt);
2655 }
2656 if (!err) {
2657 pprintf(prn, _("Model printed to %s\n"), fname);
2658 }
2659 }
2660
2661 return err;
2662 }
2663
2664 #if USE_CURL
2665
package_check_dependencies(const char * fname,ExecState * s,PRN * prn)2666 static int package_check_dependencies (const char *fname,
2667 ExecState *s,
2668 PRN *prn)
2669 {
2670 char **depends;
2671 int ndeps;
2672 int err = 0;
2673
2674 if (has_suffix(fname, ".zip")) {
2675 /* we need to map from @fname to the gfn name */
2676 gchar *tmp, *gfnname;
2677 const char *p;
2678
2679 tmp = g_strndup(fname, strlen(fname) - 4);
2680 p = path_last_element(tmp);
2681 gfnname = g_strdup_printf("%s%c%s.gfn", tmp, SLASH, p);
2682 depends = package_peek_dependencies(gfnname, &ndeps);
2683 g_free(tmp);
2684 g_free(gfnname);
2685 } else {
2686 depends = package_peek_dependencies(fname, &ndeps);
2687 }
2688
2689 if (depends != NULL) {
2690 char *pkgpath;
2691 int i;
2692
2693 for (i=0; i<ndeps && !err; i++) {
2694 pkgpath = gretl_function_package_get_path(depends[i], PKG_ALL);
2695 if (pkgpath == NULL) {
2696 err = install_function_package(depends[i], OPT_D, s, prn);
2697 }
2698 free(pkgpath);
2699 }
2700 strings_array_free(depends, ndeps);
2701 }
2702
2703 return err;
2704 }
2705
2706 /* For now DO_BINPGK (that is, handle binary packages -- x13as and
2707 tramo-seats -- via the "pkg" command) is specific to macOS. It
2708 could in principle be extended to other OSes.
2709 */
2710
2711 #ifdef OS_OSX
2712 # define DO_BINPKG 1
2713 #else
2714 # define DO_BINPKG 0
2715 #endif
2716
2717 #if DO_BINPKG
2718
2719 #include "gretl_untar.h"
2720
handle_tgz(const char * fname,ExecState * s,PRN * prn)2721 static int handle_tgz (const char *fname,
2722 ExecState *s,
2723 PRN *prn)
2724 {
2725 const char *path_id = NULL;
2726 gchar *uri, *fullname;
2727 int err;
2728
2729 fullname = gretl_make_dotpath(fname);
2730 /* using WFU server for now, could be moved to sourceforge */
2731 uri = g_strdup_printf("http://ricardo.ecn.wfu.edu/pub/gretl/%s", fname);
2732 err = retrieve_public_file(uri, fullname);
2733
2734 if (!err) {
2735 gchar *s, *topdir = NULL;
2736 int try = 0;
2737
2738 try_again:
2739
2740 if (try == 0) {
2741 topdir = g_strdup(gretl_bindir());
2742 s = strstr(topdir, "/bin/");
2743 } else {
2744 topdir = g_strdup(gretl_function_package_path());
2745 s = strstr(topdir, "/functions");
2746 }
2747
2748 if (s == NULL) {
2749 err = E_DATA;
2750 } else {
2751 *s = '\0';
2752 fprintf(stderr, "topdir %d: '%s'\n", try, topdir);
2753 err = gretl_chdir(topdir);
2754 if (err) {
2755 fprintf(stderr, "chdir %d error\n", try);
2756 } else {
2757 err = gretl_untar(fullname);
2758 fprintf(stderr, "untar %d: err = %d\n", try, err);
2759 }
2760 }
2761
2762 if (err && try == 0) {
2763 g_free(topdir);
2764 err = 0;
2765 try = 1;
2766 goto try_again;
2767 }
2768 if (!err) {
2769 if (strstr(fname, "tramo") != NULL) {
2770 path_id = "tramo";
2771 s = g_strdup_printf("%s/bin/tramo", topdir);
2772 gretl_set_path_by_name(path_id, s);
2773 g_free(s);
2774 } else if (strstr(fname, "x13as") != NULL) {
2775 path_id = "x12a";
2776 s = g_strdup_printf("%s/bin/x13as", topdir);
2777 gretl_set_path_by_name(path_id, s);
2778 g_free(s);
2779 }
2780 }
2781 gretl_remove(fullname);
2782 g_free(topdir);
2783 }
2784
2785 if (!err && gretl_messages_on()) {
2786 pprintf(prn, "Installed %s\n", fname);
2787 }
2788
2789 if (!err && s != NULL && path_id != NULL && gui_callback != NULL) {
2790 gretl_bundle *b = gretl_bundle_new();
2791
2792 gretl_bundle_set_string(b, "path_id", path_id);
2793 gretl_bundle_set_int(b, "binpkg", 1);
2794 gui_callback(s, b, GRETL_OBJ_BUNDLE);
2795 }
2796
2797 g_free(fullname);
2798 g_free(uri);
2799
2800 return err;
2801 }
2802
2803 #endif /* DO_BINPKG */
2804
really_local(const char * pkgname)2805 static int really_local (const char *pkgname)
2806 {
2807 #ifdef WIN32
2808 if (isalpha(pkgname[0]) && pkgname[1] == ':') {
2809 return 1;
2810 } else if (strchr(pkgname, '\\')) {
2811 return 1;
2812 }
2813 #else
2814 if (strchr(pkgname, ':') == NULL && strchr(pkgname, '/')) {
2815 return 1;
2816 }
2817 #endif
2818 return 0;
2819 }
2820
install_function_package(const char * pkgname,gretlopt opt,ExecState * s,PRN * prn)2821 static int install_function_package (const char *pkgname,
2822 gretlopt opt,
2823 ExecState *s,
2824 PRN *prn)
2825 {
2826 char *fname = NULL;
2827 gchar *gfname = NULL;
2828 int filetype = 0;
2829 int local = (opt & OPT_L);
2830 int addon = 0;
2831 int http = 0;
2832 int err = 0;
2833
2834 #if DO_BINPKG
2835 if (!local && strstr(pkgname, ".tar.gz")) {
2836 return handle_tgz(pkgname, s, prn);
2837 }
2838 #endif
2839
2840 if (!local && is_gretl_addon(pkgname)) {
2841 addon = 1;
2842 filetype = 2;
2843 if (strchr(pkgname, '.') == NULL) {
2844 gfname = g_strdup_printf("%s.zip", pkgname);
2845 fname = gfname;
2846 }
2847 goto next_step;
2848 }
2849
2850 if (!strncmp(pkgname, "http://", 7) ||
2851 !strncmp(pkgname, "https://", 8)) {
2852 http = 1;
2853 }
2854
2855 if (!local && !http && really_local(pkgname)) {
2856 local = 1;
2857 }
2858
2859 if (strstr(pkgname, ".gfn")) {
2860 filetype = 1;
2861 } else if (strstr(pkgname, ".zip")) {
2862 filetype = 2;
2863 } else if (local || http) {
2864 /* must have suitable suffix */
2865 err = E_DATA;
2866 } else {
2867 /* from gretl server: determine the correct suffix */
2868 fname = retrieve_remote_pkg_filename(pkgname, &err);
2869 if (!err) {
2870 filetype = strstr(fname, ".zip") ? 2 : 1;
2871 }
2872 }
2873
2874 if (!err) {
2875 if (http) {
2876 /* get @fname as last portion of URL */
2877 const char *p = strrchr(pkgname, '/');
2878
2879 if (p == NULL) {
2880 err = E_DATA;
2881 } else {
2882 fname = gretl_strdup(p + 1);
2883 }
2884 } else if (local) {
2885 const char *p;
2886
2887 gretl_maybe_switch_dir(pkgname);
2888 p = strrslash(pkgname);
2889 if (p != NULL) {
2890 fname = gretl_strdup(p + 1);
2891 }
2892 }
2893 }
2894
2895 next_step:
2896
2897 if (!err && filetype) {
2898 const char *basename = fname != NULL ? fname : pkgname;
2899 const char *instpath = gretl_function_package_path();
2900 gchar *fullname;
2901
2902 fullname = g_strdup_printf("%s%s", instpath, basename);
2903
2904 if (addon) {
2905 gchar *uri = get_uri_for_addon(basename, &err);
2906
2907 if (!err) {
2908 err = retrieve_public_file(uri, fullname);
2909 }
2910 g_free(uri);
2911 } else if (local) {
2912 err = gretl_copy_file(pkgname, fullname);
2913 } else if (http) {
2914 /* get file from a specified server */
2915 err = retrieve_public_file(pkgname, fullname);
2916 } else {
2917 /* get file from default gretl server */
2918 err = retrieve_remote_function_package(basename, fullname);
2919 }
2920
2921 if (!err && filetype == 2) {
2922 err = gretl_unzip_into(fullname, instpath);
2923 if (!err) {
2924 /* delete the zipfile */
2925 gretl_remove(fullname);
2926 }
2927 }
2928
2929 if (!err && !addon) {
2930 package_check_dependencies(fullname, s, prn);
2931 }
2932
2933 if (!err && gretl_messages_on()) {
2934 if (opt & OPT_D) {
2935 pprintf(prn, "Installed dependency %s\n", basename);
2936 } else {
2937 pprintf(prn, "Installed %s\n", basename);
2938 }
2939 }
2940
2941 if (!err && s != NULL && gui_callback != NULL &&
2942 !addon && !(opt & OPT_D)) {
2943 /* FIXME: handling of OPT_D here? */
2944 gretl_bundle *b = gretl_bundle_new();
2945 char *p, *nosfx = gretl_strdup(basename);
2946
2947 p = strrchr(nosfx, '.');
2948 if (p != NULL) {
2949 *p = '\0';
2950 }
2951 gretl_bundle_set_string(b, "filename", fullname);
2952 gretl_bundle_set_string(b, "pkgname", nosfx);
2953 gretl_bundle_set_int(b, "zipfile", filetype == 2);
2954 gui_callback(s, b, GRETL_OBJ_BUNDLE);
2955 free(nosfx);
2956 }
2957
2958 g_free(fullname);
2959 }
2960
2961 if (addon) {
2962 g_free(gfname);
2963 } else {
2964 free(fname);
2965 }
2966
2967 return err;
2968 }
2969
2970 #else /* !USE_CURL */
2971
2972 /* in this case we can only install from a local file */
2973
install_function_package(const char * pkgname,gretlopt opt,ExecState * s,PRN * prn)2974 static int install_function_package (const char *pkgname,
2975 gretlopt opt,
2976 ExecState *s,
2977 PRN *prn)
2978 {
2979 char *fname = NULL;
2980 int filetype = 0;
2981 int err = 0;
2982
2983 if (!strncmp(pkgname, "http://", 7) ||
2984 !strncmp(pkgname, "https://", 8)) {
2985 gretl_errmsg_set(_("Internet access not supported"));
2986 return E_DATA;
2987 }
2988
2989 if (strstr(pkgname, ".gfn")) {
2990 filetype = 1;
2991 } else if (strstr(pkgname, ".zip")) {
2992 filetype = 2;
2993 } else {
2994 /* must have suitable suffix */
2995 err = E_DATA;
2996 }
2997
2998 if (!err) {
2999 /* get last portion of local filename */
3000 const char *p;
3001
3002 gretl_maybe_switch_dir(pkgname);
3003 p = strrslash(pkgname);
3004 if (p != NULL) {
3005 fname = gretl_strdup(p + 1);
3006 }
3007 }
3008
3009 if (!err && filetype) {
3010 const char *basename = fname != NULL ? fname : pkgname;
3011 const char *instpath = gretl_function_package_path();
3012 gchar *fullname;
3013
3014 fullname = g_strdup_printf("%s%s", instpath, basename);
3015
3016 /* copy file into place */
3017 err = gretl_copy_file(pkgname, fullname);
3018
3019 if (!err && filetype == 2) {
3020 err = gretl_unzip_into(fullname, instpath);
3021 if (!err) {
3022 /* delete the zipfile */
3023 gretl_remove(fullname);
3024 }
3025 }
3026
3027 g_free(fullname);
3028
3029 if (!err && gretl_messages_on()) {
3030 pprintf(prn, "Installed %s\n", basename);
3031 }
3032 }
3033
3034 free(fname);
3035
3036 return err;
3037 }
3038
3039 #endif
3040
abort_execution(ExecState * s)3041 static void abort_execution (ExecState *s)
3042 {
3043 *s->cmd->savename = '\0';
3044 gretl_cmd_destroy_context(s->cmd);
3045 errmsg(E_STOP, s->prn);
3046 }
3047
3048 static int plot_ok;
3049
set_plot_produced(void)3050 void set_plot_produced (void)
3051 {
3052 plot_ok = 1;
3053 }
3054
is_plotting_command(CMD * cmd)3055 int is_plotting_command (CMD *cmd)
3056 {
3057 if (GRAPHING_COMMAND(cmd->ci)) {
3058 return cmd->ci;
3059 } else if (cmd->ci == END &&
3060 cmd->param != NULL &&
3061 !strcmp(cmd->param, "plot")) {
3062 return PLOT;
3063 } else {
3064 return 0;
3065 }
3066 }
3067
maybe_schedule_graph_callback(ExecState * s)3068 static void maybe_schedule_graph_callback (ExecState *s)
3069 {
3070 int gui_mode = gretl_in_gui_mode();
3071
3072 if (graph_written_to_file()) {
3073 if (gui_mode && *s->cmd->savename != '\0') {
3074 pprintf(s->prn, "Warning: ignoring \"%s <-\"\n", s->cmd->savename);
3075 }
3076 report_plot_written(s->prn);
3077 } else if (gui_mode && !graph_displayed()) {
3078 schedule_callback(s);
3079 }
3080 }
3081
execute_plot_call(CMD * cmd,DATASET * dset,char * line,PRN * prn)3082 static int execute_plot_call (CMD *cmd, DATASET *dset,
3083 char *line, PRN *prn)
3084 {
3085 gretlopt opt = cmd->opt;
3086 int err = 0;
3087
3088 if (gretl_in_gui_mode() && *cmd->savename != '\0') {
3089 /* saving plot "as icon": add internal option to
3090 override production of a "gpttmp" file
3091 */
3092 opt |= OPT_G;
3093 }
3094
3095 #if 1
3096 if (!gretl_in_gui_mode() && getenv("CLI_NO_PLOTS")
3097 && cmd->ci != END) {
3098 return 0;
3099 }
3100 #endif
3101
3102 if (cmd->ci == END) {
3103 /* end of a "plot" block */
3104 err = gretl_plot_finalize(line, dset, opt);
3105 } else if (opt & OPT_X) {
3106 err = matrix_command_driver(cmd->ci, cmd->list, cmd->param,
3107 dset, opt, prn);
3108 } else if (cmd->ci == GNUPLOT) {
3109 if (opt & OPT_I) {
3110 err = gnuplot_process_file(opt, prn);
3111 } else if (opt & OPT_C) {
3112 err = xy_plot_with_control(cmd->list, cmd->param,
3113 dset, opt);
3114 } else {
3115 err = gnuplot(cmd->list, cmd->param, dset, opt);
3116 }
3117 } else if (cmd->ci == SCATTERS) {
3118 err = multi_scatters(cmd->list, dset, opt);
3119 } else if (cmd->ci == BXPLOT) {
3120 err = boxplots(cmd->list, cmd->param, dset, opt);
3121 } else if (cmd->ci == HFPLOT) {
3122 err = hf_plot(cmd->list, cmd->param, dset, opt);
3123 } else if (cmd->ci == PANPLOT) {
3124 err = cli_panel_plot(cmd->list, cmd->param, dset, opt);
3125 } else if (cmd->ci == QQPLOT) {
3126 err = qq_plot(cmd->list, dset, opt);
3127 }
3128
3129 return err;
3130 }
3131
smpl_restrict(gretlopt opt)3132 static int smpl_restrict (gretlopt opt)
3133 {
3134 opt &= ~OPT_Q;
3135 opt &= ~OPT_T;
3136 return opt != OPT_NONE;
3137 }
3138
check_smpl_full(gretlopt opt)3139 static int check_smpl_full (gretlopt opt)
3140 {
3141 opt ^= OPT_F;
3142 if (opt & OPT_Q) {
3143 opt ^= OPT_Q;
3144 }
3145 return opt == OPT_NONE ? 0 : E_BADOPT;
3146 }
3147
panel_smpl_special(gretlopt opt)3148 static int panel_smpl_special (gretlopt opt)
3149 {
3150 /* --unit [or, maybe someday, --time] */
3151 return opt & OPT_U;
3152 }
3153
maybe_print_error_message(CMD * cmd,int err,PRN * prn)3154 static void maybe_print_error_message (CMD *cmd, int err, PRN *prn)
3155 {
3156 if (gretl_function_depth() > 0) {
3157 ; /* defer printing */
3158 } else if (cmd->flags & CMD_CATCH) {
3159 /* print only if messages on */
3160 if (gretl_messages_on()) {
3161 errmsg(err, prn);
3162 }
3163 } else {
3164 /* otherwise go ahead and print */
3165 errmsg(err, prn);
3166 }
3167 }
3168
gretl_cmd_exec(ExecState * s,DATASET * dset)3169 int gretl_cmd_exec (ExecState *s, DATASET *dset)
3170 {
3171 CMD *cmd = s->cmd;
3172 char *line = s->line;
3173 MODEL *model = s->model;
3174 PRN *prn = s->prn;
3175 char readfile[MAXLEN];
3176 int *listcpy = NULL;
3177 int err = 0;
3178
3179 exec_state_prep(s);
3180 plot_ok = 0;
3181
3182 if (gretl_in_gui_mode() && check_for_stop()) {
3183 /* the GUI user clicked the "Stop" button */
3184 abort_execution(s);
3185 return E_STOP;
3186 }
3187
3188 if (NEEDS_MODEL_CHECK(cmd->ci)) {
3189 err = model_test_check(cmd, dset, prn);
3190 } else if (MODIFIES_LIST(cmd->ci)) {
3191 if (cmd->list[0] == 0) {
3192 /* no-op */
3193 return 0;
3194 } else {
3195 /* list is potentially modified -> make a copy */
3196 listcpy = gretl_list_copy(cmd->list);
3197 if (listcpy == NULL) {
3198 err = E_ALLOC;
3199 }
3200 }
3201 }
3202
3203 if (err) {
3204 goto bailout;
3205 }
3206
3207 *readfile = '\0';
3208
3209 if (cmd->ci == OLS && dataset_is_panel(dset)) {
3210 cmd->ci = PANEL;
3211 cmd->opt |= OPT_P; /* panel pooled OLS flag */
3212 }
3213
3214 #if 0
3215 fprintf(stderr, "gretl_cmd_exec: '%s' (ci %d) \n", line, cmd->ci);
3216 #endif
3217
3218 switch (cmd->ci) {
3219
3220 case APPEND:
3221 case JOIN:
3222 case OPEN:
3223 if (cmd->ci == JOIN && (dset == NULL || dset->v == 0)) {
3224 /* "join" is not applicable in the absence of
3225 a dataset */
3226 err = E_NODATA;
3227 } else {
3228 err = lib_open_append(s, dset, readfile, prn);
3229 }
3230 if (!err && cmd->ci != OPEN) {
3231 schedule_callback(s);
3232 }
3233 break;
3234
3235 case CLEAR:
3236 err = check_clear(cmd->opt);
3237 if (!err) {
3238 if (cmd->opt & OPT_F) {
3239 gretl_functions_cleanup();
3240 } else if (gretl_in_gui_mode()) {
3241 schedule_callback(s);
3242 } else {
3243 lib_clear_data(s, dset);
3244 }
3245 }
3246 break;
3247
3248 case FLUSH:
3249 if (gretl_in_gui_mode()) {
3250 schedule_callback(s);
3251 } else {
3252 gretl_print_flush_stream(prn);
3253 }
3254 break;
3255
3256 case ANOVA:
3257 err = anova(cmd->list, dset, cmd->opt, prn);
3258 break;
3259
3260 case ADF:
3261 err = adf_test(cmd->order, cmd->list, dset, cmd->opt, prn);
3262 break;
3263
3264 case KPSS:
3265 err = kpss_test(cmd->order, cmd->list, dset, cmd->opt, prn);
3266 break;
3267
3268 case LEVINLIN:
3269 err = llc_test_driver(cmd->param, cmd->list, dset,
3270 cmd->opt, prn);
3271 break;
3272
3273 case COINT:
3274 err = engle_granger_test(cmd->order, cmd->list, dset,
3275 cmd->opt, prn);
3276 break;
3277
3278 case COINT2:
3279 err = johansen_test_simple(cmd->order, cmd->list,
3280 dset, cmd->opt, prn);
3281 break;
3282
3283 case CORR:
3284 err = incompatible_options(cmd->opt, OPT_N | OPT_S | OPT_K);
3285 if (!err) {
3286 err = incompatible_options(cmd->opt, OPT_X | OPT_S | OPT_K);
3287 }
3288 if (err) {
3289 break;
3290 }
3291 if (cmd->opt & OPT_K) {
3292 err = kendall_tau(cmd->list, dset, cmd->opt, prn);
3293 } else if (cmd->opt & OPT_S) {
3294 err = spearman_rho(cmd->list, dset, cmd->opt, prn);
3295 } else if (cmd->opt & OPT_X) {
3296 err = matrix_command_driver(CORR, cmd->list, cmd->param,
3297 dset, cmd->opt, prn);
3298 } else {
3299 err = gretl_corrmx(cmd->list, dset, cmd->opt, prn);
3300 }
3301 break;
3302
3303 case CORRGM:
3304 err = corrgram(cmd->list[1], cmd->order, 0, dset,
3305 cmd->opt, prn);
3306 break;
3307
3308 case XCORRGM:
3309 err = xcorrgram(cmd->list, cmd->order, dset,
3310 cmd->opt, prn);
3311 break;
3312
3313 case PERGM:
3314 err = periodogram(cmd->list[1], cmd->order, dset,
3315 cmd->opt, prn);
3316 break;
3317
3318 case FRACTINT:
3319 err = fractint(cmd->list[1], cmd->order, dset,
3320 cmd->opt, prn);
3321 break;
3322
3323 case FUNDEBUG:
3324 err = do_debug_command(s, cmd->param, cmd->opt);
3325 break;
3326
3327 case BREAK:
3328 case ENDLOOP:
3329 pprintf(prn, _("You can't end a loop here, "
3330 "you haven't started one\n"));
3331 err = 1;
3332 break;
3333
3334 case FCAST:
3335 err = do_forecast(cmd->param, dset, cmd->opt, prn);
3336 break;
3337
3338 case FREQ:
3339 if (cmd->opt & OPT_X) {
3340 err = matrix_freq_driver(cmd->list, cmd->opt, prn);
3341 } else {
3342 err = freqdist(cmd->list[1], dset, cmd->opt, prn);
3343 }
3344 break;
3345
3346 case DISCRETE:
3347 err = list_makediscrete(cmd->list, dset, cmd->opt);
3348 break;
3349
3350 case ESTIMATE:
3351 err = estimate_named_system(cmd->param, cmd->parm2, dset,
3352 cmd->opt, prn);
3353 if (!err && (cmd->opt & OPT_W) && gretl_in_gui_mode()) {
3354 gui_save_system(s);
3355 }
3356 break;
3357
3358 case FUNC:
3359 err = gretl_start_compiling_function(cmd->param, dset, prn);
3360 break;
3361
3362 case GENR:
3363 case EVAL:
3364 if (cmd->flags & CMD_CATCH) {
3365 err = generate(cmd->vstart, dset, cmd->gtype,
3366 cmd->opt | OPT_C, prn);
3367 if (err == E_BADCATCH) {
3368 cmd->flags ^= CMD_CATCH;
3369 }
3370 } else {
3371 err = generate(cmd->vstart, dset, cmd->gtype,
3372 cmd->opt, prn);
3373 }
3374 break;
3375
3376 case PCA:
3377 err = do_pca(cmd->list, dset, cmd->opt, prn);
3378 break;
3379
3380 case DATA:
3381 err = db_get_series(cmd->param, dset, cmd->opt, prn);
3382 break;
3383
3384 case DATAMOD:
3385 err = modify_dataset(dset, cmd->auxint, cmd->list,
3386 cmd->parm2, cmd->opt, prn);
3387 if (!err) {
3388 schedule_callback(s);
3389 }
3390 break;
3391
3392 case DIFF:
3393 case LDIFF:
3394 case SDIFF:
3395 err = list_diffgenr(listcpy, cmd->ci, dset);
3396 if (!err) {
3397 maybe_list_series(dset, prn);
3398 set_dataset_is_changed(dset, 1);
3399 }
3400 break;
3401
3402 case ORTHDEV:
3403 err = list_orthdev(listcpy, dset);
3404 if (!err) {
3405 maybe_list_series(dset, prn);
3406 set_dataset_is_changed(dset, 1);
3407 }
3408 break;
3409
3410 case DUMMIFY:
3411 err = list_dumgenr(&listcpy, dset, cmd->opt);
3412 if (!err) {
3413 maybe_list_series(dset, prn);
3414 set_dataset_is_changed(dset, 1);
3415 }
3416 break;
3417
3418 case LAGS:
3419 err = list_laggenr(&listcpy, 1, cmd->order, NULL,
3420 dset, 0, cmd->opt);
3421 if (!err) {
3422 maybe_list_series(dset, prn);
3423 set_dataset_is_changed(dset, 1);
3424 }
3425 break;
3426
3427 case LOGS:
3428 err = list_loggenr(listcpy, dset);
3429 if (!err) {
3430 maybe_list_series(dset, prn);
3431 set_dataset_is_changed(dset, 1);
3432 }
3433 break;
3434
3435 case STDIZE:
3436 err = list_stdgenr(listcpy, dset, cmd->opt);
3437 if (!err) {
3438 maybe_list_series(dset, prn);
3439 set_dataset_is_changed(dset, 1);
3440 }
3441 break;
3442
3443 case SQUARE:
3444 err = list_xpxgenr(&listcpy, dset, cmd->opt);
3445 if (!err) {
3446 maybe_list_series(dset, prn);
3447 set_dataset_is_changed(dset, 1);
3448 }
3449 break;
3450
3451 case TEXTPLOT:
3452 err = textplot(cmd->list, dset, cmd->opt, prn);
3453 break;
3454
3455 case RMPLOT:
3456 err = rmplot(cmd->list, dset, cmd->opt, prn);
3457 break;
3458
3459 case HURST:
3460 err = hurstplot(cmd->list, dset, cmd->opt, prn);
3461 break;
3462
3463 case INFO:
3464 print_info(cmd->opt, dset, prn);
3465 break;
3466
3467 case RENAME:
3468 err = dataset_rename_series(dset, cmd->auxint, cmd->parm2);
3469 if (!err && !(cmd->opt & OPT_Q)) {
3470 maybe_list_series(dset, prn);
3471 }
3472 break;
3473
3474 case SET:
3475 err = execute_set(cmd->param, cmd->parm2, dset, cmd->opt, prn);
3476 if (!err && cmd->parm2 != NULL) {
3477 maybe_schedule_set_callback(s);
3478 }
3479 break;
3480
3481 case SETINFO:
3482 err = set_var_info(cmd->list, cmd->param, cmd->parm2,
3483 cmd->opt, dset);
3484 break;
3485
3486 case SETMISS:
3487 err = set_miss(cmd->list, cmd->param, dset, prn);
3488 break;
3489
3490 case LABELS:
3491 if (cmd->opt & (OPT_D | OPT_F | OPT_T | OPT_A | OPT_R)) {
3492 err = read_or_write_var_labels(cmd->opt, dset, prn);
3493 if (!err && (cmd->opt & (OPT_D | OPT_F))) {
3494 schedule_callback(s);
3495 }
3496 } else {
3497 showlabels(cmd->list, cmd->opt, dset, prn);
3498 }
3499 break;
3500
3501 case MARKERS:
3502 err = read_or_write_obs_markers(cmd->opt, dset, prn);
3503 if (!err && (cmd->opt & (OPT_D | OPT_F))) {
3504 schedule_callback(s);
3505 }
3506 break;
3507
3508 case VARLIST:
3509 if (cmd->opt & OPT_T) {
3510 list_user_vars_of_type(dset, prn);
3511 } else if (cmd->opt & OPT_S) {
3512 print_scalars(prn);
3513 } else if (cmd->opt & OPT_A) {
3514 list_ok_dollar_vars(dset, prn);
3515 } else {
3516 list_series(dset, cmd->opt, prn);
3517 }
3518 break;
3519
3520 case PRINT:
3521 if (cmd->opt & OPT_L) {
3522 err = printdata(NULL, cmd->param, dset, OPT_NONE, prn);
3523 } else if (cmd->param != NULL) {
3524 /* directly printing a string literal */
3525 pputs(prn, cmd->param);
3526 pputc(prn, '\n');
3527 } else {
3528 err = printdata(cmd->list, cmd->parm2, dset, cmd->opt, prn);
3529 }
3530 break;
3531
3532 case PRINTF:
3533 case SSCANF:
3534 err = do_printscan_command(cmd->ci, cmd->param, cmd->parm2,
3535 cmd->vstart, dset, prn);
3536 break;
3537
3538 case PVAL:
3539 err = batch_pvalue(cmd->param, dset, prn);
3540 break;
3541
3542 case SUMMARY:
3543 err = incompatible_options(cmd->opt, OPT_B | OPT_W);
3544 if (err) {
3545 break;
3546 }
3547 if (cmd->opt & OPT_B) {
3548 err = do_command_by(cmd, dset, prn);
3549 } else if (cmd->opt & OPT_X) {
3550 err = matrix_command_driver(cmd->ci, cmd->list, cmd->param,
3551 dset, cmd->opt, prn);
3552 } else {
3553 err = list_summary_driver(cmd->list, dset, cmd->opt, prn);
3554 }
3555 break;
3556
3557 case XTAB:
3558 if (cmd->opt & OPT_X) {
3559 err = crosstab_from_matrix(cmd->opt, prn);
3560 } else {
3561 err = crosstab(cmd->list, dset, cmd->opt, prn);
3562 }
3563 break;
3564
3565 case MAHAL:
3566 err = mahalanobis_distance(cmd->list, dset, cmd->opt, prn);
3567 break;
3568
3569 case MEANTEST:
3570 err = means_test(cmd->list, dset, cmd->opt, prn);
3571 break;
3572
3573 case VARTEST:
3574 err = vars_test(cmd->list, dset, prn);
3575 break;
3576
3577 case RUNS:
3578 err = runs_test(cmd->list[1], dset, cmd->opt, prn);
3579 break;
3580
3581 case SPEARMAN:
3582 err = spearman_rho(cmd->list, dset, cmd->opt, prn);
3583 break;
3584
3585 case DIFFTEST:
3586 err = diff_test(cmd->list, dset, cmd->opt, prn);
3587 break;
3588
3589 case OUTFILE:
3590 err = do_outfile_command(cmd->opt, cmd->param, dset, prn);
3591 break;
3592
3593 case SETOBS:
3594 err = set_obs(cmd->param, cmd->parm2, dset, cmd->opt);
3595 if (!err) {
3596 if (dset->n > 0) {
3597 if (!(cmd->opt & (OPT_I | OPT_G))) {
3598 print_smpl(dset, 0, OPT_NONE, prn);
3599 }
3600 schedule_callback(s);
3601 } else {
3602 pprintf(prn, _("data frequency = %d\n"), dset->pd);
3603 }
3604 }
3605 break;
3606
3607 case SETOPT:
3608 err = set_options_for_command(cmd->param, cmd->parm2, cmd->opt);
3609 if (!err && gretl_messages_on()) {
3610 pprintf(prn, "Set option(s) for command \"%s\"\n", cmd->param);
3611 }
3612 break;
3613
3614 case SMPL:
3615 if (cmd->opt & OPT_F) {
3616 err = check_smpl_full(cmd->opt);
3617 if (!err) {
3618 err = restore_full_sample(dset, s);
3619 }
3620 } else if (cmd->opt == OPT_T && cmd->param == NULL) {
3621 /* --permanent, by itself */
3622 err = perma_sample(dset, cmd->opt, prn, NULL);
3623 } else if (panel_smpl_special(cmd->opt)) {
3624 /* the panel --unit option */
3625 err = set_panel_sample(cmd->param, cmd->parm2, cmd->opt, dset);
3626 } else if (smpl_restrict(cmd->opt)) {
3627 /* --restrict, --dummy, etc. */
3628 err = restrict_sample(cmd->param, cmd->list, dset,
3629 s, cmd->opt, prn, NULL);
3630 } else if (cmd->param == NULL && cmd->parm2 == NULL) {
3631 /* no args given: give a report */
3632 print_smpl(dset, get_full_length_n(), OPT_F, prn);
3633 break;
3634 } else {
3635 /* simple setting of t1, t2 business */
3636 err = set_sample(cmd->param, cmd->parm2, dset, cmd->opt);
3637 }
3638 if (!err && gretl_messages_on() && !(cmd->opt & OPT_Q)) {
3639 print_smpl(dset, get_full_length_n(), OPT_NONE, prn);
3640 }
3641 break;
3642
3643 case PKG:
3644 err = do_pkg_command(cmd->param, cmd->parm2, cmd->opt, s, prn);
3645 break;
3646
3647 case MAKEPKG:
3648 err = create_and_write_function_package(cmd->param, cmd->opt, prn);
3649 break;
3650
3651 case STORE:
3652 if (!has_param(cmd)) {
3653 pputs(prn, _("store: no filename given\n"));
3654 err = E_PARSE;
3655 } else if (cmd->opt & OPT_A) {
3656 err = write_matrix_as_dataset(cmd->param, cmd->opt, prn);
3657 } else if (dset == NULL || dset->Z == NULL) {
3658 err = E_NODATA;
3659 } else {
3660 err = write_data(cmd->param, cmd->list, dset, cmd->opt, prn);
3661 }
3662 break;
3663
3664 case SHELL:
3665 err = gretl_shell(cmd->vstart, cmd->opt, prn);
3666 break;
3667
3668 case OLS:
3669 case WLS:
3670 clear_model(model);
3671 *model = lsq(cmd->list, dset, cmd->ci, cmd->opt);
3672 err = print_save_model(model, dset, cmd->opt, 0, prn, s);
3673 break;
3674
3675 case MPOLS:
3676 clear_model(model);
3677 *model = mp_ols(cmd->list, dset, cmd->opt);
3678 err = print_save_model(model, dset, cmd->opt, 0, prn, s);
3679 break;
3680
3681 case AR:
3682 case AR1:
3683 case ARMA:
3684 case ARCH:
3685 clear_model(model);
3686 if (cmd->ci == AR) {
3687 *model = ar_model(cmd->list, dset, cmd->opt, prn);
3688 } else if (cmd->ci == AR1) {
3689 *model = ar1_model(cmd->list, dset, cmd->opt, prn);
3690 } else if (cmd->ci == ARMA) {
3691 *model = arma(cmd->list, cmd->auxlist, dset,
3692 cmd->opt, prn);
3693 } else {
3694 *model = arch_model(cmd->list, cmd->order, dset,
3695 cmd->opt);
3696 }
3697 err = print_save_model(model, dset, cmd->opt, 0, prn, s);
3698 break;
3699
3700 case PANEL:
3701 case DPANEL:
3702 if (!dataset_is_panel(dset)) {
3703 gretl_errmsg_set(_("This estimator requires panel data"));
3704 err = E_DATA;
3705 break;
3706 }
3707 /* Falls through. */
3708 case GARCH:
3709 case HECKIT:
3710 case HSK:
3711 case INTREG:
3712 case IVREG:
3713 case LAD:
3714 case LOGISTIC:
3715 case LOGIT:
3716 case POISSON:
3717 case NEGBIN:
3718 case PROBIT:
3719 case QUANTREG:
3720 case TOBIT:
3721 case DURATION:
3722 case BIPROBIT:
3723 case MIDASREG:
3724 clear_model(model);
3725 if (cmd->ci == LOGIT || cmd->ci == PROBIT) {
3726 *model = logit_probit(cmd->list, dset, cmd->ci, cmd->opt, prn);
3727 } else if (cmd->ci == HSK) {
3728 *model = hsk_model(cmd->list, dset, cmd->opt);
3729 } else if (cmd->ci == LOGISTIC) {
3730 *model = logistic_driver(cmd->list, dset, cmd->opt);
3731 } else if (cmd->ci == TOBIT) {
3732 *model = tobit_driver(cmd->list, dset, cmd->opt, prn);
3733 } else if (cmd->ci == POISSON || cmd->ci == NEGBIN) {
3734 *model = count_model(cmd->list, cmd->ci, dset, cmd->opt, prn);
3735 } else if (cmd->ci == HECKIT) {
3736 *model = heckit_model(cmd->list, dset, cmd->opt, prn);
3737 } else if (cmd->ci == IVREG) {
3738 *model = ivreg(cmd->list, dset, cmd->opt);
3739 } else if (cmd->ci == LAD) {
3740 *model = lad_model(cmd->list, dset, cmd->opt);
3741 } else if (cmd->ci == QUANTREG) {
3742 *model = quantreg_driver(cmd->param, cmd->list, dset,
3743 cmd->opt, prn);
3744 } else if (cmd->ci == DURATION) {
3745 *model = duration_model(cmd->list, dset, cmd->opt, prn);
3746 } else if (cmd->ci == GARCH) {
3747 *model = garch(cmd->list, dset, cmd->opt, prn);
3748 } else if (cmd->ci == PANEL) {
3749 *model = panel_model(cmd->list, dset, cmd->opt, prn);
3750 } else if (cmd->ci == DPANEL) {
3751 *model = dpd_model(cmd->list, cmd->auxlist, cmd->param,
3752 dset, cmd->opt, prn);
3753 } else if (cmd->ci == INTREG) {
3754 *model = interval_model(cmd->list, dset, cmd->opt, prn);
3755 } else if (cmd->ci == BIPROBIT) {
3756 *model = biprobit_model(cmd->list, dset, cmd->opt, prn);
3757 } else if (cmd->ci == MIDASREG) {
3758 *model = midas_model(cmd->list, cmd->param, dset,
3759 cmd->opt, prn);
3760 } else {
3761 /* can't happen */
3762 err = 1;
3763 break;
3764 }
3765 err = print_save_model(model, dset, cmd->opt, 0, prn, s);
3766 break;
3767
3768 case GMM:
3769 case MLE:
3770 case NLS:
3771 err = nl_parse_line(cmd->ci, cmd->vstart, dset, prn);
3772 if (!err) {
3773 gretl_cmd_set_context(cmd, cmd->ci);
3774 }
3775 break;
3776
3777 case FOREIGN:
3778 case MPI:
3779 if (cmd->context == FOREIGN || cmd->context == MPI) {
3780 err = foreign_append(line, cmd->context);
3781 } else {
3782 err = foreign_start(cmd->ci, cmd->param, cmd->opt, prn);
3783 if (!err) {
3784 gretl_cmd_set_context(cmd, cmd->ci);
3785 }
3786 }
3787 break;
3788
3789 case PLOT:
3790 if (!cmd->context) {
3791 err = gretl_plot_start(cmd->param, dset);
3792 } else {
3793 err = gretl_plot_append_line(line, dset);
3794 }
3795 if (!err && !cmd->context) {
3796 gretl_cmd_set_context(cmd, cmd->ci);
3797 }
3798 break;
3799
3800 case ADD:
3801 case OMIT:
3802 if (get_last_model_type() == GRETL_OBJ_VAR) {
3803 err = VAR_omit_driver(cmd, dset, prn);
3804 } else if (add_omit_save(cmd, model)) {
3805 MODEL mymod;
3806
3807 gretl_model_init(&mymod, dset);
3808 if (cmd->ci == ADD) {
3809 err = add_test_full(model, &mymod, cmd->list,
3810 dset, cmd->opt, prn);
3811 } else {
3812 err = omit_test_full(model, &mymod, cmd->list,
3813 dset, cmd->opt, prn);
3814 }
3815 if (!err && mymod.ncoeff > 0) {
3816 gretlopt popt = OPT_NONE;
3817
3818 if (cmd->opt & (OPT_I | OPT_Q)) {
3819 popt = OPT_Q;
3820 } else if (cmd->opt & OPT_O) {
3821 popt = OPT_O; /* --vcv printing option */
3822 }
3823 clear_model(model);
3824 *model = mymod;
3825 print_save_model(model, dset, popt, 1, prn, s);
3826 }
3827 } else if (cmd->ci == ADD) {
3828 err = add_test(model, cmd->list, dset, cmd->opt, prn);
3829 } else {
3830 err = omit_test(model, cmd->list, dset, cmd->opt, prn);
3831 }
3832 if (err == E_NOOMIT) {
3833 /* auto-omit was a no-op */
3834 err = 0;
3835 }
3836 break;
3837
3838 case BKW:
3839 case COEFFSUM:
3840 case CUSUM:
3841 case RESET:
3842 case CHOW:
3843 case QLRTEST:
3844 case VIF:
3845 if (cmd->ci == COEFFSUM) {
3846 err = gretl_sum_test(cmd->list, model, dset, cmd->opt, prn);
3847 } else if (cmd->ci == CUSUM) {
3848 err = cusum_test(model, dset, cmd->opt, prn);
3849 } else if (cmd->ci == RESET) {
3850 err = reset_test(model, dset, cmd->opt, prn);
3851 } else if (cmd->ci == CHOW) {
3852 err = chow_test_driver(cmd->param, model, dset, cmd->opt, prn);
3853 } else if (cmd->ci == QLRTEST) {
3854 err = QLR_test(model, dset, cmd->opt, prn);
3855 } else if (cmd->ci == VIF) {
3856 err = vif_test(model, dset, cmd->opt, prn);
3857 } else if (cmd->ci == BKW) {
3858 err = bkw_test(model, dset, cmd->opt, prn);
3859 }
3860 break;
3861
3862 case BDS:
3863 err = bds_test_driver(cmd->order, cmd->list, dset,
3864 cmd->opt, prn);
3865 break;
3866
3867 case NORMTEST:
3868 err = gretl_normality_test(cmd->list[1], dset, cmd->opt, prn);
3869 break;
3870
3871 case PANSPEC:
3872 err = panel_specification_test(model, dset, cmd->opt, prn);
3873 break;
3874
3875 case MODTEST:
3876 err = model_test_driver(cmd->order, dset, cmd->opt, prn);
3877 break;
3878
3879 case LEVERAGE:
3880 err = leverage_test(model, dset, cmd->opt, prn);
3881 if (!err && (cmd->opt & OPT_S) && !(cmd->opt & OPT_Q)) {
3882 maybe_list_series(dset, prn);
3883 }
3884 break;
3885
3886 case EQNPRINT:
3887 case TABPRINT:
3888 if (model->errcode == E_NAN) {
3889 pprintf(prn, _("Couldn't format model\n"));
3890 } else {
3891 err = model_print_driver(model, dset, cmd->ci,
3892 cmd->param, cmd->opt,
3893 prn);
3894 }
3895 break;
3896
3897 case RESTRICT:
3898 /* joint hypothesis test on model */
3899 if (s->rset == NULL) {
3900 if (!has_param(cmd)) {
3901 /* if param is non-blank, we're restricting a named system */
3902 err = model_test_check(cmd, dset, prn);
3903 if (err) break;
3904 }
3905 s->rset = restriction_set_start(cmd->param, cmd->opt, &err);
3906 if (!err) {
3907 /* FIXME redundant? */
3908 gretl_cmd_set_context(cmd, RESTRICT);
3909 }
3910 } else {
3911 err = restriction_set_parse_line(s->rset, line, dset);
3912 if (err) {
3913 s->rset = NULL;
3914 }
3915 }
3916 break;
3917
3918 case SYSTEM:
3919 if (s->sys == NULL) {
3920 /* no equation system is defined currently */
3921 s->sys = equation_system_start(cmd->param, cmd->savename,
3922 cmd->opt, &err);
3923 if (!err) {
3924 gretl_cmd_set_context(cmd, SYSTEM);
3925 }
3926 } else {
3927 /* tokenize: use of @line OK here? */
3928 err = system_parse_line(s->sys, line, dset);
3929 if (err) {
3930 s->sys = NULL;
3931 }
3932 }
3933 break;
3934
3935 case EQUATION:
3936 if (cmd->opt & OPT_M) {
3937 err = equation_system_append_multi(s->sys, cmd->param,
3938 cmd->parm2, dset);
3939 } else {
3940 err = equation_system_append(s->sys, cmd->list);
3941 }
3942 if (err) {
3943 s->sys = NULL;
3944 }
3945 break;
3946
3947 case END:
3948 if (!strcmp(cmd->param, "system")) {
3949 err = equation_system_finalize(s->sys, dset, cmd->opt, prn);
3950 if (!err) {
3951 gui_save_system(s);
3952 }
3953 /* clear for next use */
3954 s->sys = NULL;
3955 } else if (!strcmp(cmd->param, "mle") ||
3956 !strcmp(cmd->param, "nls") ||
3957 !strcmp(cmd->param, "gmm")) {
3958 clear_model(model);
3959 *model = nl_model(dset, cmd->opt, prn);
3960 err = print_save_model(model, dset, cmd->opt, 0, prn, s);
3961 } else if (!strcmp(cmd->param, "restrict")) {
3962 err = do_end_restrict(s, dset);
3963 } else if (!strcmp(cmd->param, "foreign")) {
3964 err = foreign_execute(dset, cmd->opt, prn);
3965 } else if (!strcmp(cmd->param, "mpi")) {
3966 err = foreign_execute(dset, cmd->opt, prn);
3967 } else if (!strcmp(cmd->param, "plot")) {
3968 err = execute_plot_call(cmd, dset, line, prn);
3969 } else if (!strcmp(cmd->param, "outfile")) {
3970 err = do_outfile_command(OPT_C, NULL, NULL, prn);
3971 } else {
3972 err = E_PARSE;
3973 }
3974 break;
3975
3976 case VAR:
3977 case VECM:
3978 if (cmd->ci == VAR) {
3979 s->var = gretl_VAR(cmd->order, cmd->auxlist, cmd->list,
3980 dset, cmd->opt, prn, &err);
3981 } else {
3982 s->var = gretl_VECM(cmd->order, cmd->auxint, cmd->list,
3983 dset, cmd->opt, prn, &err);
3984 }
3985 if (!err && s->var != NULL) {
3986 save_var_vecm(s);
3987 }
3988 break;
3989
3990 case RUN:
3991 case INCLUDE:
3992 if (cmd->ci == RUN) {
3993 err = get_full_filename(cmd->param, readfile, OPT_S);
3994 } else {
3995 err = get_full_filename(cmd->param, readfile, OPT_I);
3996 cmd->opt |= OPT_Q;
3997 }
3998 if (err) {
3999 break;
4000 }
4001 if (gretl_messages_on()) {
4002 pprintf(prn, " %s\n", readfile);
4003 }
4004 if (cmd->ci == INCLUDE && gretl_is_xml_file(readfile)) {
4005 err = load_XML_functions_file(readfile, cmd->opt, prn);
4006 break;
4007 } else if (cmd->ci == INCLUDE && gfn_is_loaded(readfile)) {
4008 break;
4009 }
4010 if (!strcmp(readfile, s->runfile)) {
4011 pprintf(prn, _("Infinite loop detected in script\n"));
4012 err = 1;
4013 break;
4014 }
4015 err = run_script(readfile, s, dset, cmd->opt, prn);
4016 break;
4017
4018 case FUNCERR:
4019 case FUNCRET:
4020 if (gretl_function_depth() == 0) {
4021 gretl_errmsg_sprintf("'%s': can only be used within a function",
4022 gretl_command_word(cmd->ci));
4023 err = 1;
4024 } else if (cmd->ci == FUNCERR) {
4025 err = E_FUNCERR;
4026 }
4027 break;
4028
4029 case DELEET:
4030 err = gretl_delete_variables(cmd->list, cmd->param, cmd->opt,
4031 dset, NULL, prn);
4032 break;
4033
4034 case MODPRINT:
4035 err = do_modprint(cmd->param, cmd->parm2, cmd->opt, prn);
4036 break;
4037
4038 case GNUPLOT:
4039 case BXPLOT:
4040 case SCATTERS:
4041 case HFPLOT:
4042 case PANPLOT:
4043 case QQPLOT:
4044 err = execute_plot_call(cmd, dset, NULL, prn);
4045 break;
4046
4047 case MODELTAB:
4048 case GRAPHPG:
4049 if (gretl_in_gui_mode()) {
4050 schedule_callback(s);
4051 } else {
4052 pprintf(prn, _("%s: command not available\n"),
4053 gretl_command_word(cmd->ci));
4054 }
4055 break;
4056
4057 default:
4058 {
4059 const char *word = gretl_command_word(cmd->ci);
4060
4061 if (*word != '\0') {
4062 pprintf(prn, _("The \"%s\" command cannot be used in this context"),
4063 word);
4064 pputc(prn, '\n');
4065 } else {
4066 pprintf(prn, "What??\n");
4067 }
4068 }
4069 err = 1;
4070 break;
4071 }
4072
4073 if (listcpy != NULL) {
4074 free(listcpy);
4075 }
4076
4077 if (err == E_OK) {
4078 err = 0;
4079 }
4080
4081 if (!err && plot_ok) {
4082 maybe_schedule_graph_callback(s);
4083 plot_ok = 0;
4084 }
4085
4086 if (callback_scheduled(s)) {
4087 callback_exec(s, readfile, err);
4088 }
4089
4090 bailout:
4091
4092 if (err) {
4093 maybe_print_error_message(cmd, err, prn);
4094 err = process_command_error(s, err);
4095 }
4096
4097 if (err) {
4098 gretl_cmd_destroy_context(cmd);
4099 } else {
4100 /* this is a no-op if there's no warning */
4101 warnmsg(prn);
4102 }
4103
4104 return err;
4105 }
4106
4107 /* called by functions, and by scripts executed from within
4108 functions */
4109
maybe_exec_line(ExecState * s,DATASET * dset,int * loopstart)4110 int maybe_exec_line (ExecState *s, DATASET *dset, int *loopstart)
4111 {
4112 int err = 0;
4113
4114 if (string_is_blank(s->line)) {
4115 return 0;
4116 }
4117
4118 if (gretl_compiling_loop()) {
4119 err = get_command_index(s, LOOP);
4120 } else {
4121 /* FIXME last arg to parse_command_line() ? */
4122 err = parse_command_line(s, dset, NULL);
4123 if (!err && loopstart != NULL && s->cmd->ci == LOOP) {
4124 *loopstart = 1;
4125 }
4126 }
4127
4128 if (err) {
4129 errmsg(err, s->prn);
4130 if (s->cmd->flags & CMD_CATCH) {
4131 set_gretl_errno(err);
4132 return 0;
4133 } else {
4134 return err;
4135 }
4136 }
4137
4138 gretl_exec_state_transcribe_flags(s, s->cmd);
4139
4140 if (s->cmd->ci < 0) {
4141 return 0; /* nothing there, or a comment */
4142 }
4143
4144 if (s->cmd->ci == LOOP || gretl_compiling_loop()) {
4145 /* accumulating loop commands */
4146 err = gretl_loop_append_line(s, dset);
4147 if (err) {
4148 errmsg(err, s->prn);
4149 return err;
4150 }
4151 return 0;
4152 }
4153
4154 s->pmod = NULL; /* be on the safe side */
4155
4156 if (s->cmd->ci == FUNCERR) {
4157 err = E_FUNCERR;
4158 } else {
4159 /* note: error messages may be printed to s->prn */
4160 err = gretl_cmd_exec(s, dset);
4161 }
4162
4163 return err;
4164 }
4165
4166 /**
4167 * get_command_index:
4168 * @s: pointer to execution state
4169 * @cmode: compilation mode: LOOP or FUNC
4170 *
4171 * Parse @line and assign to the %ci field of @s->cmd the index number of
4172 * the command embedded in @s->line. Note: this is a "lite" version of
4173 * parse_command_line(). It is used when commands are being stacked
4174 * for execution within a loop. Command options are not parsed out.
4175 *
4176 * Returns: 1 on error, otherwise 0.
4177 */
4178
get_command_index(ExecState * s,int cmode)4179 int get_command_index (ExecState *s, int cmode)
4180 {
4181 CMD *cmd = s->cmd;
4182 char *line = s->line;
4183 int err = 0;
4184
4185 gretl_cmd_clear(cmd);
4186
4187 #if CMD_DEBUG
4188 fprintf(stderr, "get_command_index2: line='%s'\n", line);
4189 #endif
4190
4191 if ((cmd->context == FOREIGN || cmd->context == MPI) &&
4192 !ends_foreign_block(line)) {
4193 cmd->opt = OPT_NONE;
4194 cmd->ci = cmd->context;
4195 return 0;
4196 }
4197
4198 if (filter_comments(line, cmd)) {
4199 return 0;
4200 }
4201
4202 err = real_parse_command(s, NULL, cmode, NULL);
4203
4204 if (!err && cmd->ci == 0) {
4205 /* maybe genr via series name? */
4206 const char *s = cmd->toks[0].s;
4207
4208 if (s != NULL) {
4209 if (*s == '$' || *s == '@') s++;
4210 if (strlen(s) == gretl_namechar_spn(s)) {
4211 cmd->ci = GENR;
4212 }
4213 }
4214 }
4215
4216 if (!err && cmd->ci == 0) {
4217 /* FIXME watch out for fallout! (2012-03-01) */
4218 cmd->ci = CMD_NULL;
4219 err = E_PARSE;
4220 }
4221
4222 if (err) {
4223 return err;
4224 }
4225
4226 if (cmd->ci == END) {
4227 cmd->context = 0;
4228 } else if (cmd->context) {
4229 cmd->ci = cmd->context;
4230 }
4231
4232 if (cmd->ci == NLS || cmd->ci == MLE ||
4233 cmd->ci == GMM || cmd->ci == FOREIGN ||
4234 cmd->ci == PLOT || cmd->ci == MPI) {
4235 cmd->context = cmd->ci;
4236 }
4237
4238 #if CMD_DEBUG
4239 fprintf(stderr, " get_command_index: cmd->ci set to %d\n", cmd->ci);
4240 #endif
4241
4242 return 0;
4243 }
4244
gretl_cmd_set_context(CMD * cmd,int ci)4245 void gretl_cmd_set_context (CMD *cmd, int ci)
4246 {
4247 cmd->context = ci;
4248 }
4249
gretl_cmd_destroy_context(CMD * cmd)4250 void gretl_cmd_destroy_context (CMD *cmd)
4251 {
4252 if (cmd->context == FOREIGN || cmd->context == MPI) {
4253 foreign_destroy();
4254 }
4255 cmd->context = 0;
4256 *cmd->savename = '\0';
4257 }
4258
gretl_cmd_get_opt(const CMD * cmd)4259 gretlopt gretl_cmd_get_opt (const CMD *cmd)
4260 {
4261 return cmd->opt;
4262 }
4263
gretl_cmd_set_opt(CMD * cmd,gretlopt opt)4264 void gretl_cmd_set_opt (CMD *cmd, gretlopt opt)
4265 {
4266 cmd->opt = opt;
4267 }
4268
gretl_cmd_get_savename(CMD * cmd)4269 const char *gretl_cmd_get_savename (CMD *cmd)
4270 {
4271 return cmd->savename;
4272 }
4273
4274 #define PMDEBUG 0
4275
gretl_exec_state_init(ExecState * s,ExecFlags flags,char * line,CMD * cmd,MODEL * model,PRN * prn)4276 void gretl_exec_state_init (ExecState *s,
4277 ExecFlags flags,
4278 char *line,
4279 CMD *cmd,
4280 MODEL *model,
4281 PRN *prn)
4282 {
4283 s->flags = flags;
4284
4285 s->line = line;
4286 if (s->line != NULL) {
4287 *s->line = '\0';
4288 }
4289 s->more = NULL;
4290
4291 s->cmd = cmd;
4292 if (s->cmd != NULL) {
4293 s->cmd->ci = 0;
4294 }
4295
4296 *s->runfile = '\0';
4297
4298 s->model = model;
4299 s->prn = prn;
4300
4301 s->pmod = NULL;
4302 s->sys = NULL;
4303 s->rset = NULL;
4304 s->var = NULL;
4305 s->in_comment = 0;
4306 s->padded = 0;
4307
4308 if (flags == FUNCTION_EXEC) {
4309 /* On entry to function execution we check if there's
4310 a 'last model' in place. If so, we want to make
4311 this invisible within the function, but set things
4312 up so that we can restore it as last model on
4313 exit from the function -- the idea being that
4314 executing a function should not change the 'last
4315 model' state at caller level. To achieve this we
4316 need to take out a 'private' reference to the
4317 model, stored in the ExecState, and then remove
4318 it from last model position for the present.
4319 */
4320 s->prev_model = get_last_model(&s->prev_type);
4321 if (s->prev_model != NULL) {
4322 #if PMDEBUG
4323 fprintf(stderr, "ExecState %p: set prev_model %p\n",
4324 (void *) s, s->prev_model);
4325 #endif
4326 gretl_object_ref(s->prev_model, s->prev_type);
4327 set_as_last_model(NULL, GRETL_OBJ_NULL);
4328 }
4329 s->prev_model_count = get_model_count();
4330 } else {
4331 s->prev_model = NULL;
4332 s->prev_type = GRETL_OBJ_NULL;
4333 s->prev_model_count = -1;
4334 }
4335
4336 s->submask = NULL;
4337 s->callback = NULL;
4338 }
4339
function_state_init(CMD * cmd,ExecState * state,int * indent0)4340 void function_state_init (CMD *cmd, ExecState *state, int *indent0)
4341 {
4342 cmd->list = NULL;
4343 cmd->auxlist = NULL;
4344 cmd->param = NULL;
4345 cmd->parm2 = NULL;
4346 /* FIXME tokenize more needed? */
4347
4348 state->cmd = NULL;
4349 state->model = NULL;
4350 state->submask = NULL;
4351
4352 state->padded = 0;
4353
4354 *indent0 = gretl_if_state_record();
4355 }
4356
gretl_exec_state_set_callback(ExecState * s,EXEC_CALLBACK callback,gretlopt opt)4357 void gretl_exec_state_set_callback (ExecState *s,
4358 EXEC_CALLBACK callback,
4359 gretlopt opt)
4360 {
4361 s->callback = callback;
4362 s->pmod = NULL;
4363
4364 if (opt & OPT_G) {
4365 gui_callback = callback;
4366 }
4367 }
4368
get_gui_callback(void)4369 EXEC_CALLBACK get_gui_callback (void)
4370 {
4371 return gui_callback;
4372 }
4373
set_gui_callback(EXEC_CALLBACK callback)4374 void set_gui_callback (EXEC_CALLBACK callback)
4375 {
4376 gui_callback = callback;
4377 }
4378
gretl_exec_state_clear(ExecState * s)4379 void gretl_exec_state_clear (ExecState *s)
4380 {
4381 gretl_cmd_free(s->cmd);
4382
4383 if (s->flags & FUNCTION_EXEC) {
4384 /* Restore whatever was the 'last model' before
4385 function execution. Note that this includes
4386 the case where there was no 'last model', in
4387 which case we restore the null state. Drop
4388 the extra refcount for the model we put into
4389 last model position (if any), so we don't end
4390 up leaking memory.
4391 */
4392 set_as_last_model(s->prev_model, s->prev_type);
4393 if (s->prev_model != NULL) {
4394 gretl_object_unref(s->prev_model, s->prev_type);
4395 }
4396 #if PMDEBUG
4397 fprintf(stderr, "ExecState %p, set prev_model %p as last_model\n",
4398 (void *) s, (void *) s->prev_model);
4399 #endif
4400 /* restore the previous model count */
4401 if (s->prev_model_count >= 0) {
4402 set_model_count(s->prev_model_count);
4403 }
4404 }
4405
4406 destroy_working_model(s->model);
4407
4408 s->prev_model = NULL;
4409 s->prev_type = GRETL_OBJ_NULL;
4410 s->prev_model_count = -1;
4411
4412 free_subsample_mask(s->submask);
4413 }
4414
gretl_exec_state_destroy(ExecState * s)4415 void gretl_exec_state_destroy (ExecState *s)
4416 {
4417 free_subsample_mask(s->submask);
4418 gretl_abort_compiling_loop();
4419 free(s);
4420 }
4421
gretl_exec_state_uncomment(ExecState * s)4422 void gretl_exec_state_uncomment (ExecState *s)
4423 {
4424 s->in_comment = 0;
4425 s->cmd->flags &= ~CMD_IGNORE;
4426 }
4427
gretl_exec_state_transcribe_flags(ExecState * s,CMD * cmd)4428 void gretl_exec_state_transcribe_flags (ExecState *s, CMD *cmd)
4429 {
4430 s->in_comment = (cmd_ignore(cmd))? 1 : 0;
4431 }
4432
gretl_exec_state_set_model(ExecState * s,MODEL * pmod)4433 void gretl_exec_state_set_model (ExecState *s, MODEL *pmod)
4434 {
4435 s->pmod = pmod;
4436 }
4437
process_command_error(ExecState * s,int err)4438 int process_command_error (ExecState *s, int err)
4439 {
4440 int ret = err;
4441
4442 if (err) {
4443 if (gretl_compiling_function() ||
4444 gretl_compiling_loop()) {
4445 ; /* pass the error through */
4446 } else if (s->cmd->flags & CMD_CATCH) {
4447 /* local "continue on error" */
4448 set_gretl_errno(err);
4449 s->cmd->flags ^= CMD_CATCH;
4450 ret = 0;
4451 }
4452 }
4453
4454 if (ret && print_redirection_level(s->prn) > 0) {
4455 print_end_redirection(s->prn);
4456 pputs(s->prn, _("An error occurred when 'outfile' was active\n"));
4457 }
4458
4459 return ret;
4460 }
4461