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