1# -*-Perl-*-
2################################################################
3###
4###			      Util.pm
5###
6### Author:  Internet Message Group <img@mew.org>
7### Created: Apr 23, 1997
8### Revised: Apr 23, 2007
9###
10
11my $PM_VERSION = "IM::Util.pm version 20161010(IM153)";
12
13package IM::Util;
14require 5.003;
15require Exporter;
16
17use integer;
18use strict;
19use vars qw(@ISA @EXPORT
20	    $SUCCESS $ERROR $EXIT_SUCCESS $EXIT_ERROR
21	    $old); # why not my($old)?
22
23@ISA = qw(Exporter);
24@EXPORT = qw($SUCCESS $ERROR $EXIT_SUCCESS $EXIT_ERROR
25	     unixp win95p wntp os2p
26	     progname
27	     im_getlogin
28	     im_msg im_info im_debug im_notice im_warn im_err im_die im_die2
29	     im_save_error im_saved_errors im_open im_sysopen
30	     debug_option set_debug debug set_verbose verbose
31	     flush);
32
33use vars qw($OS $SavedMsg %Debug);
34
35###
36### Constant
37###
38
39$SUCCESS = 1;
40$ERROR = 0;
41
42$EXIT_SUCCESS = 0;
43$EXIT_ERROR = 1;
44
45###
46### get OS name
47###
48
49my $osname = $^O;
50
51if ($osname =~ /win/i && $osname !~ /darwin/i) {
52    eval {
53	if (Win32::IsWinNT()) {
54	    $OS = 'WNT';
55	} elsif (Win32::IsWin95()) {
56	    $OS = 'WIN95';
57	} else {
58	    $OS = 'WIN95';	# xxx
59	}
60    };
61    if ($@) {
62	$OS = 'UNIX';
63    }
64} elsif ($osname =~ /os2/i) {
65    $OS = 'OS/2';
66} else {
67    $OS = 'UNIX';
68}
69
70sub unixp {
71    if ($OS eq 'UNIX') {
72	return 1;
73    } else {
74	return 0;
75    }
76}
77
78sub win95p {
79    if (($OS eq 'WIN95') || ($OS eq 'WNT')) {
80	return 1;
81    } else {
82	return 0;
83    }
84}
85
86sub wntp {
87    if ($OS eq 'WNT') {
88	return 1;
89    } else {
90	return 0;
91    }
92}
93
94sub os2p {
95    if ($OS eq 'OS/2') {
96	return 1;
97    } else {
98	return 0;
99    }
100}
101
102sub progname() {
103    return $main::Prog;
104}
105
106###
107### get login name
108###
109sub im_getlogin() {
110    if (&unixp()) {
111	my $login = getlogin();
112	if ($login ne '' && $login ne 'root') {
113	    return $login;
114	} else {
115	    return (getpwuid($<))[0] || undef;
116	}
117    } elsif (&os2p()) {
118	return getlogin() || undef;
119    } elsif (&win95p()) {
120	return Win32::LoginName();
121    }
122}
123
124###
125### message
126###
127
128# im_msg    - display desired information
129# im_debug  - display debugging information (with --debug or something)
130# im_info   - display informational messages (hidden with --quiet)
131# im_notice - display process tracing information (shown with --verbose)
132# im_warn   - display problem report -- the problem may be ignored
133# im_err    - display critical error messages -- process will be aborted
134# im_die    - display critical error messages and exit
135
136sub im_msg($) {
137    my $msg = shift;
138    print progname(), ': ', $msg;
139}
140
141sub im_info($) {
142    my $info = shift;
143    return if $main::opt_quiet;
144    print progname(), ': ', $info;
145}
146
147sub im_debug($) {
148    my $dbg = shift;
149    print STDERR progname(), ':DEBUG: ', $dbg;
150}
151
152sub im_notice($) {
153    return unless &verbose;
154    my $warn = progname() . ': '. shift;
155    $SavedMsg .= $warn;
156    print STDERR $warn;
157}
158
159sub im_warn($) {
160    my $warn = progname() . ': '. shift;
161    $SavedMsg .= $warn;
162    print STDERR $warn;
163}
164
165sub im_err($) {
166    my $err = progname() . ': ERROR: ' . shift;
167    $SavedMsg .= $err;
168    print STDERR $err;
169}
170
171sub im_die($) {
172    my $die = shift;
173    print STDERR progname(), ': ERROR: ', $die;
174    exit $EXIT_ERROR;
175}
176
177sub im_die2($) {
178    my $die = shift;
179    print STDERR progname(), ': ', $die;
180    exit $EXIT_ERROR;
181}
182
183sub im_save_error(;$) {
184    my $string = shift;
185    if ($string eq '') {
186	$SavedMsg = '';	# reset
187    } else {
188	$SavedMsg .= $string;
189    }
190}
191
192sub im_saved_errors() {
193    return $SavedMsg;
194}
195
196###
197### Debug
198###
199
200sub print_hash(\%) {
201    my $hashref = shift;
202
203    foreach (keys(%{$hashref})) {
204	print "$_ -> $hashref->{$_}\n";
205    }
206}
207
208sub set_debug($$) {
209    my $category = shift;
210
211    $Debug{$category} = shift;
212}
213
214sub debug($) {
215    my $category = shift;
216
217    if ($Debug{'all'}) {
218	return $Debug{'all'};
219    } else {
220	return $Debug{$category};
221    }
222}
223
224sub set_verbose($) {
225    $main::opt_verbose = shift;
226}
227
228sub verbose() {
229    return $main::opt_verbose;
230}
231
232##### SET DEBUG OPTION #####
233#
234# debug_option()
235#
236sub debug_option($) {
237    my $DebugFlag = shift;
238
239    if ($DebugFlag && ($DebugFlag !~ /^(off|no|false|0)$/)) {
240	foreach (split(',', $DebugFlag)) {
241	    im_warn("setting debug level $_=1\n");
242	    &set_debug($_, 1);
243	}
244	&set_verbose(1);
245    }
246}
247
248#
249# flush buffer
250#
251
252sub flush(*) {
253    local($old) = select(shift);
254    $| = 1;
255    print '';
256    $| = 0;
257    select($old);
258}
259
260#
261# open file
262#
263
264sub im_open($$) {
265    my($d, $f) = @_;
266    my($r);
267    if ($> != 0) {
268	$f =~ /(.+)/;	# may be tainted
269	$f = $1;	# clean up
270    }
271    if ($r = open($d, $f)) {
272	binmode($d);
273    }
274    return $r;
275}
276
277sub im_sysopen($$$) {
278    my($d, $f, $a) = @_;
279    my($r);
280    if ($> != 0) {
281	$f =~ /(.+)/;	# may be tainted
282	$f = $1;	# clean up
283    }
284    if ($r = sysopen($d, $f, $a)) {
285	binmode($d);
286    }
287    return $r;
288}
289
2901;
291
292__END__
293
294=head1 NAME
295
296IM::Util - utility functions for IM
297
298=head1 SYNOPSIS
299
300 use IM::Util;
301
302Constant variables:
303$SUCCESS
304$ERROR
305$EXIT_SUCCESS
306$EXIT_ERROR
307
308Subroutines:
309unixp win95p wntp os2p
310progname
311im_getlogin
312im_msg im_info im_debug im_notice im_warn im_err im_die im_die2
313im_save_error im_saved_errors im_open im_sysopen
314debug_option set_debug debug set_verbose verbose
315flush
316
317=head1 DESCRIPTION
318
319The I<IM::Util> module provides utility functions for IM.
320
321This modules is provided by IM (Internet Message).
322
323=head1 COPYRIGHT
324
325IM (Internet Message) is copyrighted by IM developing team.
326You can redistribute it and/or modify it under the modified BSD
327license.  See the copyright file for more details.
328
329=cut
330
331### Copyright (C) 1997, 1998, 1999 IM developing team
332### All rights reserved.
333###
334### Redistribution and use in source and binary forms, with or without
335### modification, are permitted provided that the following conditions
336### are met:
337###
338### 1. Redistributions of source code must retain the above copyright
339###    notice, this list of conditions and the following disclaimer.
340### 2. Redistributions in binary form must reproduce the above copyright
341###    notice, this list of conditions and the following disclaimer in the
342###    documentation and/or other materials provided with the distribution.
343### 3. Neither the name of the team nor the names of its contributors
344###    may be used to endorse or promote products derived from this software
345###    without specific prior written permission.
346###
347### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
348### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
349### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
350### PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
351### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
352### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
353### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
354### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
355### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
356### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
357### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
358