lip.pl

This is lip.pl in view mode; [Download] [Up]
#!/usr/local/bin/perl
# spilice some architecture from Mach multi-architechture-binary
# hyoudo@kcn.or.jp
# 1997.07.17 - 18,24 viewer implement
#      08.03         remover implement

$fpath = "~/Apps";
$fwrite = 0;	# disable $fpath for rewrite
while( $#ARGV > -1) {
	$_ = shift @ARGV;
	if( /^\-sort/ ){
		$fsort = 1 ;
	} elsif( /^\-nim/ ){
		$fnim = 1 ;
	} elsif( /^\-path$/ ){
		if( $#ARGV < 0 ){
			print "No parameter of -path, use $fpath\n";
		} else { 
			$temp = shift @ARGV;
			$_ = `if [ -r $temp ]\
			then echo "exists"\
			else echo "no"\
			fi\
			`;
			chop;
			if( /^no$/ ){
				print "Cnat't read path: $temp, use $fpath\n";
			} else {
				$fpath = $temp;
				$fwrite = 1;	# enable $fpath for rewrite
			}
		}
	} elsif( /^\-nihs$/ ){
		if( $#ARGV < 0 ){
			print "No parameter of -nihs\n";
		} else { 
			$_ = $fnihs . (shift @ARGV);
			tr/A-Z/a-z/;
			s/[^nihs]//g;
			$fnihs = $_;
		}
	} else {
		print "Unknown argument : $_\n";
		$fwrite = 0;	# disable $fpath for rewrite
	}
}

$fnihs = "nihs" unless $fnihs;

# debug print
# print "sort $fsort; num $fnim; path $fpath; nihs $fnihs\n";
print "Not rewrite $fpath\n" unless $fwrite;

@exfile = `find $fpath -perm -100 ! -type d -print`;
open( stderr, ">/dev/null" );
for ( @exfile ) {
#	print "1 $_";
	chop;
	$_ = `lipo -info $_`;
	next if /^$/;
#	print "2 $_";
	chop;

	@a = split( /: / );

	$_ = $a[$#a];
	$arch = "";
	$f = $fsort;
	while( $f ){
		$arch .= "m68k ", next if s/m68k\s*//;
		$arch .= "i${1}86 ", next if s/i(\d)86\s*//;
		$arch .= "hppa ", next if s/hppa\s*//;
		$arch .= "sparc ", next if s/sparc\s*//;
		$arch .= $_ if /.+/;
		$f = 0;
		s/ $/$/;
		$_ = $arch;
	}
	@arch = split( / / );
	if( $fnim ){
		s/m68k/N/;
		s/i\d86/I/;
		s/hppa/H/;
		s/sparc/S/;
		s/ //g;
	}
	$arch = $_;

	pop @a;
	shift @a;
	$_ = pop @a;
	s/ are$//;
	s/ is architecture$//;
	$fn = $_;
	$_ = join( ": ", $arch, @a, $fn );
	print "$_\n";
	
	$remove = $rarch = "";
	while( $#arch > -1 ){
		$_ = shift @arch;
		s/^m/n/;
		unless( /^[$fnihs]/ ){
			s/^n/m/;
			$rarch .= "$_ ";
			$remove .= " -remove $_" ;
			}
	}
	$remove = "lipo $fn $remove" if $remove;
	
	next unless $rarch;
	if( $fwrite ){
		# ディレクトリ確認
		$dirs = $fn;
		$dirs =~ s/\/[^\/]+$//;
		print "DIR: $dirs\n";
		$_ = `if [ -w $dirs -a -w $fn]
				then echo "good"
				else echo "no"
			fi`;
		if( /^no/ ){
			print "\t$arch Not removed, Can't write.\n";
		} else {
			
			# テンポラリファイル確認
			$temp = "__001";
			while( `if [ -f $dirs/$temp -o -d $dirs/$temp ]
					then echo "TRUE"
					fi` ){
				$temp++;
			}
			
			# 抽出
			$_ = `$remove -output $dirs/$temp`;
			print $_;
			
			# 抽出確認
			if( `if [ -f $dirs/$temp ]
					then echo "TRUE"
				fi`){
				$_ = `mv $dirs/$temp $fn`;
				print $_;
				print "\t$rarch removed.\n";
			} else {
				print "\tFailed remove $rarch.\n";
			}

		}
	} else {
		print "\t$rarch Not removed.\n"; 
	}
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.