/
io.pir
185 lines (141 loc) Β· 3.35 KB
/
io.pir
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
178
179
180
181
182
183
184
185
## $Id$
=head1 NAME
src/builtins/io.pir - Perl6 builtins for I/O
=head1 Functions
=over 4
=cut
.namespace []
=item printf
Parses a format string and prints formatted output according to it.
=cut
.sub 'printf'
.param pmc args :slurpy
.local pmc it, out
out = get_hll_global '$OUT'
$S0 = 'sprintf'(args :flat)
out.'print'($S0)
.return (1)
.end
.sub 'open'
.param string filename
.param int r :named('r') :optional
.param int w :named('w') :optional
.param int a :named('a') :optional
# Work out a mode string. XXX Default to r?
.local string mode
if r goto is_read
if w goto is_write
if a goto is_append
is_read:
mode = "r"
goto done_mode
is_write:
mode = "w"
goto done_mode
is_append:
mode = "wa"
goto done_mode
done_mode:
# Open file to get PIO file handle.
$P0 = open filename, mode
if $P0 goto opened_ok
'die'("Unable to open file") # XXX better message
opened_ok:
# Set default encoding to utf8
$P0.'encoding'('utf8')
# Create IO object and set handle.
.local pmc obj
obj = get_hll_global 'IO'
obj = obj.'new'()
setattribute obj, "$!PIO", $P0
.return(obj)
.end
.sub 'close'
.param pmc obj
obj.'close'()
.end
.sub 'slurp'
.param string filename
.local string contents
$P0 = 'open'(filename, 'r')
contents = $P0.'slurp'()
'close'($P0)
.return(contents)
.end
=item unlink LIST
Deletes a list of files. Returns the number of files successfully
deleted.
$cnt = unlink 'a', 'b', 'c';
Be warned that unlinking a directory can inflict damage on your filesystem.
Finally, using C<unlink> on directories is not supported on many operating
systems. Use C<rmdir> instead.
It is an error to use bare C<unlink> without arguments.
=cut
.sub 'unlink'
.param pmc to_delete :slurpy
.local pmc it, os
.local int success_count
# Error with no arguments.
$I0 = elements to_delete
if $I0 goto ok
'die'("Cannot call unlink without any arguments")
ok:
os = root_new ['parrot';'OS']
success_count = 0
it = iter to_delete
it_loop:
unless it goto it_loop_end
$S0 = shift it
push_eh unlink_skip
os.'rm'($S0)
inc success_count
unlink_skip:
pop_eh
goto it_loop
it_loop_end:
.return (success_count)
.end
.sub '!qx'
.param string cmd
.local pmc pio
pio = open cmd, 'rp'
unless pio goto err_qx
pio.'encoding'('utf8')
$P0 = pio.'readall'()
pio.'close'()
.return ($P0)
err_qx:
.tailcall '!FAIL'('Unable to execute "', cmd, '"')
.end
=item chdir STRING
Changes the current working directory.
chdir '/new/dir';
On success the value of the new directory is put in $*CWD and a
true value is returned.
=cut
.sub 'chdir'
.param string newdir
# Try to change directory; if we fail, exception thrown, so catch
# it and fail if needed.
.local pmc os
os = root_new ['parrot';'OS']
push_eh failure
os.'chdir'(newdir)
pop_eh
# Update $*CWD and we're done.
$S0 = os."cwd"()
$P0 = box $S0
set_hll_global '$CWD', $P0
$P0 = get_hll_global ['Bool'], 'True'
.return ($P0)
failure:
pop_eh
.tailcall '!FAIL'('Unable to change to directory "', newdir, '"')
.end
=back
=cut
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir: