File: logfile.pas

package info (click to toggle)
imapcopy 1.04-2.1
  • links: PTS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 348 kB
  • ctags: 277
  • sloc: pascal: 2,939; xml: 103; sh: 19; makefile: 17
file content (125 lines) | stat: -rw-r--r-- 2,898 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
{**********************************************************************
    $Id: logfile.pas
    This file is part of imapcopy
    Copyright (c) 2001-2005 Armin Diehl

    Logging to screen or file for imapcopy

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

unit logfile;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

{$I-}

uses sysutils;

const
  log_message =  0;
  log_warning =  1;
  log_error   =  2;
  log_status  =  4;
  log_fatal   =  8;
  log_file    = 16;

  log_to_stdout  = log_message + log_status;
  log_to_stderr  = log_warning + log_error + log_fatal;
  log_to_logfile = log_warning + log_error + log_status + log_fatal + log_file;

  log_to_file    : boolean = false;
  log_filename   : string  = 'imapcopy.log';
  log_file_open  : boolean = false;

function log_openfile (const fn : string) : boolean;
function log_closefile : boolean;
procedure log (logclass : integer; msg : string);
procedure logfmt (logclass : integer; fmtstr : string; args : array of const);


implementation

var fLog : file;

function log_openfile (const fn : string) : boolean;
begin
  log_closefile;
  if fn <> '' then
    log_filename := fn;
  assign (fLog,log_filename);
  reset (fLog,1);
  if IOResult <> 0 then
    rewrite (fLog,1)
  else
    seek (fLog, filesize(fLog));
  log_file_open := (IOResult = 0);
  result := log_file_open;
end;

function log_closefile : boolean;
begin
  if log_file_open then
  begin
    close (fLog);
    log_file_open := (IOResult <> 0);
    result := not log_file_open;
  end else
    result := true;
end;


procedure log (logclass : integer; msg : string);
var to_stdout, to_stderr, to_file : boolean;
begin
  to_stdout := (logclass and log_to_stdout <> 0);
  to_stderr := (logclass and log_to_stderr <> 0);
  to_file   := (logclass and log_to_logfile <> 0);
  if to_stdout then
    writeln (msg);
  if to_stderr then
    (*$IFDEF Delphi*)
    writeln (msg);   // at least delphi3 has no stderr
    (*$ELSE*)
    writeln (stderr,msg);
    (*$ENDIF*)
  if to_file then
    if log_file_open then
    begin
      Case logclass of
        log_message : Msg := 'M '+Msg;
        log_warning : Msg := 'W '+Msg;
        log_error   : Msg := 'E '+Msg;
        log_status  : Msg := 'S '+Msg;
        log_fatal   : Msg := 'F '+Msg
      else
        Msg := '  '+Msg;
      end;
      (*$IFNDEF Unix*)
      Msg := Msg + #13#10;
      (*$ELSE*)
      Msg := Msg + #10;
      (*$ENDIF*)
      BlockWrite (fLog,msg[1],length(msg));
    end;
  IOResult;
end;


procedure logfmt (logclass : integer; fmtstr : string; args : array of const);
var msg : string;
begin
  msg := format (fmtstr, args);
  log (logclass, msg);
end;

begin
  log_closefile;
end.