From http://www.jwz.org/xscreensaver/xscreensaver-5.35.tar.gz
[xscreensaver] / OSX / seticon.pl
1 #!/usr/bin/perl -w
2 # Copyright © 2015 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
14 require 5;
15 use diagnostics;
16 use strict;
17 #use IPC::Open2;
18 use File::Temp;
19
20 my $progname = $0; $progname =~ s@.*/@@g;
21 my ($version) = ('$Revision: 1.4 $' =~ m/\s(\d[.\d]+)\s/s);
22
23 my $verbose = 0;
24
25 sub 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              'CoreServices.r',
56              $rez_filename,
57              '-o', $target_res);
58
59   print STDERR "$progname: exec: " . join(' ', @cmd) . "\n$pgm\n"
60     if ($verbose);
61
62 #  my ($in, $out);
63 #  my $pid = open2 ($out, $in, @cmd);
64 #  print $in $pgm;
65 #  close ($in);
66 #  waitpid ($pid, 0);
67
68   system (@cmd);
69
70   my $exit  = $? >> 8;
71   exit ($exit) if $exit;
72
73   # Have to also inform Finder that the icon is there, with the
74   # com.apple.FinderInfo xattr (a FolderInfo struct).
75   @cmd = ('SetFile', '-a', 'C', $target);
76   system (@cmd);
77   $exit  = $? >> 8;
78   exit ($exit) if $exit;
79 }
80
81 sub usage() {
82   print "Usage: $progname -d source [file...]\n";
83   exit 1;
84 }
85
86 sub main() {
87   my ($d, $src, $dst);
88   while ($#ARGV >= 0) {
89     $_ = shift @ARGV;
90     if (m/^--?verbose$/s)      { $verbose++; }
91     elsif (m/^-v+$/s)          { $verbose += length($_)-1; }
92     elsif (m/^-d$/s)           { $d = 1; }
93     elsif (!defined($src))     { $src = $_; }
94     elsif (!defined($dst))     { $dst = $_; }
95     else { usage; }
96   }
97   usage() unless ($d && $src);
98   set_icon ($src, $dst);
99 }
100
101 main();
102 exit 0;