Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
409 lines (323 sloc) 8.28 KB
/*
:reverse - Reads lines backward
*/
#include "perlioutil.h"
#define IOR(f) (PerlIOSelf(f, PerlIOReverse))
#define REV_BUFSIZ 4096
#define SEGSV_BUFSIZ 512
#define BUFSV_BUFSIZ (REV_BUFSIZ+SEGSV_BUFSIZ)
typedef struct{
struct _PerlIO base;
STDCHAR buffer[ REV_BUFSIZ ]; /* first buffer */
SV* segsv; /* broken segment */
SV* bufsv; /* reversed buffer */
STDCHAR* ptr;
STDCHAR* end;
} PerlIOReverse;
static PerlIO*
PerlIOReverse_open(pTHX_ PerlIO_funcs* const self, PerlIO_list_t* const layers, IV const n,
const char* const mode, int const fd, int const imode, int const perm,
PerlIO* f, int const narg, SV** const args){
PerlIO_funcs* tab;
assert(layers->cur > 0);
tab = LayerFetch(layers, 0); /* :unix or :scalar */
if(!(tab && tab->Open) || PerlIOUnix_oflags(mode) & (O_WRONLY | O_RDWR) ){
SETERRNO(EINVAL, LIB_INVARG);
return NULL;
}
f = tab->Open(aTHX_ tab, layers, (IV)1, mode, fd, imode, perm, f, narg, args);
if(f){
if(!PerlIO_push(aTHX_ f, self, mode, PerlIOArg)){
PerlIO_close(f);
return NULL;
}
}
return f;
}
static IV
PerlIOReverse_pushed(pTHX_ PerlIO* const f, const char* const mode, SV* const arg, PerlIO_funcs* const tab){
PerlIOReverse* ior;
PerlIO* nx;
Off_t pos;
PerlIO* p;
if(!(PerlIOValid(f) && (nx = PerlIONext(f)) && PerlIOValid(nx))){
SETERRNO(EBADF, SS_IVCHAN);
return -1;
}
if(!IOLflag(nx, PERLIO_F_CANREAD)){
SETERRNO(EINVAL, LIB_INVARG);
return -1;
}
for(p = nx; PerlIOValid(p); p = PerlIONext(p)){
if(!(PerlIOBase(p)->tab->kind & PERLIO_K_RAW)
|| (PerlIOBase(p)->flags & PERLIO_F_CRLF)){
PerlIOUtil_warnif(aTHX_ packWARN(WARN_LAYER),
":%s is not a raw layer",
PerlIOBase(p)->tab->name);
SETERRNO(EINVAL, LIB_INVARG);
return -1;
}
}
pos = PerlIO_tell(nx);
if(pos <= 0){
if(pos < 0 || PerlIO_seek(nx, (Off_t)0, SEEK_END) < 0){
return -1;
}
}
ior = IOR(f);
ior->segsv = newSV(SEGSV_BUFSIZ);
ior->bufsv = newSV(BUFSV_BUFSIZ);
assert( ior->bufsv );
assert( ior->segsv );
sv_setpvn(ior->bufsv, "", 0);
sv_setpvn(ior->segsv, "", 0);
return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
}
static IV
PerlIOReverse_popped(pTHX_ PerlIO* const f){
PerlIOReverse* const ior = IOR(f);
PerlIO_debug("PerlIOReverse_popped:"
" bufsv=%ld, segsv=%ld\n",
(long)(ior->bufsv ? SvLEN(ior->bufsv) : 0),
(long)(ior->segsv ? SvLEN(ior->segsv) : 0));
SvREFCNT_dec(ior->bufsv);
SvREFCNT_dec(ior->segsv);
return PerlIOBase_popped(aTHX_ f);
}
#if defined(IOR_DEBUGGING)
#define write_buf(s, l, m) PerlIOReverse_debug_write_buf(aTHX_ s, l, m)
#define write_bufsv(sv, msg) PerlIOReverse_debug_write_buf(aTHX_ SvPVX(sv), SvCUR(sv), msg)
/* to pass -Wmissing-prototypes -Wunused-function */
void
PerlIOReverse_debug_write_buf(pTHX_ register const STDCHAR*, const Size_t count, const STDCHAR* msg);
void
PerlIOReverse_debug_write_buf(pTHX_ register const STDCHAR* src, const Size_t count, const STDCHAR* msg){
char* buf;
char* end;
register char* ptr;
Newx(buf, count, char);
ptr = buf;
end = buf + count;
/* write the buffer */
while(ptr < end){
*ptr = (*src == '\0' ? '@' : *src);
ptr++;
src++;
}
if(msg){
PerlIO_write(PerlIO_stderr(), msg, strlen(msg));
}
PerlIO_write(PerlIO_stderr(), "[", 1);
PerlIO_write(PerlIO_stderr(), buf, count);
Perl_warn(aTHX_ "]");
//PerlIO_write(PerlIO_stderr(), "]\n", 2);
Safefree(buf);
}
#endif /* IOR_DEBUGGING */
static IV
PerlIOReverse_flush(pTHX_ PerlIO* const f){
if(IOLflag(f, PERLIO_F_RDBUF)){
PerlIOReverse* ior = IOR(f);
Off_t offset = (ior->end - ior->ptr) + SvCUR(ior->segsv);
SvCUR(ior->bufsv) = SvCUR(ior->segsv) = 0;
ior->end = ior->ptr = SvPVX(ior->bufsv);
IOLflag_off(f, PERLIO_F_RDBUF);
PerlIO_seek(PerlIONext(f), offset , SEEK_CUR);
}
return PerlIO_flush(PerlIONext(f));
}
static SSize_t
reverse_read(pTHX_ PerlIO* const f, STDCHAR* const vbuf, SSize_t count){
PerlIO* const nx = PerlIONext(f);
SSize_t avail = 0;
Off_t const pos = PerlIO_tell(nx);
assert( pos == (SSize_t)pos ); /* XXX: What should I do? */
if(pos <= 0){
IOLflag_on(f, pos < 0 ? PERLIO_F_ERROR : PERLIO_F_EOF);
return (SSize_t)pos;
}
if(pos < count){
count = (SSize_t)pos;
}
if(PerlIO_seek(nx, (Off_t)-count, SEEK_CUR) < 0){
IOLflag_on(f, PERLIO_F_ERROR);
return -1;
}
while(avail < count){
SSize_t s = PerlIO_read(nx, vbuf+avail, (Size_t)(count - avail));
if(s > 0){
avail += s;
}
else{
break;
}
}
if(PerlIO_seek(nx, (Off_t)-avail, SEEK_CUR) < 0){
IOLflag_on(f, PERLIO_F_ERROR);
return -1;
}
return avail;
}
static IV
PerlIOReverse_fill(pTHX_ PerlIO* const f){
PerlIOReverse* const ior = IOR(f);
SSize_t avail;
SV* const bufsv = ior->bufsv;
SV* const segsv = ior->segsv;
STDCHAR* rbuf;
STDCHAR* const buf = ior->buffer;
STDCHAR* ptr;
const STDCHAR* end;
const STDCHAR* start;
SvCUR(bufsv) = 0;
retry:
avail = reverse_read(aTHX_ f, buf, REV_BUFSIZ);
if(avail < 0){
return -1;
}
start = ptr = buf;
end = buf + avail;
if(avail == REV_BUFSIZ){ /* not EOF */
while(ptr < end){
if(*(ptr++) == '\n') break;
}
/* available buffer has no newlines */
if(ptr == end){
/* fill segment simply */
sv_insert(segsv, 0, 0, buf, (Size_t)avail);
goto retry;
}
}
/* solve previous segment */
if(SvCUR(segsv) > 0){
const STDCHAR* p = end;
while(p >= ptr){
if(*(--p) == '\n') break;
}
p++;
/* buf[oo\nbar\nba]
^ ^ ^
start ptr p
seg[z\n]
*/
sv_grow(bufsv, (end - ptr) + SvCUR(segsv));
sv_setpvn(bufsv, p, (Size_t)(end - p));
sv_catsv( bufsv, segsv);
end = p;
}
/*write_buf(start, (Size_t)(ptr - start), "");*/
sv_setpvn(segsv, start, (Size_t)(ptr - start));
start = ptr;
rbuf = SvPVX(bufsv) + SvCUR(bufsv);
SvCUR(bufsv) += end - start;
assert(SvCUR(bufsv) <= SvLEN(bufsv));
while(ptr < end){
if(*(ptr++) == '\n'){
/* line length: ptr - start */
/* write pos: end - ptr */
Copy( start,
rbuf + (end - ptr),
ptr - start, STDCHAR);
start = ptr;
}
}
if(start != end){
Copy( start, rbuf + (end - ptr), ptr - start, STDCHAR);
}
/*
write_bufsv(segsv, "segm");
write_buf(start, end - start, "buf");
write_bufsv(segsv, "rbuf");
// */
ior->ptr = SvPVX(bufsv);
ior->end = SvPVX(bufsv) + SvCUR(bufsv);
if( SvCUR(bufsv) == 0 ){
return -1;
}
IOLflag_on(f, PERLIO_F_RDBUF);
return 0;
}
static STDCHAR*
PerlIOReverse_get_base(pTHX_ PerlIO* const f){
return SvPVX(IOR(f)->bufsv);
}
static STDCHAR*
PerlIOReverse_get_ptr(pTHX_ PerlIO* const f){
return IOR(f)->ptr;
}
static SSize_t
PerlIOReverse_get_cnt(pTHX_ PerlIO* const f){
return IOR(f)->end - IOR(f)->ptr;
}
static Size_t
PerlIOReverse_bufsiz(pTHX_ PerlIO* const f){
return SvCUR(IOR(f)->bufsv);
}
static void
PerlIOReverse_set_ptrcnt(pTHX_ PerlIO* const f, STDCHAR* const ptr, SSize_t const cnt){
PERL_UNUSED_ARG(cnt);
IOR(f)->ptr = ptr;
}
static IV
PerlIOReverse_seek(pTHX_ PerlIO* const f, Off_t const offset, int whence){
PerlIO* const nx = PerlIONext(f);
PerlIOReverse_flush(aTHX_ f);
switch(whence){
case SEEK_SET:
whence = SEEK_END;
break;
case SEEK_END:
whence = SEEK_SET;
break;
}
return PerlIO_seek(nx, -offset, whence);
}
static Off_t
PerlIOReverse_tell(pTHX_ PerlIO* const f){
PerlIO* const nx = PerlIONext(f);
Off_t const current = PerlIO_tell(nx);
Off_t end;
if(PerlIO_seek(nx, (Off_t)0, SEEK_END) < 0){
return -1;
}
end = PerlIO_tell(nx);
if(PerlIO_seek(nx, current, SEEK_SET) < 0){
return -1;
}
/*
warn("(end=%d - pos=%d) - (cnt=%d + segsv=%d) = %d",
(int)end, (int)current, (int)(IOR(f)->end-IOR(f)->ptr), (int)SvCUR(IOR(f)->segsv),
(int)((end - current) - ((IOR(f)->end - IOR(f)->ptr) + SvCUR(IOR(f)->segsv))));
*/
return (end - current) - ((IOR(f)->end - IOR(f)->ptr) + SvCUR(IOR(f)->segsv));
}
PERLIO_FUNCS_DECL(PerlIO_reverse) = {
sizeof(PerlIO_funcs),
"reverse",
sizeof(PerlIOReverse),
PERLIO_K_BUFFERED | PERLIO_K_RAW,
PerlIOReverse_pushed,
PerlIOReverse_popped,
PerlIOReverse_open,
PerlIOBase_binmode,
NULL, /* getarg */
NULL, /* fileno */
NULL, /* dup */
NULL, /* read */
NULL, /* unread */
NULL, /* write */
PerlIOReverse_seek,
PerlIOReverse_tell,
NULL, /* close */
PerlIOReverse_flush,
PerlIOReverse_fill,
NULL, /* eof */
NULL, /* error */
NULL, /* clearerr */
NULL, /* setlinebuf */
PerlIOReverse_get_base,
PerlIOReverse_bufsiz,
PerlIOReverse_get_ptr,
PerlIOReverse_get_cnt,
PerlIOReverse_set_ptrcnt
};