development/compilers/freepascal/rtl/unix/printer.pp

   1 {
   2     $Id$
   3     This file is part of the Free Pascal run time library.
   4     Copyright (c) 1999-2000 by Michael Van Canneyt,
   5     member of the Free Pascal development team.
   6
   7     See the file COPYING.FPC, included in this distribution,
   8     for details about the copyright.
   9
  10     This program is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13
  14  **********************************************************************}
  15
  16 {   Change Log
  17    ----------
  18
  19    Started by Michael Van Canneyt, 1996
  20    (michael@tfdec1.fys.kuleuven.ac.be)
  21
  22    Current version is 0.9
  23
  24    Date          Version          Who         Comments
  25    1999-2000 by         0.8              Michael     Initial implementation
  26    11/97         0.9              Peter Vreman <pfv@worldonline.nl>
  27                                               Unit now depends on the
  28                                               linux unit only.
  29                                               Cleaned up code.
  30
  31   ---------------------------------------------------------------------}
  32
  33 Unit printer;
  34
  35 Interface
  36
  37 {.$DEFINE PRINTERDEBUG}
  38
  39 Const
  40   DefFile = '/tmp/PID.lst';
  41
  42 Var
  43   Lst : Text;
  44
  45 Procedure AssignLst ( Var F : text; ToFile : string);
  46 {
  47  Assigns to F a printing device. ToFile is a string with the following form:
  48  '|filename options'  : This sets up a pipe with the program filename,
  49                         with the given options
  50  'filename' : Prints to file filename. Filename can contain the string 'PID'
  51               (No Quotes), which will be replaced by the PID of your program.
  52               When closing lst, the file will be sent to lpr and deleted.
  53               (lpr should be in PATH)
  54
  55  'filename|' Idem as previous, only the file is NOT sent to lpr, nor is it
  56              deleted.
  57              (useful for opening /dev/printer or for later printing)
  58
  59  Lst is set up using '/tmp/PID.lst'. You can change this behaviour at
  60  compile time, setting the DefFile constant.
  61 }
  62
  63 Implementation
  64 Uses Linux,Strings;
  65
  66 {
  67   include definition of textrec
  68 }
  69 {$i textrec.inc}
  70
  71
  72 Const
  73   P_TOF   = 1; { Print to file }
  74   P_TOFNP = 2; { Print to File, don't spool }
  75   P_TOP   = 3; { Print to Pipe }
  76
  77 Var
  78   Lpr      : String[255]; { Contains path to lpr binary, including null char }
  79   SaveExit : pointer;
  80
  81
  82 Procedure PrintAndDelete (f:string);
  83 var
  84   i,j  : longint;
  85   p,pp : ppchar;
  86 begin
  87   f:=f+#0;
  88   if lpr='' then
  89    exit;
  90   i:=Fork;
  91   if i<0 then
  92    exit; { No printing was done. We leave the file where it is.}
  93   if i=0 then
  94    begin
  95    { We're in the child }
  96      getmem(p,12);
  97      if p=nil then
  98       halt(127);
  99      pp:=p;
 100      pp^:=@lpr[1];
 101      inc(pp);
 102      pp^:=@f[1];
 103      inc(pp);
 104      pp^:=nil;
 105      Execve(lpr,p,envp);
 106      { In trouble here ! }
 107      halt(128)
 108    end
 109   else
 110    begin
 111    { We're in the parent. }
 112      waitpid (i,@j,0);
 113      if j<>0 then
 114       exit;
 115    { Erase the file }
 116      Unlink(f);
 117    end;
 118 end;
 119
 120
 121
 122 Procedure OpenLstPipe ( Var F : Text);
 123 begin
 124   POpen (f,StrPas(textrec(f).name),'W');
 125 end;
 126
 127
 128
 129 Procedure OpenLstFile ( Var F : Text);
 130 var
 131   i : longint;
 132 begin
 133 {$IFDEF PRINTERDEBUG}
 134   writeln ('Printer : In OpenLstFile');
 135 {$ENDIF}
 136  If textrec(f).mode <> fmoutput then
 137   exit;
 138  textrec(f).userdata[15]:=0; { set Zero length flag }
 139  i:=fdOpen(StrPas(textrec(f).name),(Open_WrOnly or Open_Creat), 438);
 140  if i<0 then
 141   textrec(f).mode:=fmclosed
 142  else
 143   textrec(f).handle:=i;
 144 end;
 145
 146
 147
 148 Procedure CloseLstFile ( Var F : Text);
 149 begin
 150 {$IFDEF PRINTERDEBUG}
 151   writeln ('Printer : In CloseLstFile');
 152 {$ENDIF}
 153   fdclose (textrec(f).handle);
 154 { In case length is zero, don't print : lpr would give an error }
 155   if (textrec(f).userdata[15]=0) and (textrec(f).userdata[16]=P_TOF) then
 156    begin
 157      Unlink(StrPas(textrec(f).name));
 158      exit
 159    end;
 160 { Non empty : needs printing ? }
 161   if (textrec(f).userdata[16]=P_TOF) then
 162    PrintAndDelete (strpas(textrec(f).name));
 163   textrec(f).mode:=fmclosed
 164 end;
 165
 166
 167
 168 Procedure InOutLstFile ( Var F : text);
 169 begin
 170 {$IFDEF PRINTERDEBUG}
 171   writeln ('Printer : In InOutLstFile');
 172 {$ENDIF}
 173   If textrec(f).mode<>fmoutput then
 174    exit;
 175   if textrec(f).bufpos<>0 then
 176    textrec(f).userdata[15]:=1; { Set it is not empty. Important when closing !!}
 177   fdwrite(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufpos);
 178   textrec(f).bufpos:=0;
 179 end;
 180
 181
 182
 183 Procedure SubstPidInName ( Var s : string);
 184 var
 185   i    : longint;
 186   temp : string[8];
 187 begin
 188   i:=pos('PID',s);
 189   if i=0 then
 190    exit;
 191   delete (s,i,3);
 192   str(GetPid,temp);
 193   insert(temp,s,i);
 194 {$IFDEF PRINTERDEBUG}
 195   writeln ('Print : Filename became : ',s);
 196 {$ENDIF}
 197 end;
 198
 199
 200
 201 Procedure AssignLst ( Var F : text; ToFile : string);
 202 begin
 203 {$IFDEF PRINTERDEBUG}
 204   writeln ('Printer : In AssignLst');
 205 {$ENDIF}
 206   If ToFile='' then
 207    exit;
 208   textrec(f).bufptr:=@textrec(f).buffer;
 209   textrec(f).bufsize:=128;
 210   SubstPidInName (Tofile);
 211   if ToFile[1]='|' then
 212    begin
 213      Assign(f,Copy(ToFile,2,255));
 214      textrec(f).userdata[16]:=P_TOP;
 215      textrec(f).OpenFunc:=@OpenLstPipe;
 216    end
 217   else
 218    begin
 219     if Tofile[Length(ToFile)]='|' then
 220       begin
 221         Assign(f,Copy(ToFile,1,length(Tofile)-1));
 222         textrec(f).userdata[16]:=P_TOFNP;
 223       end
 224      else
 225       begin
 226         Assign(f,ToFile);
 227         textrec(f).userdata[16]:=P_TOF;
 228       end;
 229      textrec(f).OpenFunc:=@OpenLstFile;
 230      textrec(f).CloseFunc:=@CloseLstFile;
 231      textrec(f).InoutFunc:=@InoutLstFile;
 232      textrec(f).FlushFunc:=@InoutLstFile;
 233    end;
 234 end;
 235
 236
 237
 238 Procedure PrinterExitProc;
 239 begin
 240   close(lst);
 241   ExitProc:=SaveExit
 242 end;
 243
 244
 245
 246 begin
 247   SaveExit:=ExitProc;
 248   ExitProc:=@PrinterExitProc;
 249   AssignLst(Lst,DefFile);
 250   rewrite(Lst);
 251   lpr:='/usr/bin/lpr';
 252 end.
 253
 254
 255 {
 256   $Log$
 257   Revision 1.1  2002/02/19 08:26:20  sasu
 258   Initial revision
 259
 260   Revision 1.1.2.1  2000/09/14 13:38:26  marco
 261    * Moved from Linux dir. now start of generic unix dir, from which the
 262       really exotic features should be moved to the target specific dirs.
 263
 264   Revision 1.1  2000/07/13 06:30:54  michael
 265   + Initial import
 266
 267   Revision 1.7  2000/02/09 16:59:32  peter
 268     * truncated log
 269
 270   Revision 1.6  2000/01/07 16:41:41  daniel
 271     * copyright 2000
 272
 273   Revision 1.5  2000/01/07 16:32:28  daniel
 274     * copyright 2000 added
 275
 276   Revision 1.4  1999/09/08 16:14:43  peter
 277     * pointer fixes
 278
 279 }