aboutsummaryrefslogtreecommitdiff
path: root/pkg/proto/t_joinlines.x
blob: 1dd886c13359e70e77f40d07287a7f5679593284 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
# T_JOINLINES -- Join text files line by line.

procedure t_joinlines ()

int	list			# List of input files
int	out			# Output file descriptor
pointer	delim			# Delimiter string
pointer	missing			# Missing string
int	maxchars		# Maximum characters per line
bool	shortest		# Stop of shortest file?
bool	verbose			# Verbose warnings?

char	c
pointer	sp, fname, fds
int	i, j, in
int	nfiles, nlines, neof, nchars, ntruncate, nlong, ndelim, nmissing
int	fntopnb(), clplen(), clgfil(), clgeti(), open(), strlen()
char	getc()
bool	clgetb()

begin
	call smark (sp)
	call salloc (fname, SZ_FNAME, TY_CHAR)
	call salloc (delim, SZ_FNAME, TY_CHAR)
	call salloc (missing, SZ_LINE, TY_CHAR)

	# Task parameters

	# This stuff is provided for backwards compatibility.
	# It would be better to just use an "input" parameter.
	call clgstr ("list1", Memc[fname], SZ_FNAME)
	if (clgeti ("$nargs") == 2) {
	    call clgstr ("list2", Memc[delim], SZ_FNAME)
	    call strcat (",", Memc[fname], SZ_FNAME)
	    call strcat (Memc[delim], Memc[fname], SZ_FNAME)
	}
	list = fntopnb (Memc[fname], NO)

#	list = clpopnu ("input")
	call clgstr ("output", Memc[fname], SZ_FNAME)
	call clgstr ("delim", Memc[delim], SZ_FNAME)
	call clgstr ("missing", Memc[missing], SZ_LINE)
	maxchars = clgeti ("maxchars") - 1
	shortest = clgetb ("shortest")
	verbose = clgetb ("verbose")

	# Open files.  Quit on an error.
	out = open (Memc[fname], APPEND, TEXT_FILE)
	nfiles = clplen (list)
	call malloc (fds, nfiles, TY_INT)
	do i = 1, nfiles {
	    j = clgfil (list, Memc[fname], SZ_FNAME)
	    Memi[fds+i-1] = open (Memc[fname], READ_ONLY, TEXT_FILE)
	}
	call clpcls (list)

	# Join the input lines.  First read a character from each file
	# to determine if we are at the EOF and take appropriate action
	# if one or more EOFs are found.

	ndelim = strlen (Memc[delim])
	nmissing = strlen (Memc[missing])
	ntruncate = 0
	nlong = 0
	for (nlines = 1; ; nlines = nlines + 1) {
	    nchars = 0
	    neof = 0
	    do i = 1, nfiles {
	        in = Memi[fds+i-1]
		if (getc (in, c) == EOF)
		    neof = neof + 1
		else
		    call ungetc (in, c)
	    }
	    if (neof == nfiles || (shortest && neof > 0))
		break

	    do i = 1, nfiles {
	        in = Memi[fds+i-1]
	        repeat {
	            if (getc (in, c) == EOF) {
		        do j = 1, nmissing {
		            if (nchars < maxchars)
		                call putc (out, Memc[missing+j-1])
	    	            nchars = nchars + 1
		        }
			break
		    } else if (c == '\n')
		        break
		    if (nchars < maxchars)
		        call putc (out, c)
		    nchars = nchars + 1
	        }

		# Add the delimiter and new line.  Count the delimiter also.
	        if (i < nfiles) {
		    do j = 1, ndelim {
		        if (nchars < maxchars)
		            call putc (out, Memc[delim+j-1])
	    	        nchars = nchars + 1
		    }
	        } else {
		    call fprintf (out, "\n")
		    break
	        }
	    }

	    # Accumulate warnings about line lengths.
	    if (nchars > maxchars)
		ntruncate = ntruncate + 1
	    if (min (nchars, maxchars + 1) > SZ_LINE)
		nlong = nlong + 1
	}

	# Finish up.
	if (verbose) {
	    if (ntruncate > 0) {
	        call eprintf ("WARNING: %d lines truncated at %d characters\n")
		    call pargi (ntruncate)
		    call pargi (maxchars + 1)
	    }
	    if (nlong > 0) {
	        call eprintf (
		    "WARNING: %d lines exceed IRAF limit of %d characters\n")
		    call pargi (nlong)
		    call pargi (SZ_LINE)
	    }
	    if (neof < nfiles) {
	        call eprintf ("WARNING: %d/%d files completed\n")
		    call pargi (neof)
		    call pargi (nfiles)
	    }
	}
		
	call close (out)
	do i = 1, nfiles
	    call close (Memi[fds+i-1])
	call sfree (sp)
end