From: plugwash Date: Sat, 23 Feb 2013 02:25:59 +0000 (+0000) Subject: various work on readtxt2.pas X-Git-Url: http://www.lcore.org/git/lcore.git/commitdiff_plain/1a863b8d4ef10ffb7424401ef65a39e3090f41a9 various work on readtxt2.pas fix issue with files where a line with a unix line ending followed a line with a mac line ending add support for applications to specify that only a single line ending type is a valid line ending expand testreadtxt2.dpr git-svn-id: file:///svnroot/lcore/trunk@124 b1de8a11-f9be-4011-bde0-cc7ace90066a --- diff --git a/lserial.pas b/lserial.pas index cee4727..4f13fce 100755 --- a/lserial.pas +++ b/lserial.pas @@ -1,71 +1,71 @@ -{$mode delphi} -unit lserial; -interface -uses - lcore; - -type - tlserial=class(tlasio) - public - device: string; - baudrate: longint; - procedure open; - end; - - -implementation -uses - baseunix, - unix, - unixutil, - termio, // despite the name the fpc termio unit seems to be an interface to termios - sysutils; -procedure tlserial.open; -var - fd : longint; - config : termios; - baudrateos : longint; -begin - fd := fpopen(device,O_RDWR or O_NOCTTY or O_NONBLOCK); - - if isatty(fd)=0 then begin - writeln('not a tty'); - halt(1); - end; - - fillchar(config,sizeof(config),#0); - config.c_cflag := CLOCAL or CREAD; - cfmakeraw(config); - case baudrate of - 50: baudrateos := B50; - 75: baudrateos := B75; - 110: baudrateos := B110; - 134: baudrateos := B134; - 150: baudrateos := B150; - 200: baudrateos := B200; - 300: baudrateos := B300; - 600: baudrateos := B600; - 1200: baudrateos := B1200; - 1800: baudrateos := B1800; - 2400: baudrateos := B2400; - 4800: baudrateos := B4800; - 9600: baudrateos := B9600; - 19200: baudrateos := B19200; - 38400: baudrateos := B38400; - 57600: baudrateos := B57600; - 115200: baudrateos := B115200; - 230400: baudrateos := B230400; - else raise exception.create('unrecognised baudrate'); - end; - cfsetispeed(config,baudrateos); - cfsetospeed(config,baudrateos); - config.c_cc[VMIN] := 1; - config.c_cc[VTIME] := 0; - if tcsetattr(fd,TCSAFLUSH,config) <0 then begin - writeln('could not set termios attributes'); - halt(3); - end; - dup(fd); - closehandles := true; -end; -end. +{$mode delphi} +unit lserial; +interface +uses + lcore; + +type + tlserial=class(tlasio) + public + device: string; + baudrate: longint; + procedure open; + end; + + +implementation +uses + baseunix, + unix, + unixutil, + termio, // despite the name the fpc termio unit seems to be an interface to termios + sysutils; +procedure tlserial.open; +var + fd : longint; + config : termios; + baudrateos : longint; +begin + fd := fpopen(device,O_RDWR or O_NOCTTY or O_NONBLOCK); + + if isatty(fd)=0 then begin + writeln('not a tty'); + halt(1); + end; + + fillchar(config,sizeof(config),#0); + config.c_cflag := CLOCAL or CREAD; + cfmakeraw(config); + case baudrate of + 50: baudrateos := B50; + 75: baudrateos := B75; + 110: baudrateos := B110; + 134: baudrateos := B134; + 150: baudrateos := B150; + 200: baudrateos := B200; + 300: baudrateos := B300; + 600: baudrateos := B600; + 1200: baudrateos := B1200; + 1800: baudrateos := B1800; + 2400: baudrateos := B2400; + 4800: baudrateos := B4800; + 9600: baudrateos := B9600; + 19200: baudrateos := B19200; + 38400: baudrateos := B38400; + 57600: baudrateos := B57600; + 115200: baudrateos := B115200; + 230400: baudrateos := B230400; + else raise exception.create('unrecognised baudrate'); + end; + cfsetispeed(config,baudrateos); + cfsetospeed(config,baudrateos); + config.c_cc[VMIN] := 1; + config.c_cc[VTIME] := 0; + if tcsetattr(fd,TCSAFLUSH,config) <0 then begin + writeln('could not set termios attributes'); + halt(3); + end; + dup(fd); + closehandles := true; +end; +end. diff --git a/readtxt2.pas b/readtxt2.pas index 1888c5b..2c269a7 100644 --- a/readtxt2.pas +++ b/readtxt2.pas @@ -22,31 +22,34 @@ uses const bufsize=4096; eoltype_none=0; + eoltype_any=0; eoltype_cr=1; eoltype_lf=2; eoltype_crlf=3; type treadtxt=class(tobject) + private + buf:array[0..bufsize-1] of byte; + numread:integer; + bufpointer:integer; + currenteol,preveol:integer; + fileeof,reachedeof:boolean; + fdetectedeol:integer; + procedure checkandread; public sourcestream:tstream; destroysourcestream:boolean; + allowedeol:integer; constructor create(asourcestream: tstream; adestroysourcestream:boolean); constructor createf(filename : string); function readline:ansistring; function eof:boolean; destructor destroy; override; - private - buf:array[0..bufsize-1] of byte; - numread:integer; - bufpointer:integer; - currenteol,preveol:integer; - fileeof,reachedeof:boolean; - eoltype:integer; - procedure checkandread; + property detectedeol : integer read fdetectedeol; end; - + implementation constructor treadtxt.create(asourcestream: tstream; adestroysourcestream:boolean); @@ -78,21 +81,51 @@ end; function treadtxt.readline; var a,b,c,d:integer; + prevchar : integer; + trimchar : boolean; begin - + prevchar := 0; result := ''; repeat checkandread; b := numread-1; - + trimchar := false; {core search loop begin} d := -1; for a := bufpointer to b do begin c := buf[a]; - if (c = 10) or (c = 13) then begin - d := a; - break; + //check if the character can possiblly be a line ending before getting + //into the more complex checks that depend on eol type + if (c = 10) or (c = 13) then case allowedeol of + eoltype_any: begin + d := a; + break; + end; + eoltype_cr: begin + if (c = 13) then begin + d := a; + break; + end; + end; + eoltype_lf: begin + if (c = 10) then begin + d := a; + break; + end; + end; + eoltype_crlf: begin + if (c = 10) and (prevchar= 13) then begin + d := a; + trimchar := true; + break; + end; + prevchar := c; + end; + else begin + raise exception.create('undefined eol type set'); + end; end; + prevchar := c; end; {core search loop end} @@ -114,18 +147,24 @@ begin currenteol := buf[d]; {end of line before end of buffer} - if (currenteol = 10) and (preveol = 13) then begin + if (currenteol = 10) and (preveol = 13) and (bufpointer = d) then begin {it's the second EOL char of a DOS line ending, don't cause a line} bufpointer := d+1; - eoltype := eoltype_crlf; + fdetectedeol := eoltype_crlf; end else begin - if eoltype = eoltype_none then begin - if (currenteol = 10) then eoltype := eoltype_lf else eoltype := eoltype_cr; + if fdetectedeol = eoltype_none then begin + if (currenteol = 10) then fdetectedeol := eoltype_lf else fdetectedeol := eoltype_cr; end; b := d-bufpointer; - setlength(result,c+b); - move(buf[bufpointer],result[c+1],b); - bufpointer := d+1; + if trimchar then begin + setlength(result,c+b-1); + move(buf[bufpointer],result[c+1],b-1); + bufpointer := d+1; + end else begin + setlength(result,c+b); + move(buf[bufpointer],result[c+1],b); + bufpointer := d+1; + end; {EOF check} if fileeof then begin diff --git a/testreadtxt2.dpr b/testreadtxt2.dpr index 1e1d69a..3e7d0df 100644 --- a/testreadtxt2.dpr +++ b/testreadtxt2.dpr @@ -23,14 +23,44 @@ begin writestring(f,'DOS'#13#10); writestring(f,'UNIX'#10); writestring(f,'MAC'#13); + writestring(f,'UNIX'#10); writestring(f,'NONE'); closefile(f); + + writeln('reading test file in default mode (all line endings treated as line endings)'); t := treadtxt.createf('mixed.txt'); if t.readline = 'DOS' then writeln('DOS success') else writeln('DOS fail'); if t.readline = 'UNIX' then writeln('UNIX success') else writeln('UNIX fail'); if t.readline = 'MAC' then writeln('MAC success') else writeln('MAC fail'); + if t.readline = 'UNIX' then writeln('UNIX success') else writeln('UNIX fail'); if t.readline = 'NONE' then writeln('NONE success') else writeln('NONE fail'); t.destroy; + + writeln('reading test file with only CR treated as a line ending'); + t := treadtxt.createf('mixed.txt'); + t.allowedeol := eoltype_cr; + if t.readline = 'DOS' then writeln('DOS success') else writeln('DOS fail'); + if t.readline = #10'UNIX'#10'MAC' then writeln('LF+UNIX+LF+MAC success') else writeln('LF+UNIX+LF+MAC fail'); + if t.readline = 'UNIX'#10'NONE' then writeln('UNIX+LF+NONE success') else writeln('UNIX+LF+NONE fail'); + t.destroy; + + writeln('reading test file with only LF treated as a line ending'); + t := treadtxt.createf('mixed.txt'); + t.allowedeol := eoltype_lf; + if t.readline = 'DOS'#13 then writeln('DOS+CR success') else writeln('DOS+CR fail'); + if t.readline = 'UNIX' then writeln('UNIX success') else writeln('UNIX fail'); + if t.readline = 'MAC'#13'UNIX' then writeln('MAC+CR+UNIX success') else writeln('MAC+CR+UNIX fail'); + if t.readline = 'NONE' then writeln('NONE success') else writeln('NONE fail'); + t.destroy; + + writeln('reading test file with only CRLF treated as a line ending'); + t := treadtxt.createf('mixed.txt'); + t.allowedeol := eoltype_crlf; + if t.readline = 'DOS' then writeln('DOS success') else writeln('DOS fail'); + if t.readline = 'UNIX'#10'MAC'#13'UNIX'#10'NONE' then writeln('UNIX+LF+MAC+CR+UNIX+LF+NONE success') else writeln('UNIX+LF+MAC+CR+UNIX+LF+NONE fail'); + t.destroy; + + {$ifdef win32} //make things a little easier to test in the delphi GUI readln;