-{$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}\r
+unit lserial;\r
+interface\r
+uses \r
+ lcore;\r
+ \r
+type\r
+ tlserial=class(tlasio)\r
+ public \r
+ device: string;\r
+ baudrate: longint;\r
+ procedure open;\r
+ end;\r
+ \r
+ \r
+implementation\r
+uses\r
+ baseunix,\r
+ unix,\r
+ unixutil,\r
+ termio, // despite the name the fpc termio unit seems to be an interface to termios\r
+ sysutils;\r
+procedure tlserial.open;\r
+var\r
+ fd : longint;\r
+ config : termios;\r
+ baudrateos : longint;\r
+begin\r
+ fd := fpopen(device,O_RDWR or O_NOCTTY or O_NONBLOCK);\r
+ \r
+ if isatty(fd)=0 then begin\r
+ writeln('not a tty');\r
+ halt(1);\r
+ end;\r
+\r
+ fillchar(config,sizeof(config),#0);\r
+ config.c_cflag := CLOCAL or CREAD;\r
+ cfmakeraw(config);\r
+ case baudrate of\r
+ 50: baudrateos := B50;\r
+ 75: baudrateos := B75;\r
+ 110: baudrateos := B110;\r
+ 134: baudrateos := B134;\r
+ 150: baudrateos := B150;\r
+ 200: baudrateos := B200;\r
+ 300: baudrateos := B300;\r
+ 600: baudrateos := B600;\r
+ 1200: baudrateos := B1200;\r
+ 1800: baudrateos := B1800;\r
+ 2400: baudrateos := B2400;\r
+ 4800: baudrateos := B4800;\r
+ 9600: baudrateos := B9600;\r
+ 19200: baudrateos := B19200;\r
+ 38400: baudrateos := B38400;\r
+ 57600: baudrateos := B57600;\r
+ 115200: baudrateos := B115200;\r
+ 230400: baudrateos := B230400; \r
+ else raise exception.create('unrecognised baudrate');\r
+ end;\r
+ cfsetispeed(config,baudrateos);\r
+ cfsetospeed(config,baudrateos);\r
+ config.c_cc[VMIN] := 1;\r
+ config.c_cc[VTIME] := 0;\r
+ if tcsetattr(fd,TCSAFLUSH,config) <0 then begin\r
+ writeln('could not set termios attributes');\r
+ halt(3);\r
+ end;\r
+ dup(fd);\r
+ closehandles := true;\r
+end;\r
+end.\r
const\r
bufsize=4096;\r
eoltype_none=0;\r
+ eoltype_any=0;\r
eoltype_cr=1;\r
eoltype_lf=2;\r
eoltype_crlf=3;\r
\r
type\r
treadtxt=class(tobject)\r
+ private\r
+ buf:array[0..bufsize-1] of byte;\r
+ numread:integer;\r
+ bufpointer:integer;\r
+ currenteol,preveol:integer;\r
+ fileeof,reachedeof:boolean;\r
+ fdetectedeol:integer;\r
+ procedure checkandread;\r
public\r
sourcestream:tstream;\r
destroysourcestream:boolean;\r
+ allowedeol:integer;\r
constructor create(asourcestream: tstream; adestroysourcestream:boolean);\r
constructor createf(filename : string);\r
\r
function readline:ansistring;\r
function eof:boolean;\r
destructor destroy; override;\r
- private\r
- buf:array[0..bufsize-1] of byte;\r
- numread:integer;\r
- bufpointer:integer;\r
- currenteol,preveol:integer;\r
- fileeof,reachedeof:boolean;\r
- eoltype:integer;\r
- procedure checkandread;\r
+ property detectedeol : integer read fdetectedeol;\r
end;\r
-\r
+ \r
implementation\r
\r
constructor treadtxt.create(asourcestream: tstream; adestroysourcestream:boolean);\r
function treadtxt.readline;\r
var\r
a,b,c,d:integer;\r
+ prevchar : integer;\r
+ trimchar : boolean;\r
begin\r
-\r
+ prevchar := 0;\r
result := '';\r
repeat\r
checkandread;\r
b := numread-1;\r
-\r
+ trimchar := false;\r
{core search loop begin}\r
d := -1;\r
for a := bufpointer to b do begin\r
c := buf[a];\r
- if (c = 10) or (c = 13) then begin\r
- d := a;\r
- break;\r
+ //check if the character can possiblly be a line ending before getting\r
+ //into the more complex checks that depend on eol type\r
+ if (c = 10) or (c = 13) then case allowedeol of\r
+ eoltype_any: begin\r
+ d := a;\r
+ break;\r
+ end;\r
+ eoltype_cr: begin\r
+ if (c = 13) then begin\r
+ d := a;\r
+ break;\r
+ end;\r
+ end;\r
+ eoltype_lf: begin\r
+ if (c = 10) then begin\r
+ d := a;\r
+ break;\r
+ end;\r
+ end;\r
+ eoltype_crlf: begin\r
+ if (c = 10) and (prevchar= 13) then begin\r
+ d := a;\r
+ trimchar := true;\r
+ break;\r
+ end;\r
+ prevchar := c;\r
+ end;\r
+ else begin\r
+ raise exception.create('undefined eol type set');\r
+ end;\r
end;\r
+ prevchar := c;\r
end;\r
{core search loop end}\r
\r
currenteol := buf[d];\r
\r
{end of line before end of buffer}\r
- if (currenteol = 10) and (preveol = 13) then begin\r
+ if (currenteol = 10) and (preveol = 13) and (bufpointer = d) then begin\r
{it's the second EOL char of a DOS line ending, don't cause a line}\r
bufpointer := d+1;\r
- eoltype := eoltype_crlf;\r
+ fdetectedeol := eoltype_crlf;\r
end else begin\r
- if eoltype = eoltype_none then begin\r
- if (currenteol = 10) then eoltype := eoltype_lf else eoltype := eoltype_cr;\r
+ if fdetectedeol = eoltype_none then begin\r
+ if (currenteol = 10) then fdetectedeol := eoltype_lf else fdetectedeol := eoltype_cr;\r
end; \r
b := d-bufpointer;\r
- setlength(result,c+b);\r
- move(buf[bufpointer],result[c+1],b);\r
- bufpointer := d+1;\r
+ if trimchar then begin\r
+ setlength(result,c+b-1);\r
+ move(buf[bufpointer],result[c+1],b-1);\r
+ bufpointer := d+1;\r
+ end else begin\r
+ setlength(result,c+b);\r
+ move(buf[bufpointer],result[c+1],b);\r
+ bufpointer := d+1;\r
+ end;\r
\r
{EOF check}\r
if fileeof then begin\r
writestring(f,'DOS'#13#10);\r
writestring(f,'UNIX'#10);\r
writestring(f,'MAC'#13);\r
+ writestring(f,'UNIX'#10);\r
writestring(f,'NONE');\r
closefile(f);\r
+ \r
+ writeln('reading test file in default mode (all line endings treated as line endings)');\r
t := treadtxt.createf('mixed.txt');\r
if t.readline = 'DOS' then writeln('DOS success') else writeln('DOS fail');\r
if t.readline = 'UNIX' then writeln('UNIX success') else writeln('UNIX fail');\r
if t.readline = 'MAC' then writeln('MAC success') else writeln('MAC fail');\r
+ if t.readline = 'UNIX' then writeln('UNIX success') else writeln('UNIX fail');\r
if t.readline = 'NONE' then writeln('NONE success') else writeln('NONE fail');\r
t.destroy;\r
+ \r
+ writeln('reading test file with only CR treated as a line ending');\r
+ t := treadtxt.createf('mixed.txt');\r
+ t.allowedeol := eoltype_cr;\r
+ if t.readline = 'DOS' then writeln('DOS success') else writeln('DOS fail');\r
+ if t.readline = #10'UNIX'#10'MAC' then writeln('LF+UNIX+LF+MAC success') else writeln('LF+UNIX+LF+MAC fail');\r
+ if t.readline = 'UNIX'#10'NONE' then writeln('UNIX+LF+NONE success') else writeln('UNIX+LF+NONE fail');\r
+ t.destroy;\r
+\r
+ writeln('reading test file with only LF treated as a line ending');\r
+ t := treadtxt.createf('mixed.txt');\r
+ t.allowedeol := eoltype_lf;\r
+ if t.readline = 'DOS'#13 then writeln('DOS+CR success') else writeln('DOS+CR fail');\r
+ if t.readline = 'UNIX' then writeln('UNIX success') else writeln('UNIX fail');\r
+ if t.readline = 'MAC'#13'UNIX' then writeln('MAC+CR+UNIX success') else writeln('MAC+CR+UNIX fail');\r
+ if t.readline = 'NONE' then writeln('NONE success') else writeln('NONE fail');\r
+ t.destroy;\r
+\r
+ writeln('reading test file with only CRLF treated as a line ending');\r
+ t := treadtxt.createf('mixed.txt');\r
+ t.allowedeol := eoltype_crlf;\r
+ if t.readline = 'DOS' then writeln('DOS success') else writeln('DOS fail');\r
+ 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');\r
+ t.destroy;\r
+\r
+ \r
{$ifdef win32}\r
//make things a little easier to test in the delphi GUI\r
readln;\r
lcore.org gitweb / lcore.git / commitdiff