1# -*- perl -*-
2###############################################################################
3# $Id: Mac.pm,v 1.9 1999/10/25 21:18:22 MRO Exp $
4#
5# Mac.pm
6#
7# Contains MacOS specific wrappers for system commands.
8#
9# NOTE: These subs do proper error catching. They return 1 on success
10#       and 0 on failure. In the latter case an error message is
11#       printed.
12#
13# Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de>
14# using stuff from the former Override.pm and from the File::Spec modules.
15#
16# This software is part of LaTex2HTML, originally by Nikos Drakos
17# It is published under the GNU Public License and comes without any
18# warranty.
19#
20# You aren't supposed to edit this script.
21#
22###############################################################################
23# Changes History
24#
25# $Log: Mac.pm,v $
26# Revision 1.9  1999/10/25 21:18:22  MRO
27#
28# -- added more configure options (Jens' suggestions)
29# -- fixed bug in regexp range reported by Achim Haertel
30# -- fixed old references in documentation (related to mail list/archive)
31#
32# Revision 1.8  1999/08/30 22:45:09  MRO
33#
34# -- perl now reports line numbers respective to .pin file - eases
35#    code development!
36# -- l2hcfg.pm is installed, too for furtjer reference
37# -- some minor bugs (hopefully) fixed.
38#
39# Revision 1.7  1999/06/06 14:24:53  MRO
40#
41#
42# -- many cleanups wrt. to TeXlive
43# -- changed $* to /m as far as possible. $* is deprecated in perl5, all
44#    occurrences should be removed.
45#
46# Revision 1.6  1999/06/04 15:30:16  MRO
47#
48#
49# -- fixed errors introduced by cleaning up TMP*
50# -- made pstoimg -quiet really quiet
51# -- pstoimg -debug now saves intermediate result files
52# -- several fixes for OS/2
53#
54# Revision 1.5  1999/06/03 12:15:44  MRO
55#
56#
57# - cleaned up the TMP / TMPDIR / TMP_ mechansim. Should work much the
58#   same now, but the code should be easier to understand.
59#
60# - cleaned up L2hos, added an INSTALLation FAQ, beautified the test
61#   document a little bit
62#
63# Revision 1.4  1999/06/01 06:55:37  MRO
64#
65#
66# - fixed small bug in L2hos/*
67# - added some test_mode related output to latex2html
68# - improved documentation
69# - fixed small bug in pstoimg wrt. OS2
70#
71# Revision 1.3  1999/05/31 07:49:07  MRO
72#
73#
74# - a lot of cleanups wrt. OS/2
75# - make test now available (TEST.BAT on Win32, TEST.CMD on OS/2)
76# - re-inserted L2HCONFIG environment
77# - added some new subs to L2hos (path2os, path2URL, Cwd)
78#
79# Revision 1.2  1999/05/19 23:54:02  MRO
80#
81#
82# -- uniquified icons - some of them look a little bit strange, might
83#    need to be fixed.
84# -- got rid of unlink errors, cleaned up some cosmetics
85#
86# Revision 1.1  1999/05/11 06:10:02  MRO
87#
88#
89# - merged config stuff, did first tries on Linux. Simple document
90#   passes! More test required, have to ger rid of Warnings in texexpand
91#
92# Revision 1.2  1999/05/05 19:47:06  MRO
93#
94#
95# - many cosmetic changes
96# - final backup before merge
97#
98# Revision 1.1  1999/03/15 23:00:54  MRO
99#
100#
101# - moved L2hos modules to top level directory, so that no dir-
102#   delimiter is necessary in the @INC-statement.
103# - changed strategy for "shave": Do not rely on STDERR redirection any
104#   more (caused problems on at least Win32)
105#
106# Revision 1.1  1999/02/10 01:37:16  MRO
107#
108#
109# -- changed os-dependency structure again - now neat OO modules are
110#    used: portable, extensible, neat!
111# -- some minor cleanups and bugfixes
112#
113#
114###############################################################################
115
116# Warning! This package is under construction!
117# No guarantee for anything, sorry...
118
119package L2hos::Mac;
120
121use Exporter ();
122
123use Carp;
124use Cwd;
125use File::Copy;
126use strict;
127use L2hos qw($Verbose);
128
129my $dd = ':';
130
131# Platform identifier (configure internal)
132sub plat {
133  my ($self) = @_;
134  'macOS';
135}
136
137# Directory delimiter
138sub dd {
139  my ($self) = @_;
140  $dd;
141}
142
143# Path delimiter in PATH environment
144sub pathd {
145  my ($self) = @_;
146  '|';
147}
148
149# current working directory in platform-specific format
150sub Cwd {
151  my ($self) = @_;
152  path2os($self,cwd());
153}
154
155# The home directory
156sub home {
157  my ($self,$user) = @_;
158  croak "Error (home): Cannot expand other user's home directory\n"
159    if($user);
160  $ENV{'HOME'} || Cwd() || '.';
161}
162
163# The shell the current user is running
164sub shell {
165  my ($self) = @_;
166  ''; # sorry
167}
168
169# The user's login name
170sub user {
171  my ($self) = @_;
172  $ENV{'USER'} || '';
173}
174
175# The user's full name
176sub fullname {
177  my ($self) = @_;
178  $ENV{'USER'} || '';
179}
180
181# The hostname we're running on
182sub host {
183  my ($self) = @_;
184
185  use Sys::Hostname;
186  my $host = hostname() || '';
187  $host;
188}
189
190# The null device to redirect garbage to
191sub nulldev {
192  my ($self) = @_;
193  '';
194}
195
196# A copy method
197sub Copy {
198  my ($self,$from,$to) = @_;
199  unless(copy($from,$to)) {
200    carp qq{Error (Copy): Copy "$from" to "$to" failed: $!\n};
201    return 0;
202  }
203  1;
204}
205
206# A delete/remove/unlink method
207# ignore non-existing files
208sub Unlink {
209  my ($self,@files) = @_;
210  my @items;
211  if(@items = grep(-e, @files)) {
212    unless(unlink(@items)) {
213      carp 'Error (Unlink): Unlink "' . join(' ',@items) . "\" failed: $!\n";
214      return 0;
215    }
216  }
217  1;
218}
219
220# A rename/move method
221sub Rename {
222  my ($self,$from,$to) = @_;
223  if(system('cp',$from,$to) || system('rm',$from)) {
224    carp qq{Error (Rename): Rename (MacOS cp, rm) "$from" to "$to" failed: $!\n};
225    return 0;
226  }
227  1;
228}
229
230# A (hard) link method
231sub Link {
232  my ($self,$from,$to) = @_;
233  # no link available, simply Copy
234  Copy($self,$from,$to);
235  }
236
237# A symbolic link method
238sub Symlink {
239  my ($self,$from,$to) = @_;
240  # No symlinks, so copy
241  &Copy($from,$to);
242  }
243
244# Given a directory name in either relative or absolute form, returns
245# the absolute form.
246# Note: The argument *must* be a directory name.
247sub Make_directory_absolute {
248  my ($self,$path) = @_;
249  if($path =~ /^:/) { # relative!
250    my $orig_cwd;
251    unless($orig_cwd = cwd()) {
252      carp qq{Error (Make_directory_absolute): Could not determine current directory: $!\n};
253      return '';
254    }
255    unless(chdir $path) {
256      carp qq{Error (Make_directory_absolute): chdir "$path" failed: $!\n};
257      return '';
258    }
259    $path = cwd();
260    chdir $orig_cwd;
261  }
262  path2os($self,$path);
263}
264
265# Call external tools
266sub syswait {
267  my ($self,$cmd,$in,$out,$err) = @_;
268  carp qq{Debug (syswait): Running "$cmd"\n} if($Verbose);
269  # it seems that no command is using specific redirections ...
270  my $redirerr = 0;
271  if($in) {
272    open(SI, "<&STDIN");
273    if(open(STDIN, "<$in")) {
274      binmode(STDIN);
275    } else {
276      $in = '';
277      $redirerr++;
278    }
279  }
280  if($out) {
281    open(SO, ">&STDOUT");
282    if(open(STDOUT, ">$out")) {
283      binmode(STDOUT);
284    } else {
285      $out = '';
286      $redirerr++;
287    }
288  }
289  if($err) {
290    open(SE, ">&STDERR");
291    if(open(STDERR, ">$err")) {
292      binmode(STDERR);
293    } else {
294      $err = '';
295      $redirerr++;
296    }
297  }
298  my $errcode = system($cmd);
299  if($in) {
300    close(STDIN);
301    open(STDIN, "<&SI");
302  }
303  if($out) {
304    close(STDOUT);
305    open(STDOUT, ">&SO");
306  }
307  if($err) {
308    close(STDERR);
309    open(STDERR, ">&SE");
310  }
311  if($redirerr) {
312    carp "Warning (syswait): One or more redirections failed.\n";
313  }
314  $errcode;
315}
316
317# check if path is absolute
318sub is_absolute_path {
319  my ($self,$path) = @_;
320  $path !~ /^\Q$dd\E/i; # Mac is different...
321}
322
323# Convert a path to OS-specific
324sub path2os {
325  my ($self,$path) = @_;
326  # relative paths are just the other way round on Mac
327  if($path =~ m:^(/*)(.*):) {
328    $path = ($1 ? '' : ':' ) . $2;
329  }
330  $path =~ s:/+:$dd:g;
331  $path;
332}
333
334# convert a path to an URL
335sub path2URL {
336  my ($self,$path) = @_;
337  $path =~ s:[$dd$dd]+:/:g;
338  "file:" . $path;
339}
340
341# convert a path so that LaTeX can use it
342sub path2latex {
343  my ($self,$path) = @_;
344  $path =~ s:[$dd$dd]+:/:go;
345  $path;
346}
347
348# run perldoc the right way
349sub perldoc {
350  my ($self,$script) = @_;
351  use vars qw(%Config);
352  eval 'use Config qw(%Config)'; # load perl's configuration
353  my $perldoc = $Config{scriptdir}.$dd."perldoc";
354  $script ||= $0;
355  # no nroff here
356  system("$perldoc -t $script");
357}
358
359# quote a command line argument
360sub quote {
361  my ($self,$str) = @_;
362  $str;
363}
364
3651; # must be last line
366
367__END__
368