1#!/usr/bin/perl -w
2# Copyright © 2015-2016 Dave Odell <dmo2118@gmail.com>
3#
4# Permission to use, copy, modify, distribute, and sell this software and its
5# documentation for any purpose is hereby granted without fee, provided that
6# the above copyright notice appear in all copies and that both that
7# copyright notice and this permission notice appear in supporting
8# documentation.  No representations are made about the suitability of this
9# software for any purpose.  It is provided "as is" without express or
10# implied warranty.
11
12# This is a replacement for seticon from http://osxutils.sourceforge.net/.
13
14require 5;
15use diagnostics;
16use strict;
17#use IPC::Open2;
18use File::Temp;
19
20my $progname = $0; $progname =~ s@.*/@@g;
21my ($version) = ('$Revision: 1.7 $' =~ m/\s(\d[.\d]+)\s/s);
22
23my $verbose = 0;
24
25sub set_icon ($$) {
26  my ($icon, $target) = @_;
27  my $target_res = $target;
28
29  if (-d $target) {
30    $target_res = $target_res . "/Icon\r";
31  }
32
33  # Rez hates absolute paths, apparently.
34  if ($icon =~ m@^/@s) {
35    my $cwd = `pwd`;
36    chomp $cwd;
37    $icon =~ s@^\Q$cwd/@@s;
38  }
39
40  # The Rez language is documented in "Building and Managing Programs in MPW,
41  # Second Edition". No longer available on Apple's servers, it can now be
42  # found at:
43  # http://www.powerpc.hu/manila/static/home/Apple/developer/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./Documentation/MPW_Reference/Building_Progs_In_MPW.sit.hqx
44
45  my $pgm = "Read 'icns' (kCustomIconResource) \"$icon\";\n";
46
47  # Rez can read from stdin, but only if it is a file handle, not if it
48  # is a pipe (OS X 10.9, Xcode 5; OSX 10.11, Xcode 6).
49
50  my ($rez_fh, $rez_filename) = File::Temp::tempfile(DIR => '.', UNLINK => 1);
51  print $rez_fh $pgm;
52  close $rez_fh;
53
54  my @cmd = ('Rez',
55
56             '-isysroot',
57             '/Applications/Xcode.app/Contents/Developer/Platforms' .
58             '/MacOSX.platform/Developer/SDKs/MacOSX.sdk',
59
60             'CoreServices.r',
61             $rez_filename,
62             '-o', $target_res);
63
64  print STDERR "$progname: exec: " . join(' ', @cmd) . "\n$pgm\n"
65    if ($verbose);
66
67#  my ($in, $out);
68#  my $pid = open2 ($out, $in, @cmd);
69#  print $in $pgm;
70#  close ($in);
71#  waitpid ($pid, 0);
72
73  system (@cmd);
74
75  my $exit  = $? >> 8;
76  exit ($exit) if $exit;
77
78  # Have to also inform Finder that the icon is there, with the
79  # com.apple.FinderInfo xattr (a FolderInfo struct).
80  @cmd = ('SetFile', '-a', 'C', $target);
81  system (@cmd);
82  $exit  = $? >> 8;
83  exit ($exit) if $exit;
84}
85
86sub error($) {
87  my ($err) = @_;
88  print STDERR "$progname: $err\n";
89  exit 1;
90}
91
92sub usage() {
93  print "Usage: $progname -d source [file...]\n";
94  exit 1;
95}
96
97sub main() {
98  my ($src, @dst);
99  while ($#ARGV >= 0) {
100    $_ = shift @ARGV;
101    if (m/^--?verbose$/s)      { $verbose++; }
102    elsif (m/^-v+$/s)          { $verbose += length($_)-1; }
103    elsif (m/^-d$/s)           { $src = shift @ARGV; }
104    elsif (m/^-/s)             { usage(); }
105    else { push @dst, $_; }
106  }
107  error ("no source") unless defined($src);
108  error ("no files") unless @dst;
109  foreach my $f (@dst) {
110    set_icon ($src, $f);
111  }
112}
113
114main();
115exit 0;
116