1{%MainUnit ../osprinters.pas}
2{$IFDEF DebugCUPS}
3{$DEFINE LogPrintoutFile}
4{$ENDIF}
5
6{**************************************************************
7Implementation for cupsprinter
8***************************************************************}
9uses
10  {%H-}udlgSelectPrinter, // used to compile it on this target
11  {%H-}udlgpropertiesprinter, // used to compile it on this target
12  FileUtil, LazFileUtils;
13
14const
15  CUPS_CUSTOM_PAPER = 'Custom';
16
17//Return always 72 because, PostScript it's 72 only
18function TCUPSPrinter.GetXDPI: Integer;
19begin
20  Result:=InternalGetResolution(True);
21end;
22
23//Return always 72 because, PostScript it's 72 only
24function TCUPSPrinter.GetYDPI: Integer;
25begin
26  Result:=InternalGetResolution(False);
27end;
28
29procedure TCUPSPrinter.DoEnumBins(Lst: TStrings);
30var
31  choice: Pppd_choice_t;
32  Option: Pppd_option_t;
33  c: Integer;
34begin
35  Lst.Clear;
36  if CupsPPD<>nil then
37  begin
38    Option := ppdFindOption(CupsPPD, PChar('InputSlot'));
39    if Option<>nil then
40    begin
41      Choice := Option^.choices;
42      c := 0;
43      while (Choice<>nil) and (c<Option^.num_choices) do
44      begin
45        lst.AddObject(Choice^.text, TObject(Choice));
46        inc(choice);
47        inc(c);
48      end;
49    end;
50  end;
51end;
52
53function TCUPSPrinter.DoGetDefaultBinName: string;
54var
55  Option: Pppd_option_t;
56  Choice: pppd_choice_t;
57begin
58  Result:=inherited DoGetDefaultBinName;
59
60  if CupsPPD<>nil then
61  begin
62    Option := ppdFindOption(CupsPPD, 'InputSlot');
63    if Option<>nil then
64    begin
65      choice := PPDOptionChoiceFrom('InputSlot', Option^.defchoice, true);
66      if choice<>nil then
67        result := choice^.text;
68    end;
69  end;
70end;
71
72function TCUPSPrinter.DoGetBinName: string;
73var
74  Choice: pppd_choice_t;
75begin
76  result := cupsGetOption('InputSlot');
77  if result<>'' then
78  begin
79    Choice := PPDOptionChoiceFrom('InputSlot', result, true);
80    if Choice<>nil then
81      result := Choice^.text
82    else
83      result := '';
84  end;
85
86  if result='' then
87    result := doGetDefaultBinName
88end;
89
90procedure TCUPSPrinter.DoSetBinName(aName: string);
91var
92  Choice: pppd_choice_t;
93begin
94  Choice := PPDOptionChoiceFrom('InputSlot', aName, false);
95  if Choice<>nil then
96    cupsAddOption('InputSlot', choice^.choice)
97  else
98    inherited doSetBinName(aName); // handle input slot not found
99end;
100
101//write count bytes from buffer to raw mode stream
102function TCUPSPrinter.Write(const Buffer; Count: Integer; out Written: Integer
103  ): Boolean;
104begin
105  result := False;
106  CheckRawMode(True);
107  if not Assigned(FRawModeStream) then
108    FRawModeStream := TMemoryStream.Create;
109  Written := FRawModeStream.Write(Buffer, Count);
110  Result := True;
111end;
112
113constructor TCUPSPrinter.Create;
114begin
115  inherited Create;
116
117  fcupsPrinters:=nil;
118  fcupsPrinter :=nil;
119  fcupsHttp    :=nil;
120  fcupsPPD     :=nil;
121  fcupsOptions :=nil;
122  fcupsNumOpts :=0;
123
124  FRawModeStream   := nil;
125  FCupsPapersCount := -1;
126end;
127
128procedure TCUPSPrinter.DoDestroy;
129begin
130  if assigned(fRawModeStream) then
131    fRawModeStream.Free;
132
133  FreeOptions;
134
135  if Assigned(fcupsHttp) then
136    httpClose(fcupsHttp);
137
138  inherited DoDestroy;
139end;
140
141procedure TCUPSPrinter.FreeOptions;
142begin
143  if Assigned(fcupsOptions) then
144    cupsFreeOptions(fcupsNumOpts,fcupsOptions);
145
146  fcupsNumOpts:=0;
147  fcupsOptions:=nil;
148  FStates := [];
149end;
150
151procedure TCUPSPrinter.cupsAddOption(aName,aValue: string);
152begin
153  if not CUPSLibInstalled then Exit;
154  fcupsNumOpts:=cupsdyn.cupsAddOption(PChar(aName),PChar(aValue),fcupsNumOpts,
155                                                                @fcupsOptions);
156  if (AName='PageSize') then
157  begin
158    Exclude(FStates,cpsPaperNameValid);
159    Exclude(FStates,cpsPaperRectValid);
160  end;
161
162  {$IFDEF DebugCUPS}
163  DebugLn('TCUPSPrinter.cupsAddOption AName=%s AValue=%s',[AName,AValue]);
164  {$ENDIF}
165end;
166
167//Return the value of option set for the selected printer
168function TCUPSPrinter.cupsGetOption(aKeyWord: string): String;
169begin
170  Result:='';
171  if not CUPSLibInstalled then Exit;
172  if (Printers.Count>0) then
173  begin
174    if not Assigned(fcupsOptions) then
175         SetOptionsOfPrinter;
176
177    Result:=cupsdyn.cupsGetOption(PChar(aKeyWord),fcupsNumOpts,fcupsOptions);
178  end;
179end;
180
181function TCUPSPrinter.CopyOptions(out AOptions: Pcups_option_t): Integer;
182var
183  i: Integer;
184begin
185  AOptions := nil;
186  Result := 0;
187  for i:=0 to fcupsNumOpts-1 do
188    Result := cupsdyn.cupsAddOption(fcupsOptions[i].name,fcupsOptions[i].value,
189               Result,@AOptions);
190end;
191
192procedure TCUPSPrinter.MergeOptions(const AOptions:Pcups_option_t; const n:Integer);
193var
194  i: Integer;
195begin
196  for i:=0 to n-1 do
197    if
198      // always merge some known options
199      (strcomp('job-sheets', AOptions[i].name)=0) or
200      // check if ppd option value is valid
201      IsOptionValueValid(AOptions[i].name, AOptions[i].value)
202    then
203      cupsAddOption(AOptions[i].name, AOptions[i].value);
204  cupsFreeOptions(n, AOptions);
205end;
206
207function TCUPSPrinter.GetResolutionOption: string;
208var
209  L1,L2: TStringlist;
210  i: Integer;
211begin
212  Result := Self.cupsGetOption('Resolution');
213  if Result='' then
214  begin
215    // get resolution from ppd
216    Result := GetPPDAttribute('DefaultResolution');
217    if Result='' then
218    begin
219      // try grouped options
220      L1 := TStringList.Create;
221      L2 := TStringList.Create;
222      try
223        i := EnumPPDChoice(L1,'Resolution',L2);
224        if i>=0 then
225          Result := L2[i]
226      finally
227        L2.Free;
228        L1.Free;
229      end;
230    end;
231  end;
232end;
233
234procedure TCUPSPrinter.DebugOptions(AOPtions:Pcups_option_t=nil; n:Integer=0);
235var
236  i: Integer;
237begin
238  if (Printers.Count>0) and CUPSLibInstalled and (fcupsPrinter<>nil) then
239  begin
240    DebugLn('**************************************************');
241    if AOptions=nil then
242    begin
243      AOptions:= fcupsOptions;
244      n := fcupsNumOpts;
245    end;
246    DebugLn('Printer "%s" Number of Options %d',[fcupsPrinter^.Name,n]);
247    for i:=0 to n-1 do
248      DebugLn('name="%s" value="%s"',[AOptions[i].name,AOptions[i].value]);
249    DebugLn('**************************************************');
250  end else
251    DebugLn('DebugOptions: There are no valid printers');
252end;
253
254procedure TCUPSPrinter.DoCupsConnect;
255begin
256  if not assigned(fcupsHttp) then
257  begin
258    if not CUPSLibInstalled then Exit;
259    fcupsHttp:=httpConnect(cupsServer(),ippPort());
260    if not Assigned(fcupsHttp) then
261       raise Exception.Create('Unable to contact server: '+GetLastError);
262  end;
263end;
264
265procedure TCUPSPrinter.DoCustomPaper;
266var
267  aSize: String;
268begin
269  // while the default canvas class is TCairoPsCanvas, this is not
270  // technically necessary, as the canvas setup the page size itself.
271  aSize := format('%s.%dx%d', [ CUPS_CUSTOM_PAPER, round(fCustomPaperWidth),
272                                round(fCustomPaperHeight) ]);
273  cupsAddOption('PageSize', aSize);
274  {$IFDEF DebugCUPS}
275  DebugLn('Using CustomPaper ', aSize);
276  {$ENDIF}
277end;
278
279function TCUPSPrinter.CupsPapersListValid: boolean;
280var
281  Lst: TStringlist;
282begin
283  if fCupsPapersCount<=0 then begin
284    // paper list no exists or
285    // paper list is not enumerated yet, try it now.
286    Lst := TStringlist.Create;
287    try
288      DoEnumPapers(Lst);
289    finally
290      Lst.Free;
291    end;
292  end;
293  result := fCupsPapersCount>0;
294end;
295
296function TCUPSPrinter.InternalGetResolution(ForX: boolean): Integer;
297
298  procedure ParseResolution(s:string);
299  var
300    a,b: Integer;
301  begin
302    if s<>'' then begin
303      s := uppercase(s);
304      a := pos('X', S);
305      b := pos('D', S);
306      if b=0 then
307        b := Length(S)
308      else
309        dec(b);
310      if a>0 then begin
311        // NNNXMMMDPI (or NNN X MMM DPI)
312        FCachedResolution.x := StrToIntDef(trim(copy(S,1,a-1)), 0);
313        FCAchedResolution.y := StrToIntDef(trim(copy(S,a+1,b)), 0);
314      end else begin
315        // NNNDPI (or NNN DPI);
316        FCachedResolution.x := StrToIntDef(trim(copy(S,1,b)), 0);
317        FCachedResolution.y := FCachedResolution.x;
318      end;
319    end;
320  end;
321
322begin
323  if not (cpsResolutionValid in FStates) then begin
324    // check user defined resolution
325    FCachedResolution.x := 0;
326    FCachedResolution.y := 0;
327
328    ParseResolution(GetResolutionOption);
329
330    if (FCachedResolution.x=0) or (FCachedResolution.y=0) then
331    begin
332      FCachedResolution.x := 300;
333      FCachedResolution.y := 300;
334    end;
335
336    include(FStates, cpsResolutionValid);
337  end;
338  if ForX then
339    result := FCachedResolution.X
340  else
341    result := FCachedResolution.Y;
342end;
343
344{$IFDEF DebugCUPS}
345procedure TCUPSPrinter.DebugCapabilities;
346var
347  flags: Integer;
348
349  procedure DumpCap(const aFlag: integer; const flagMsg, Desc: string; invert: boolean=false);
350  begin
351    if (invert and (aFlag and Flags=0)) or (not invert and (aFlag and Flags<>0)) then
352      DebugLn(flagMsg, '(',Desc,')');
353  end;
354begin
355  flags := GetAttributeInteger('printer-type',CUPS_PRINTER_LOCAL);
356  DebugLn('=== CAPABILITIES ===');
357  DebugLn;
358  DumpCap(CUPS_PRINTER_CLASS or CUPS_PRINTER_REMOTE, 'CUPS_PRINTER_LOCAL    ', 'Local printer or class    ', true);
359  DumpCap(CUPS_PRINTER_CLASS     , 'CUPS_PRINTER_CLASS    ', 'Printer class             ');
360  DumpCap(CUPS_PRINTER_REMOTE    , 'CUPS_PRINTER_REMOTE   ', 'Remote printer or class   ');
361  DumpCap(CUPS_PRINTER_BW        , 'CUPS_PRINTER_BW       ', 'Can do B&W printing       ');
362  DumpCap(CUPS_PRINTER_COLOR     , 'CUPS_PRINTER_COLOR    ', 'Can do color printing     ');
363  DumpCap(CUPS_PRINTER_DUPLEX    , 'CUPS_PRINTER_DUPLEX   ', 'Can do duplexing          ');
364  DumpCap(CUPS_PRINTER_STAPLE    , 'CUPS_PRINTER_STAPLE   ', 'Can staple output         ');
365  DumpCap(CUPS_PRINTER_COPIES    , 'CUPS_PRINTER_COPIES   ', 'Can do copies             ');
366  DumpCap(CUPS_PRINTER_COLLATE   , 'CUPS_PRINTER_COLLATE  ', 'Can collage copies        ');
367  DumpCap(CUPS_PRINTER_PUNCH     , 'CUPS_PRINTER_PUNCH    ', 'Can punch output          ');
368  DumpCap(CUPS_PRINTER_COVER     , 'CUPS_PRINTER_COVER    ', 'Can cover output          ');
369  DumpCap(CUPS_PRINTER_BIND      , 'CUPS_PRINTER_BIND     ', 'Can bind output           ');
370  DumpCap(CUPS_PRINTER_SORT      , 'CUPS_PRINTER_SORT     ', 'Can sort output           ');
371  DumpCap(CUPS_PRINTER_SMALL     , 'CUPS_PRINTER_SMALL    ', 'Can do Letter/Legal/A4    ');
372  DumpCap(CUPS_PRINTER_MEDIUM    , 'CUPS_PRINTER_MEDIUM   ', 'Can do Tabloid/B/C/A3/A2  ');
373  DumpCap(CUPS_PRINTER_LARGE     , 'CUPS_PRINTER_LARGE    ', 'Can do D/E/A1/A0          ');
374  DumpCap(CUPS_PRINTER_VARIABLE  , 'CUPS_PRINTER_VARIABLE ', 'Can do variable sizes     ');
375  DumpCap(CUPS_PRINTER_IMPLICIT  , 'CUPS_PRINTER_IMPLICIT ', 'Implicit class            ');
376  DumpCap(CUPS_PRINTER_DEFAULT   , 'CUPS_PRINTER_DEFAULT  ', 'Default printer on network');
377end;
378
379procedure TCUPSPrinter.DebugPPD;
380const
381  arruitypes:array[ppd_ui_t] of string[9] = ('boolean','pickone','pickmany');
382  arrsection:array[ppd_section_t] of string[9] = ('any','document','exit','jcl','page','prolog');
383var
384  i,j,k: Integer;
385  AttrRoot  : Ppppd_attr_t;
386  Attr      : Pppd_attr_t;
387  Group     : pppd_group_t;
388  Option    : Pppd_option_t;
389  choices   : Pppd_choice_t;
390
391  function markchar(const AMark:char):char;
392  begin
393    if AMark=#1 then
394      result := '*'
395    else
396      result := ' ';
397  end;
398begin
399  DebugLn;
400  DebugLn('DebugPPD: ppdfile=',fCupsPPDName);
401  if fcupsPPD=nil then
402  begin
403    DebugLn('No valid ppd file found');
404    exit;
405  end;
406
407  DebugLn('=== HEADER ===');
408  DebugLn;
409  DebugLn('  model          : %s', [fcupsPPD^.modelname]);
410  DebugLn('  modelNumber    : %d', [fcupsPPD^.model_number]);
411  DebugLn('  manufacturer   : %s', [fcupsPPD^.manufacturer]);
412  DebugLn('  nickname       : %s', [fcupsPPD^.nickname]);
413  DebugLn('  shortnickname  : %s', [fcupsPPD^.shortnickname]);
414  DebugLn('  product        : %s', [fcupsPPD^.product]);
415  DebugLn('  attributes     : %d Current=%d', [fcupsPPD^.num_attrs,fcupsPPD^.cur_attr]);
416  DebugLn('  language_level : %d', [fcupsPPD^.language_level]);
417  DebugLn('  lang_version   : %s', [fcupsPPD^.lang_version]);
418  DebugLn('  lang_encoding  : %s', [fcupsPPD^.lang_encoding]);
419  DebugLn('  landscape      : %d', [fcupsPPD^.landscape]);
420  DebugLn('  UI groups      : %d', [fcupsPPD^.num_groups]);
421  DebugLn('  Num Papers     : %d', [fcupsPPD^.num_sizes]);
422  DebugLn('  Num Attributes : %d', [fcupsPPD^.num_attrs]);
423  DebugLn('  Num Constrains : %d', [fcupsPPD^.num_consts]);
424  DebugLn;
425  DebugLn('=== CUSTOM PAPER SUPPORT ===');
426  DebugLn;
427  DebugLn('  Custom Min 0   : %.2f',[fcupsPPD^.custom_min[0]]);
428  DebugLn('  Custom Min 1   : %.2f',[fCupsPPD^.custom_min[1]]);
429  DebugLn('  Custom Max 0   : %.2f',[fcupsPPD^.custom_max[0]]);
430  DebugLn('  Custom Max 1   : %.2f',[fcupsPPD^.custom_max[1]]);
431
432  with fcupsPPD^ do
433  DebugLn('  Custom Margins : %.2f %.2f %.2f %.2f',
434    [custom_margins[0],custom_margins[1],custom_margins[2],custom_margins[3]]);
435  DebugLn;
436  if fcupsPPD^.num_groups>0 then
437  begin
438    DebugLn('=== GROUPS ===');
439    i := 0;
440    Group := fCupsPPD^.groups;
441    while (Group<>nil) and (i<fcupsPPD^.num_groups) do
442    begin
443      DebugLn('Group %d Name="%s" Text="%s" Options=%d SubGroups=%d',
444           [i,Group^.name,Group^.text,Group^.num_options,Group^.num_subgroups]);
445      j := 0;
446      Option := group^.options;
447      while j< group^.num_options do
448      begin
449        with Option^ do
450        DebugLn('    Option %d Key="%s" Def="%s" Text="%s" UIType="%s" section="%s" Choices=%d',
451           [j,keyword,defchoice,text,arruitypes[ui],arrsection[section],num_choices]);
452        k := 0;
453        Choices := Option^.choices;
454        while k<Option^.num_choices do
455        begin
456          DebugLn('        Choice %2d %s Choice=%-20s Text="%s"',
457            [k,MarkChar(Choices^.marked),Choices^.Choice,Choices^.Text]);
458          inc(Choices);
459          inc(k);
460        end;
461        inc(Option);
462        inc(j);
463      end;
464      inc(Group);
465      inc(i);
466    end;
467  end;
468
469  DebugLn;
470  if fcupsPPD^.num_attrs>0 then
471  begin
472    DebugLn('=== Attributes ===');
473    i := 0;
474    AttrRoot := fCupsPPD^.attrs;
475    while (AttrRoot<>nil) and (i<fcupsPPD^.num_attrs) do
476    begin
477      Attr := AttrRoot^;
478      if attr<>nil then
479        DebugLn('    i=%d Name=%s Spec=%s Value=%s',[i,Attr^.Name,Attr^.Spec,Attr^.Value]);
480      inc(i);
481      inc(AttrRoot);
482    end;
483  end;
484end;
485{$ENDIF}
486
487//Print the file aFileName with a selected printer and options
488function TCUPSPrinter.PrintFile(aFileName: String): longint;
489var
490  aPrinterName : string;
491begin
492  Result:=-1;
493  //debugln(['TCUPSPrinter.PrintFile START ',aFileName]);
494  if aFileName='' then
495    raise Exception.Create('TCUPSPrinter.PrintFile missing Filename');
496  if not CUPSLibInstalled then Exit;
497  aFileName:=ExpandFileNameUTF8(aFileName);
498
499  if (Printers.Count>0) then
500  begin
501    if not Assigned(fcupsOptions) then
502      SetOptionsOfPrinter;
503
504    if Assigned(fcupsPrinter) then
505      aPrinterName:=fcupsPrinter^.Name
506    else
507      aPrinterName:='';
508
509    {$IFDEF DebugCUPS}
510    DebugOptions;
511    debugln(['TCUPSPrinter.PrintFile aPrinterName="',aPrinterName,'" aFileName="',aFileName,'" Size=',FileSizeUtf8(aFileName)]);
512    {$ENDIF}
513
514    Result:=cupsdyn.cupsPrintFile(PChar(aPrinterName),PChar(aFileName),
515                                  PChar(Self.Title),
516                                  fcupsNumOpts,fcupsOptions);
517  end;
518end;
519
520function TCUPSPrinter.GetLastError: string;
521begin
522  Result:=ippErrorString(cupsdyn.cupsLastError());
523end;
524
525function TCUPSPrinter.IsOptionValueValid(AKeyword, AValue: pchar): boolean;
526var
527  Option: pppd_option_t;
528  i: Integer;
529begin
530  result := false;
531  if (fcupsPrinter=nil) or (fcupsppd=nil) then
532    exit;
533  Option := ppdFindOption(fcupsppd, AKeyword);
534  if Option=nil then
535    exit;
536
537  i:=0;
538  while i<Option^.num_choices do
539  begin
540    if strcomp(Option^.choices[i].choice, AValue)=0 then
541    begin
542      result := true;
543      break;
544    end;
545    inc(i);
546  end;
547
548end;
549
550function TCUPSPrinter.PPDOptionChoiceFrom(OptionStr, aKeyOrValue: string;
551  IsKey:boolean): pppd_choice_t;
552var
553  i: Integer;
554  option: pppd_option_t;
555  p: pchar;
556begin
557  result := nil;
558
559  if (fcupsPrinter=nil) or (fcupsppd=nil) then
560    exit;
561
562  option := ppdFindOption(fcupsppd, pchar(OptionStr));
563  if option=nil then
564    exit;
565
566  for i:=0 to option^.num_choices-1 do
567  begin
568    if IsKey then
569      p := @option^.choices[i].choice
570    else
571      p := @option^.choices[i].text;
572    if strcomp(p, pchar(aKeyOrValue))=0 then
573    begin
574      result := @option^.choices[i];
575      break;
576    end;
577  end;
578end;
579
580
581//Set State of Job
582procedure TCUPSPrinter.SetJobState(aJobId : LongInt; aOp : ipp_op_t);
583var Request,R : Pipp_t;                         //IPP Request
584    Language  : Pcups_lang_t;                   //Default Language
585    URI       : Array[0..HTTP_MAX_URI] of Char; //Printer URI
586begin
587  if not CUPSLibInstalled then Exit;
588  if (Printers.Count>0) then
589  begin
590    if Assigned(fcupsPrinter) then
591    begin
592      R:=nil;
593      DoCupsConnect;
594      Request:=ippNew();
595      Language:=cupsLangDefault();
596
597      ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_CHARSET,
598               'attributes-charset', '', cupsLangEncoding(language));
599
600      ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_LANGUAGE,
601               'attributes-natural-language', '', Language^.language);
602
603      URI:=Format('http://%s:%d/jobs/%d',[cupsServer,ippPort,aJobId]);
604
605      ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_URI,'job-uri','',URI);
606      ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_NAME,'requesting-user-name','',cupsUser());
607
608      Request^.request.op.operation_id := aOp;
609      Request^.request.op.request_id   := 1;
610
611      //Do the request and get back a response...
612      R:=cupsDoRequest(fcupsHttp, Request, '/jobs/');
613      if Assigned(R) then
614      begin
615        if (R^.request.status.status_code>IPP_OK_CONFLICT) then
616          ippDelete(R);
617      end;
618    end;
619  end;
620end;
621
622function TCUPSPrinter.GetCupsRequest : Pipp_t;
623var Request   : Pipp_t; //IPP Request
624    Language  : Pcups_lang_t;     //Default Language
625    URI       : Array[0..HTTP_MAX_URI] of Char; //Printer URI
626begin
627  Result:=Nil;
628  if not CUPSLibInstalled then Exit;
629  if (Printers.Count>0) then
630  begin
631    if Assigned(fcupsPrinter) then
632    begin
633      DoCupsConnect;
634      Request:=ippNew();
635      {Build an IPP_GET_PRINTER_ATTRIBUTES request,
636      which requires the following attributes:
637        attributes-charset
638        attributes-natural-language
639        printer-uri}
640      Request^.request.op.operation_id := IPP_GET_PRINTER_ATTRIBUTES;
641      Request^.request.op.request_id   := 1;
642      Language:=cupsLangDefault;
643
644      ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_CHARSET,
645               'attributes-charset', '', cupsLangEncoding(language));
646
647      ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_LANGUAGE,
648               'attributes-natural-language', '', Language^.language);
649
650      // or this syntax >>
651      //URI:=Format('http://%s:%d/printers/%s',[cupsServer,ippPort,fcupsPrinter^.name]);
652      URI:=Format('ipp://localhost/printers/%s',[fcupsPrinter^.name]);
653      ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_URI,'printer-uri','',URI);
654
655      //Do the request and get back a response...
656      Result:=cupsDoRequest(fcupsHttp, Request, '/');
657      if Assigned(Result) then
658      begin
659        if (Result^.request.status.status_code>IPP_OK_CONFLICT) then
660        begin
661          ippDelete(Result);
662          Result:=nil;
663        end;
664      end;
665    end;
666  end;
667end;
668
669//Initialize the options with the default options of selected printer
670procedure TCUPSPrinter.SetOptionsOfPrinter;
671Var Opts : Pcups_option_t;
672    Opt  : Pcups_option_t;
673    i    : Integer;
674begin
675  //if not CUPSLibInstalled then
676    Exit;
677  if (Printers.Count>0) then
678  begin
679    if Assigned(fcupsPrinter) then
680    begin
681      Opts := fcupsPrinter^.Options;
682      for i:=0 to fcupsPrinter^.num_options-1 do
683      begin
684        Opt:=@Opts[i];
685        cupsAddOption(Opt^.Name,Opt^.Value);
686      end;
687    end;
688  end;
689end;
690
691//Enum all options associed with aKeyWord
692function TCUPSPrinter.EnumPPDChoice(Lst : TStrings;
693  const aKeyWord : string; OptNames: TStrings = nil) : Integer;
694var i         : integer;
695    Option    : Pppd_option_t;
696    Choice    : Pppd_choice_t;
697begin
698  Result:=-1;
699  if not CUPSLibInstalled then Exit;
700  if not Assigned(Lst) then Exit;
701  Lst.Clear;
702
703  if (Printers.Count>0) then
704  begin
705    if Assigned(fcupsPrinter) then
706    begin
707      if Assigned(fcupsPPD) then
708      begin
709        Option:=nil;
710        Option:=ppdFindOption(fcupsPPD,PChar(aKeyWord));
711
712        If Assigned(Option) then
713        begin
714          for i:=0 to Option^.num_choices-1 do
715          begin
716            Choice:=@Option^.choices[i];
717            if Choice^.marked=#1 then
718              Result:=i;
719
720            Lst.Add(Choice^.text);
721            if Assigned(OptNames) then
722              OptNames.Add(Choice^.choice);
723          end;
724
725          //Not marked choice then the choice is default
726          if (Result<0) and (Lst.Count>0) then begin
727            Result:=Lst.IndexOf(OPtion^.defchoice);
728            if (Result<0)and Assigned(OptNames) then
729              Result := OptNames.IndexOf(Option^.DefChoice);
730          end;
731        end;
732      end;
733    end;
734  end;
735end;
736
737function TCUPSPrinter.GetPPDAttribute(const aName: string): string;
738var
739  i         : integer;
740  AttrRoot  : PPppd_attr_t;
741  Attr      : Pppd_attr_t;
742begin
743  Result:='';
744  if not CUPSLibInstalled then
745    Exit;
746
747  if (Printers.Count>0) and (fcupsPrinter<>nil) and (fcupsPPD<>nil) then
748  begin
749    i := 0;
750    AttrRoot := fCupsPPD^.attrs;
751    while (AttrRoot<>nil) and (i<fcupsPPD^.num_attrs) do
752    begin
753      Attr := AttrRoot^;
754      if attr<>nil then
755      begin
756        if (StrComp(pchar(AName), Attr^.name)=0) then
757        begin
758          result := attr^.value;
759          break;
760        end;
761      end;
762      inc(i);
763      inc(AttrRoot);
764    end;
765  end;
766end;
767
768procedure TCUPSPrinter.GetEnumAttributeString(aName: PChar; Lst: TStrings);
769var
770  Reponse   : Pipp_t; //IPP Reponse
771  Attribute : Pipp_attribute_t; //Current attribute
772  i         : Integer;
773begin
774  if not assigned(Lst) then
775    raise Exception.Create('Lst must be assigned');
776  if not CUPSLibInstalled then begin
777    DebugLn(['TCUPSPrinter.GetEnumAttributeString CUPSLibInstalled not installed']);
778    Exit;
779  end;
780
781  Reponse:=GetCupsRequest;
782  if not Assigned(Reponse) then begin
783    DebugLn(['TCUPSPrinter.GetEnumAttributeString no Response']);
784  end else begin
785    try
786      Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
787      if Assigned(Attribute) then begin
788        for i:=0 to Attribute^.num_values-1 do
789        begin
790          if Attribute^.value_tag=IPP_TAG_INTEGER then
791            Lst.add(IntToStr(Pipp_value_t(@Attribute^.values)[i].aInteger))
792          else
793            Lst.add(Pipp_value_t(@Attribute^.values)[i]._string.text);
794        end;
795      end else begin
796        DebugLn(['TCUPSPrinter.GetEnumAttributeString Attribute not found: ',aName]);
797      end;
798    finally
799      ippDelete(Reponse);
800    end;
801  end;
802end;
803
804function TCUPSPrinter.GetAttributeInteger(aName: PChar; DefaultValue : Integer): Integer;
805var
806  Reponse   : Pipp_t; //IPP Reponse
807  Attribute : Pipp_attribute_t; //Current attribute
808begin
809  Result:=DefaultValue;
810  if not CUPSLibInstalled then Exit;
811
812  Reponse:=GetCupsRequest;
813  if Assigned(Reponse) then
814  begin
815    try
816      Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
817      if Assigned(Attribute) then
818        Result:=Attribute^.values[0].aInteger;
819    finally
820      ippDelete(Reponse);
821    end;
822  end;
823end;
824
825function TCUPSPrinter.GetAttributeString(aName: PChar;
826  const DefaultValue : string): string;
827var
828  Reponse   : Pipp_t; //IPP Reponse
829  Attribute : Pipp_attribute_t; //Current attribute
830begin
831  Result:=DefaultValue;
832  if not CUPSLibInstalled then Exit;
833  Reponse:=GetCupsRequest;
834  if Assigned(Reponse) then
835  begin
836    try
837      Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
838      if Assigned(Attribute) then
839        Result:=Attribute^.values[0]._string.text
840      else begin
841        DebugLn(['TCUPSPrinter.GetAttributeString failed: aName="',aName,'"']);
842      end;
843    finally
844      ippDelete(Reponse);
845    end;
846  end;
847end;
848
849function TCUPSPrinter.GetAttributeBoolean(aName: PChar;
850  DefaultValue : Boolean): Boolean;
851var
852  Reponse   : Pipp_t; //IPP Reponse
853  Attribute : Pipp_attribute_t; //Current attribute
854begin
855  Result:=DefaultValue;
856  if not CUPSLibInstalled then Exit;
857  Reponse:=GetCupsRequest;
858  if Assigned(Reponse) then
859  begin
860    try
861      Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
862      if Assigned(Attribute) then
863        Result:=(Attribute^.values[0].aBoolean=#1);
864    finally
865      ippDelete(Reponse);
866    end;
867  end;
868end;
869
870//Override this methode for assign an
871//file name at Canvas
872procedure TCUPSPrinter.DoBeginDoc;
873var
874  NewPath: String;
875  fs: TFileStream;
876
877  function TryTemporaryPath(const Path: string): Boolean;
878  var
879    CurPath: String;
880  begin
881    Result:=false;
882    CurPath:=CleanAndExpandDirectory(Path);
883    if CurPath='' then exit(false);
884    if not DirectoryIsWritable(CurPath) then exit;
885    NewPath:=CurPath;
886    Result:=true;
887  end;
888
889begin
890  if FBeginDocCount>0 then
891    raise Exception.Create('TCUPSPrinter.DoBeginDoc already called. Maybe you forgot an EndDoc?');
892  inherited DoBeginDoc;
893  inc(FBeginDocCount);
894
895  if (not TryTemporaryPath('~/tmp/'))
896  and (not TryTemporaryPath('/tmp/'))
897  and (not TryTemporaryPath('/var/tmp/')) then
898    NewPath:='';
899
900  FOutputFileName := AppendPathDelim(NewPath)+
901    'OutPrinter_'+FormatDateTime('yyyymmmddd-hhnnss',Now);
902
903  if RawMode then
904    FOutputFileName := FOutputFileName + '.raw'
905  else begin
906    FOutputFileName := FOutputFileName + '.ps';
907    TFilePrinterCanvas(Canvas).OutputFileName := FOutputFileName;
908  end;
909
910  // test writing, on error this raises exception showing the user the filename
911  fs:=TFileStream.Create(FOutputFilename,fmCreate);
912  try
913    fs.Write(FOutputFilename[1],1);
914  finally
915    fs.free;
916  end;
917  DeleteFileUTF8(FOutputFilename);
918end;
919
920//If not aborted, send PostScript file to printer.
921//After, delete this file.
922procedure TCUPSPrinter.DoEndDoc(aAborted: Boolean);
923var
924  CupsResult: LongInt;
925begin
926  inherited DoEndDoc(aAborted);
927  dec(FBeginDocCount);
928  Exclude(FStates,cpsPaperRectValid);
929
930  if RawMode then begin
931
932    if not aAborted and (FRawModeStream<>nil)
933      and (FRawModeStream.Size>0) then
934    begin
935      try
936        FRawModeStream.SaveToFile(FOutputFileName);
937      finally
938        FRawModeStream.Clear;
939      end;
940    end;
941
942  end else
943    TFilePrinterCanvas(Canvas).OutputFileName:='';
944
945  if not aAborted then begin
946    if not FileExistsUTF8(FOutputFileName) then
947      raise Exception.Create('Unable to write to "'+FOutputFileName+'"');
948    {$IFDEF LogPrintoutFile}
949    CopyFile(FOutputFileName, 'printjob'+ExtractFileExt(FOutputFileName));
950    {$ENDIF}
951    try
952      {$IFNDEF DoNotPrint}
953      if Filename<>'' then
954        CopyFile(FOutputFileName, FileName)
955      else begin
956        CupsResult:=PrintFile(FOutputFileName);
957        if CupsResult<=0 then
958          raise Exception.Create('CUPS printing: '+GetLastError);
959      end;
960      {$ENDIF}
961    finally
962      DeleteFileUTF8(FOutputFilename);
963    end;
964  end;
965end;
966
967procedure TCUPSPrinter.DoNewPage;
968begin
969  // just to flag that we want the old 'newpage' pagination way
970  // instead of the new 'beginpage/endpage'
971end;
972
973procedure TCUPSPrinter.DoResetPrintersList;
974begin
975  if Assigned(fcupsPPD) then
976  begin
977    ppdClose(fcupsPPD);
978    fcupsPPD:=nil;
979  end;
980
981  if fcupsPPDName<>'' then
982  begin
983    DeleteFileUTF8(fcupsPPDName);
984    fcupsPPDName:='';
985  end;
986
987  FreeOptions;
988  if Assigned(fcupsPrinters) and CUPSLibInstalled then begin
989    cupsFreeDests(Printers.Count,fcupsPrinters);
990    fCupsPrinter := nil;
991  end;
992
993  inherited DoResetPrintersList;
994end;
995
996procedure TCUPSPrinter.DoEnumPrinters(Lst: TStrings);
997Var i,Num   : Integer;
998    P       : Pcups_dest_t;
999begin
1000  inherited DoEnumPrinters(Lst);
1001  {$IFDEF NOPRINTERS}
1002  Lst.Clear;
1003  Exit;
1004  {$ENDIF}
1005  if not CUPSLibInstalled then Exit;
1006
1007  Num:=cupsGetDests(@fcupsPrinters);
1008  For i:=0 to Num-1 do
1009  begin
1010    P:=nil;
1011    P:=@fcupsPrinters[i];
1012    if Assigned(P) then
1013    begin
1014      if P^.is_default<>0 then
1015        Lst.Insert(0,P^.name)
1016      else
1017        Lst.Add(P^.name);
1018    end;
1019  end;
1020end;
1021
1022procedure TCUPSPrinter.DoEnumPapers(Lst: TStrings);
1023var
1024  choice: Pppd_choice_t;
1025  Option: Pppd_option_t;
1026  c: Integer;
1027begin
1028  //DebugLn(['TCUPSPrinter.DoEnumPapers ',dbgsName(Self)]);
1029
1030  //TODO: note that we are returning here the list of paper "keys"
1031  //      not the human readable paper names. Modify cups support
1032  //      to return human readable paper names.
1033
1034  Lst.Clear;
1035  FCupsDefaultPaper := '';
1036  if CupsPPD<>nil then
1037  begin
1038    Option := ppdFindOption(CupsPPD, PChar('PageSize'));
1039    Choice := Option^.choices;
1040    fCupsDefaultPaper := Option^.defchoice;
1041    c := 0;
1042    while (Choice<>nil) and (c<Option^.num_choices) do
1043    begin
1044      lst.AddObject(Choice^.Choice, TObject(Choice));
1045      inc(choice);
1046      inc(c);
1047    end;
1048  end;
1049
1050  fCupsPapersCount := lst.Count;
1051end;
1052
1053function TCUPSPrinter.DoSetPrinter(aName: string): Integer;
1054Var i  : Integer;
1055    P  : Pcups_dest_t;
1056    Fn : String;
1057begin
1058  //debugln('TCUPSPrinter.DoSetPrinter aName="',aName,'"');
1059  Result:=inherited DoSetPrinter(aName);
1060  if not CUPSLibInstalled then Exit;
1061  //debugln('TCUPSPrinter.DoSetPrinter B Printers.Count=',dbgs(Printers.Count));
1062
1063  //Set the current printer. If aName='' then use a default Printer (index 0)
1064  If (Printers.Count>0) then
1065  begin
1066    if (aName<>'') and Assigned(fcupsPPD) then
1067    begin
1068      //Printer changed ?
1069      i:=Printers.IndexOf(aName);
1070      if i=PrinterIndex then
1071      begin
1072        Result:=PrinterIndex;
1073        //debugln('TCUPSPrinter.DoSetPrinter no change');
1074        Exit;
1075      end;
1076    end;
1077
1078    //Clear all existing options
1079    FreeOptions;
1080
1081    if Assigned(fcupsPPD) then
1082    begin
1083      ppdClose(fcupsPPD);
1084      fcupsPPD:=nil;
1085
1086      if fcupsPPDName<>'' then
1087      begin
1088        DeleteFileUTF8(fcupsPPDName);
1089        fcupsPPDName:='';
1090      end;
1091    end;
1092
1093
1094    if aName='' then
1095      i:=0
1096    else
1097      i:=Printers.IndexOf(aName);
1098
1099    if i>-1 then
1100    begin
1101      Result:=i;
1102
1103      P:=nil;
1104      P:=cupsGetDest(PChar(aName),nil,Printers.Count,fcupsPrinters);
1105      if not Assigned(P) then
1106        raise Exception.Create(Format('"%s" is not a valid printer.',[aName]));
1107      fcupsPrinter:=P;
1108
1109      //Open linked ppdfile
1110      Fn:=cupsGetPPD(PChar(aName));
1111      fcupsPPD:=ppdOpenFile(PChar(Fn));
1112      fcupsPPDName:=Fn;
1113      {$IFDEF DebugCUPS}
1114      DebugPPD;
1115      DebugCapabilities;
1116      {$ENDIF}
1117    end;
1118  end
1119  else
1120  begin
1121    PrinterIndex:=-1;
1122    fcupsPPD:=nil;
1123  end;
1124end;
1125
1126function TCUPSPrinter.DoGetCopies: Integer;
1127begin
1128  if not (cpsCopiesValid in FStates) then begin
1129    fCachedCopies:=inherited DoGetCopies;
1130
1131    //Get default value if defined
1132    fCachedCopies:=GetAttributeInteger('copies-default',fCachedCopies);
1133    //Get Copies in options or return default value
1134    fCachedCopies:=StrToIntdef(cupsGetOption('copies'),fCachedCopies);
1135    {$IFDEF UseCache}
1136    Include(FStates,cpsCopiesValid);
1137    {$ENDIF}
1138  end;
1139  Result:=fCachedCopies;
1140end;
1141
1142procedure TCUPSPrinter.DoSetCopies(aValue: Integer);
1143var i : Integer;
1144begin
1145  {$IFDEF UseCache}
1146  if aValue=DoGetCopies then exit;
1147  Exclude(FStates,cpsCopiesValid);
1148  {$ENDIF}
1149  inherited DoSetCopies(aValue);
1150
1151  if Printers.Count>0 then
1152  begin
1153    if not Assigned(fcupsOptions) then
1154      SetOptionsOfPrinter;
1155    i:=aValue;
1156    if i<1 then i:=1;
1157    cupsAddOption('copies',IntToStr(i));
1158  end;
1159end;
1160
1161function TCUPSPrinter.DoGetOrientation: TPrinterOrientation;
1162var i  : Integer;
1163begin
1164  if not (cpsOrientationValid in FStates) then begin
1165    if Printers.Count>0 then
1166    begin
1167      //Default orientation value
1168      i:=GetAttributeInteger('orientation-requested-default',3);
1169      // check if rotation is automatic or out-of-range
1170      if not (i in [3,4,5,6]) then
1171        i:=3; // yep, then for us this means portait
1172      fCachedOrientation:=TPrinterOrientation(i-3);
1173    end;
1174    Include(FStates,cpsOrientationValid);
1175  end;
1176  Result:=fCachedOrientation;
1177  {$IFDEF DebugCUPS}
1178  DebugLn('DoGetOrientation: result=%d',[ord(Result)]);
1179  {$ENDIF}
1180end;
1181
1182procedure TCUPSPrinter.DoSetOrientation(aValue: TPrinterOrientation);
1183begin
1184  if aValue=DoGetOrientation then
1185    exit;
1186  Exclude(FStates,cpsPaperRectValid);
1187  inherited DoSetOrientation(aValue);
1188  fcachedOrientation := AValue;
1189  Include(FStates,cpsOrientationValid);
1190end;
1191
1192function TCUPSPrinter.DoGetDefaultPaperName: string;
1193begin
1194  if not (cpsDefaultPaperNameValid in FStates) then begin
1195    fCachedGetDefaultPaperName:='';
1196    if not CupsPapersListValid then
1197      FCachedGetDefaultPaperName:=PaperSize.DefaultPaperName
1198    else begin
1199      if FCupsDefaultPaper<>'' then
1200        fCachedGetDefaultPaperName:= FCupsDefaultPaper
1201      else
1202        fCachedGetDefaultPaperName:=
1203                 GetAttributeString('media-default',fCachedGetDefaultPaperName);
1204      {$IFDEF UseCache}
1205      Include(FStates,cpsDefaultPaperNameValid);
1206      {$ENDIF}
1207    end;
1208  end;
1209  Result:=fCachedGetDefaultPaperName;
1210end;
1211
1212function TCUPSPrinter.DoGetPaperName: string;
1213begin
1214  if cpsCustomPaperValid in FStates then begin
1215    result := CUPS_CUSTOM_PAPER;
1216    exit;
1217  end;
1218  if not (cpsPaperNameValid in FStates) then begin
1219    // paper is not yet retrieved for first time
1220    // first try to see if there is a list of papers available
1221    if not CupsPapersListValid then
1222      FCachedPaperName := PaperSize.PaperName
1223    else begin
1224      fCachedPaperName := cupsGetOption('PageSize');
1225      {$IFDEF UseCache}
1226      Include(FStates,cpsPaperNameValid);
1227      {$ENDIF}
1228    end;
1229  end;
1230  Result:=fCachedPaperName;
1231end;
1232
1233procedure TCUPSPrinter.DoSetPaperName(aName: string);
1234begin
1235  if (aName=CUPS_CUSTOM_PAPER) and (cpsCustomPaperValid in FStates) then begin
1236    DoCustomPaper;
1237    exit;
1238  end;
1239
1240  {$IFDEF UseCache}
1241  if aName=DoGetPaperName then exit;
1242  Exclude(FStates,cpsPaperNameValid);
1243  {$ENDIF}
1244  inherited DoSetPaperName(aName);
1245
1246  if FCupsPapersCount<=0 then
1247    PaperSize.PaperName:=AName
1248  else begin
1249    Exclude(Fstates, cpsCustomPaperValid);
1250    cupsAddOption('PageSize',aName)
1251  end;
1252end;
1253
1254//Initialise aPaperRc with the aName paper rect
1255//Result : -1 no result
1256//          0 aPaperRc.WorkRect is a margins
1257//          1 aPaperRc.WorkRect is really the work rect
1258function TCUPSPrinter.DoGetPaperRect(aName: string;
1259  var aPaperRc: TPaperRect): Integer;
1260
1261var
1262  P : Pppd_size_t;
1263  Ky,Kx: Double;
1264begin
1265  if (aName=CUPS_CUSTOM_PAPER) and (cpsCustomPaperValid in FStates) then begin
1266    aPaperRc.PhysicalRect.Left := 0;
1267    aPaperRc.PhysicalRect.Top := 0;
1268    aPaperRc.PhysicalRect.Right := round(fCustomPaperWidth*Printer.XDPI/72);
1269    aPaperRc.PhysicalRect.Bottom := round(fCustomPaperHeight*Printer.YDPI/72);
1270    aPaperRc.WorkRect := aPaperRc.PhysicalRect;
1271    result := 0;
1272    exit;
1273  end;
1274
1275  if (not (cpsPaperRectValid in FStates)) or
1276    (fCachePaperRectName<>aName) then
1277  begin
1278    fCachePaperRectName:=aName;
1279    FillChar(fCachePaperRect,SizeOf(fCachePaperRect),0);
1280    fCachePaperRectResult:=inherited DoGetPaperRect(aName, aPaperRc);
1281    {$IFDEF UseCache}
1282    Include(FStates,cpsPaperRectValid);
1283    {$ENDIF}
1284
1285    P:=nil;
1286    if CUPSLibInstalled and Assigned(fcupsPPD) then
1287    begin
1288      P:=ppdPageSize(fcupsPPD,PChar(aName));
1289      if Assigned(P) then
1290      begin
1291        fCachePaperRectResult:=1; //CUPS return margins
1292
1293        // Margins.
1294        //
1295        // Cups gives dimensions based on postcript language
1296        // user space coordinates system which is something like
1297        //
1298        //  +y                                 +--> +x
1299        //   ^           but our system is     |
1300        //   |                                 v
1301        //   +--> +x                           +y
1302        //
1303        //  so values in x are the same, but we need to invert values in y,
1304        //  the given bottom value is the margin size at the bottom, we need
1305        //  to re-calc. our bottom offset, and the given top value is offset
1306        //  top value of imageable area, we need to re-calc. our top offset,
1307        //  which is the margin size at the top of the page.
1308        //
1309        //  The current implementation assumes that paper is fed short-edge-first
1310        //  either in portrait orientation, or in landscape orientation.
1311        //
1312        //  In landscape orientation, printable margins should preserved.
1313        //  It's based on a 90 degree counterclock wise paper rotation
1314        //
1315        //     FEED DIRECTION             FEED DIRECTION
1316        //
1317        //           /\                         /\
1318        //          /  \                       /  \
1319        //           ||                         ||
1320        //           ||                         ||
1321        //
1322        //     PORTRAIT                   LANDSCAPE
1323        //     +-----------------+        +-----------------+
1324        //     |        t        |        |        t        |
1325        //     |   +---------+   |        |   +---------+   |
1326        //     |   |   ( )   |   |        |   |   |   / |   |
1327        //     | l |  --+--  | r |        | l |()-+---  | r |
1328        //     |   |   / \   |   |        |   |   |   \ |   |
1329        //     |   +---------+   |        |   +---------+   |
1330        //     |        b        |        |        b        |
1331        //     +-----------------+        +-----------------+
1332        //
1333        //     REVERSE PORTRAIT           REVERSE LANDSCAPE
1334        //     +-----------------+        +-----------------+
1335        //     |        t        |        |        t        |
1336        //     |   +---------+   |        |   +---------+   |
1337        //     |   |   \ /   |   |        |   | \   |   |   |
1338        //     | l |  --+--  | r |        | l |  ---+-()| r |
1339        //     |   |   ( )   |   |        |   | /   |   |   |
1340        //     |   +---------+   |        |   +---------+   |
1341        //     |        b        |        |        b        |
1342        //     +-----------------+        +-----------------+
1343        //
1344        Kx := Printer.XDPI/72;
1345        Ky := Printer.YDPI/72;
1346        if Orientation in [poPortrait, poReversePortrait] then begin
1347          fCachePaperRect.PhysicalRect.Right:=Round(P^.Width*Kx);
1348          fCachePaperRect.PhysicalRect.Bottom:=Round(P^.Length*Ky);
1349          fCachePaperRect.WorkRect.Left:=Round(P^.Left*Kx);
1350          fCachePaperRect.WorkRect.Right:=Round(P^.Right*Kx);
1351          fCachePaperRect.WorkRect.Top:=Round((P^.Length-P^.Top)*Ky);
1352          fCachePaperRect.WorkRect.Bottom:=Round((P^.Length-P^.Bottom)*Ky);
1353        end else begin
1354          FCachePaperRect.PhysicalRect.Right:=Round(P^.Length*Kx);
1355          FCachePaperRect.PhysicalRect.Bottom:=Round(P^.Width*Ky);
1356          FCachePaperRect.WorkRect.Left:=Round((P^.Length-P^.Top)*Kx);
1357          FCachePaperRect.WorkRect.Right:=Round((P^.Length-P^.Bottom)*Kx);
1358          FCachePaperRect.WorkRect.Top:=Round((P^.Width-P^.Right)*Ky);
1359          FCachePaperRect.WorkRect.Bottom:=Round((p^.width - P^.left)*Ky);
1360        end;
1361
1362        {$IFDEF DebugCUPS}
1363        with P^ do
1364        DebugLn('ORG: Width=%f Length=%f Left=%f Right=%f Top=%f Bottom=%f Name=%s',
1365          [Width,Length,Left,Right,Top,Bottom,string(Name)]);
1366        with FCachePaperRect do
1367        DebugLn('NEW: Width=%d Length=%d Left=%d Top=%d Right=%d Bottom=%d ml=%d mt=%d mr=%d mb=%d',
1368          [PhysicalRect.Right,PhysicalRect.Bottom,WorkRect.Left,WorkRect.Top,WorkRect.Right,WorkRect.Bottom,
1369           WorkRect.Left,WorkRect.Top,PhysicalRect.Right-WorkRect.Right,
1370           PhysicalRect.Bottom-WorkRect.Bottom]);
1371        {$ENDIF}
1372      end;
1373    end;
1374
1375    if P=nil then begin
1376      FCachePaperRect := PaperSize.PaperRectOf[AName];
1377      fCachePaperRectResult:=1
1378    end;
1379
1380  end;
1381  Result:=fCachePaperRectResult;
1382  aPaperRc:=fCachePaperRect;
1383end;
1384
1385function TCUPSPrinter.DoSetPaperRect(aPaperRc: TPaperRect): boolean;
1386begin
1387  result := CUPSLibInstalled;
1388  if result then
1389  begin
1390    Include(fStates, cpsCustomPaperValid);
1391    fCustomPaperWidth  := aPaperRC.PhysicalRect.Width * 72 / Printer.XDPI;
1392    fCustomPaperHeight := aPaperRC.PhysicalRect.Height * 72 / Printer.YDPI;
1393    DoCustomPaper;
1394    {$IFDEF DebugCUPS}
1395    DebugLn('CUPS: custom paper width=%dpx %4.1fpt %3.0fmm height=%dpx %4.1fpt %3.0fmm',
1396      [aPaperRC.PhysicalRect.Width,
1397       fCustomPaperWidth, fCustomPaperWidth*25.4/72,
1398       aPaperRC.PhysicalRect.Height,
1399       fCustomPaperHeight, fCustomPaperHeight*25.4/72
1400       ]);
1401    {$ENDIF}
1402  end;
1403end;
1404
1405function TCUPSPrinter.DoGetPrinterState: TPrinterState;
1406var //Request   : Pipp_t; //IPP Request
1407    //Reponse   : Pipp_t; //IPP Reponse
1408    //Attribute : Pipp_attribute_t; //Current attribute
1409    //Language  : Pcups_lang_t;     //Default Language
1410    aState    : ipp_pstate_t;     //Printer state
1411    //URI       : Array[0..HTTP_MAX_URI] of Char; //Printer URI
1412begin
1413  Result:=inherited DoGetPrinterState;
1414
1415  aState:=ipp_pstate_t(GetAttributeInteger('printer-state',0));
1416  Case aState of
1417    IPP_PRINTER_IDLE       : Result:=psReady;
1418    IPP_PRINTER_PROCESSING : Result:=psPrinting;
1419    IPP_PRINTER_STOPPED    : Result:=psStopped;
1420  end;
1421end;
1422
1423function TCUPSPrinter.DoGetDefaultCanvasClass: TPrinterCanvasRef;
1424begin
1425  {$IFDEF UseCairo}
1426  Result := TCairoPsCanvas;
1427  {$ELSE}
1428  Result := TPostscriptPrinterCanvas;
1429  {$ENDIF}
1430end;
1431
1432function TCUPSPrinter.GetPrinterType: TPrinterType;
1433Var i : Integer;
1434begin
1435  Result:=inherited GetPrinterType;
1436  i:=GetAttributeInteger('printer-type',CUPS_PRINTER_LOCAL);
1437  If (i and CUPS_PRINTER_REMOTE)=CUPS_PRINTER_REMOTE then
1438    Result:=ptNetWork;
1439end;
1440
1441function TCUPSPrinter.GetCanPrint: Boolean;
1442begin
1443  Result:=inherited GetCanPrint;
1444  Result:=GetAttributeBoolean('printer-is-accepting-jobs',Result)
1445end;
1446
1447initialization
1448  if Assigned(Printer) then
1449    Printer.Free;
1450
1451  Printer:=TCUPSPrinter.Create;
1452
1453FINALIZATION
1454  // Free the printer before unloading library
1455  Printer.Free;
1456  Printer:=nil;
1457  //Unload CUPSLib if loaded
1458  FinalizeCups;
1459
1460END.
1461
1462