git.hungrycats.org Git - xscreensaver/blob - 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;