summaryrefslogtreecommitdiff
path: root/ipl/procs/adlutils.icn
blob: 577c944dfbc9beb60881233abcd5763e6d5d8a64 (plain)
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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
############################################################################
#
#	File:     adlutils.icn
#
#	Subject:  Procedures to process address lists
#
#	Author:   Ralph E. Griswold
#
#	Date:     January 3, 1994
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#     Procedures used by programs that process address lists:
#
#	 nextadd()		get next address
#	 writeadd(add)		write address
#	 get_country(add)	get country
#	 get_state(add)		get state (U.S. addresses only)
#	 get_city(add)		get city (U.S. addresses only)
#	 get_zipcode(add)	get ZIP code (U.S. addresses only)
#	 get_lastname(add)	get last name
#	 get_namepfx(add)	get name prefix
#	 get_title(add)		get name title
#	 format_country(s)	format country name
#
############################################################################
#
#  Links:  lastname, io, namepfx, title
#
############################################################################

link lastname, io, namepfx, title

record label(header, text, comments)

procedure nextadd()
   local comments, header, line, text

   initial {			# Get to first label.
      while line := Read() do
         line ? {
            if ="#" then {
               PutBack(line)
               break
               }
            }
      }

   header := Read() | fail

   comments := text := ""

   while line := Read() do
      line ? {
         if pos(0) then next	# Skip empty lines.
         else if ="*" then comments ||:= "\n" || line
         else if ="#" then {	# Header for next label.
            PutBack(line)
            break		# Done with current label.
            }
         else text ||:= "\n" || line
         }
   every text | comments ?:= {	# Strip off leading newline, if any.
      move(1)
      tab(0)
      }

   return label(header, text, comments)

end

procedure writeadd(add)

   if *add.text + *add.comments = 0 then return
   write(add.header)
   if *add.text > 0 then write(add.text)
   if *add.comments > 0 then write(add.comments)

   return

end

procedure get_country(add)

   trim(add.text) ? {
      while tab(upto('\n')) do move(1)
      if tab(0) ? {
         tab(-1)
         any(&digits)
         } then return "U.S.A."
      else return tab(0)
      }
end

procedure get_state(add)

   trim(add.text) ? {
      while tab(upto('\n')) do move(1)
      ="APO"
      while tab(upto(',')) do move(1)
      tab(many(' '))
      return (tab(any(&ucase)) || tab(any(&ucase))) | "XX"
      }

end

procedure get_city(add)		# only works for U.S. addresses
   local result

   result := ""
   trim(add.text) ? {
      while tab(upto('\n')) do move(1)
      result := ="APO"
      result ||:= tab(upto(','))
      return result
      }

end



procedure get_zipcode(add)
   local zip

   trim(add.text) ? {
      while tab(upto('\n')) do move(1)		# get to last line
      while tab(upto(' ')) do tab(many(' '))	# get to last field
      zip := tab(0)
      if *zip = 5 & integer(zip) then return zip
      else if *zip = 10 & zip ? {
         integer(move(5)) & ="-" & integer(tab(0))
         }
      then return zip
      else return "9999999999"			# "to the end of the universe"
      }

end

procedure get_lastname(add)

   return lastname(add.text ? tab(upto('\n') | 0))

end

procedure get_namepfx(add)

   return namepfx(add.text ? tab(upto('\n') | 0))

end

procedure get_title(add)

   return title(add.text ? tab(upto('\n') | 0))

end

procedure format_country(s)
   local t, word

   s := map(s)
   t := ""
   s ? while tab(upto(&lcase)) do {
      word := tab(many(&lcase))
      if word == "of" then t ||:= word
      else t ||:= {
         word ? {
            map(move(1),&lcase,&ucase) || tab(0)
            }
         }
      t ||:= move(1)
      }
   return t
end