1 /*
2 PerlIO::dir
3 */
4
5
6 #include "perlioutil.h"
7
8 #define Dirp(f) (PerlIOSelf(f, PerlIODir)->dirp)
9
10 #define DirBuf(f) (PerlIOSelf(f, PerlIODir)->buf)
11 #define DirBufPtr(f) (PerlIOSelf(f, PerlIODir)->ptr)
12 #define DirBufEnd(f) (PerlIOSelf(f, PerlIODir)->end)
13
14 #if defined(FILENAME_MAX)
15 # define DIR_BUFSIZ (FILENAME_MAX+1)
16 #else
17 # define DIR_BUFSIZ 512
18 #endif
19 /*
20 BUF: foobar\n@@@@@@@@@@@@@
21 ^ ^ ^
22 ptr end BUFSIZ
23 */
24 typedef struct{
25 struct _PerlIO base;
26
27 DIR* dirp;
28
29 STDCHAR buf[DIR_BUFSIZ];
30 STDCHAR* ptr;
31 STDCHAR* end;
32 } PerlIODir;
33
34 static PerlIO*
PerlIODir_open(pTHX_ PerlIO_funcs * self,PerlIO_list_t * layers,IV n,const char * mode,int fd,int imode,int perm,PerlIO * f,int narg,SV ** args)35 PerlIODir_open(pTHX_ PerlIO_funcs* self, PerlIO_list_t* layers, IV n,
36 const char* mode, int fd, int imode, int perm,
37 PerlIO* f, int narg, SV** args){
38 PERL_UNUSED_ARG(layers);
39 PERL_UNUSED_ARG(n);
40 PERL_UNUSED_ARG(fd);
41 PERL_UNUSED_ARG(imode);
42 PERL_UNUSED_ARG(perm);
43 PERL_UNUSED_ARG(narg);
44
45 #ifndef EACCES
46 #define EACCES EPERM
47 #endif
48
49 if(!imode){
50 imode = PerlIOUnix_oflags(mode);
51 }
52 if( imode & (O_WRONLY | O_RDWR) ){
53 SETERRNO(EACCES, RMS_PRV);
54 return NULL;
55 }
56 if(PerlIOValid(f)){ /* reopen */
57 PerlIO_close(f);
58 }
59 else{
60 f = PerlIO_allocate(aTHX);
61 }
62
63 return PerlIO_push(aTHX_ f, self, mode, args[0]);
64 }
65
66 static IV
PerlIODir_pushed(pTHX_ PerlIO * f,const char * mode,SV * arg,PerlIO_funcs * tab)67 PerlIODir_pushed(pTHX_ PerlIO* f, const char* mode, SV* arg, PerlIO_funcs* tab){
68 if(!SvOK(arg)){
69 SETERRNO(EINVAL, LIB_INVARG);
70 return -1;
71 }
72
73 Dirp(f) = PerlDir_open(SvPV_nolen_const(arg));
74 if(!Dirp(f)){
75 return -1;
76 }
77
78 DirBufPtr(f) = DirBufEnd(f) = DirBuf(f);
79
80 PerlIOBase(f)->flags |= (PERLIO_F_NOTREG | PERLIO_F_OPEN);
81
82 return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
83 }
84
85 static IV
PerlIODir_popped(pTHX_ PerlIO * f)86 PerlIODir_popped(pTHX_ PerlIO* f){
87 if(Dirp(f)){
88 #ifdef VOID_CLOSEDIR
89 PerlDir_close(Dirp(f));
90 #else
91 if(PerlDir_close(Dirp(f)) < 0){
92 Dirp(f) = NULL;
93 return -1;
94 }
95 #endif
96 Dirp(f) = NULL;
97 }
98 return PerlIOBase_popped(aTHX_ f);
99 }
100
101 static IV
PerlIODir_fill(pTHX_ PerlIO * f)102 PerlIODir_fill(pTHX_ PerlIO* f){
103
104 #if !defined(I_DIRENT) && !defined(VMS)
105 Direntry_t *readdir (DIR *);
106 #endif
107 const Direntry_t* de = PerlDir_read(Dirp(f));
108
109 if(de){
110 #ifdef DIRNAMLEN
111 STRLEN len = de->d_namlen;
112 #else
113 STRLEN len = strlen(de->d_name);
114 #endif
115
116 assert(DIR_BUFSIZ > len);
117
118 Copy(de->d_name, DirBuf(f), len, STDCHAR);
119
120 /* add "\n" */
121 DirBuf(f)[len] = '\n';
122
123 DirBufPtr(f) = DirBuf(f);
124 DirBufEnd(f) = DirBuf(f) + (len+1);
125
126 IOLflag_on(f, PERLIO_F_RDBUF);
127
128 return 0;
129 }
130 else{
131 IOLflag_off(f, PERLIO_F_RDBUF);
132 IOLflag_on(f, PERLIO_F_EOF);
133
134 DirBufPtr(f) = DirBufEnd(f) = DirBuf(f);
135 return -1;
136 }
137 }
138
139 static STDCHAR *
PerlIODir_get_base(pTHX_ PerlIO * f)140 PerlIODir_get_base(pTHX_ PerlIO * f){
141 PERL_UNUSED_CONTEXT;
142
143 return DirBuf(f);
144 }
145
146 static STDCHAR *
PerlIODir_get_ptr(pTHX_ PerlIO * f)147 PerlIODir_get_ptr(pTHX_ PerlIO * f){
148 PERL_UNUSED_CONTEXT;
149
150 return DirBufPtr(f);
151 }
152
153 static SSize_t
PerlIODir_get_cnt(pTHX_ PerlIO * f)154 PerlIODir_get_cnt(pTHX_ PerlIO * f){
155 PERL_UNUSED_CONTEXT;
156
157 return DirBufEnd(f) - DirBufPtr(f);
158 }
159
160 static Size_t
PerlIODir_bufsiz(pTHX_ PerlIO * f)161 PerlIODir_bufsiz(pTHX_ PerlIO * f){
162 PERL_UNUSED_CONTEXT;
163 PERL_UNUSED_ARG(f);
164
165 return DirBufEnd(f) - DirBuf(f);
166 }
167
168 static void
PerlIODir_set_ptrcnt(pTHX_ PerlIO * f,STDCHAR * ptr,SSize_t cnt)169 PerlIODir_set_ptrcnt(pTHX_ PerlIO * f, STDCHAR * ptr, SSize_t cnt){
170 PERL_UNUSED_CONTEXT;
171 PERL_UNUSED_ARG(cnt);
172
173 DirBufPtr(f) = ptr;
174 }
175 #if 0
176 static IV
177 PerlIODir_seek(pTHX_ PerlIO* f, Off_t offset, int whence){
178 switch(whence){
179 case SEEK_SET:
180 PerlDir_seek(Dirp(f), offset);
181 break;
182
183 case SEEK_CUR:
184 if(offset != 0){
185 goto einval;
186 }
187 break;
188
189 case SEEK_END:
190 if(offset != 0){
191 goto einval;
192 }
193 while(PerlDir_read(Dirp(f)) != NULL){
194 NOOP;
195 }
196 break;
197
198 default:
199 einval: SETERRNO(EINVAL, LIB_INVARG);
200 return -1;
201 }
202
203 DirBufPtr(f) = DirBufEnd(f) = DirBuf(f);
204
205 IOLflag_off(f, PERLIO_F_EOF | PERLIO_F_RDBUF);
206 return 0;
207 }
208
209 static Off_t
210 PerlIODir_tell(pTHX_ PerlIO* f){
211 return PerlDir_tell( Dirp(f) );
212 }
213
214 #else
215
216
217 static IV
PerlIODir_seek(pTHX_ PerlIO * f,Off_t offset,int whence)218 PerlIODir_seek(pTHX_ PerlIO* f, Off_t offset, int whence){
219 switch(whence){
220 case SEEK_SET:
221 if(offset == 0){
222 PerlDir_rewind(Dirp(f));
223 return 0;
224 }
225 case SEEK_CUR:
226 case SEEK_END:
227 default:
228 SETERRNO(EINVAL, LIB_INVARG);
229 return -1;
230 }
231 }
232
233
234 #define PerlIODir_tell NULL
235 #endif
236
237
238 PERLIO_FUNCS_DECL(PerlIO_dir) = {
239 sizeof(PerlIO_funcs),
240 "dir",
241 sizeof(PerlIODir),
242 PERLIO_K_BUFFERED | PERLIO_K_RAW | PERLIO_K_DESTRUCT,
243 PerlIODir_pushed,
244 PerlIODir_popped,
245 PerlIODir_open,
246 PerlIOBase_binmode,
247 NULL, /* getarg */
248 NULL, /* fileno */
249 NULL, /* dup */
250 NULL, /* read */
251 NULL, /* unread */
252 NULL, /* write */
253 PerlIODir_seek,
254 PerlIODir_tell,
255 NULL, /* close */
256 NULL, /* flush */
257 PerlIODir_fill,
258 NULL, /* eof */
259 NULL, /* error */
260 NULL, /* clearerror */
261 NULL, /* setlinebuf */
262 PerlIODir_get_base,
263 PerlIODir_bufsiz,
264 PerlIODir_get_ptr,
265 PerlIODir_get_cnt,
266 PerlIODir_set_ptrcnt
267 };
268
269