Commits

Anonymous committed dc9490f

Added the initial versions of the perl Mac::Growl module and the irssi script that uses it.

Comments (0)

Files changed (10)

perl/Mac-Growl/Changes

+Revision history for Perl extension Mac::Growl.
+
+0.01  Wed Jun  2 16:53:51 2004
+	- original version; created by h2xs 1.23 with options
+		-A -n Mac::Growl
+0.20  Wed Jun  2 21:27  2004
+    - Implemented RegisterNotifications and PostNotification
+	  Both work now, but there is no image support.

perl/Mac-Growl/Growl.xs

+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "ppport.h"
+
+#include <CoreFoundation/CoreFoundation.h>
+#include "GrowlDefinesCarbon.h"
+
+#define MakeCFString(x) CFStringCreateWithCString(kCFAllocatorDefault, x, kCFStringEncodingASCII)
+#define ArrayRefOK(x) (SvROK(x) && (SvTYPE(SvRV(x)) == SVt_PVAV) && av_len((AV*)SvRV(x)) >= 0)
+
+/*Create a CFArray from a perl array of strings*/
+CFArrayRef CFArrayFromSV(AV * array)
+{
+	I32 len = av_len(array);
+	CFMutableArrayRef arr = CFArrayCreateMutable(kCFAllocatorDefault, len+1, NULL);
+	int i;
+	STRLEN l;
+
+	for(i = 0;i <= len; i++)
+	{
+		CFArrayAppendValue(arr,MakeCFString(SvPV(*av_fetch(array,i,0),l)));
+	}
+	return arr;
+}
+
+MODULE = Mac::Growl		PACKAGE = Mac::Growl
+
+void
+RegisterNotifications(app, all, def)
+		const char * app
+		SV * all
+		SV * def
+	INIT:
+		CFArrayRef allArray, defArray;
+		CFStringRef appName;
+		
+		if(!ArrayRefOK(all) || !ArrayRefOK(def))
+		{
+			XSRETURN_UNDEF;
+		}
+		
+		CFNotificationCenterRef distCenter = CFNotificationCenterGetDistributedCenter();
+		CFMutableDictionaryRef note = CFDictionaryCreateMutable(
+											kCFAllocatorDefault,
+											3,
+											NULL, NULL);
+	CODE:
+		allArray = CFArrayFromSV((AV *)SvRV(all));
+		defArray = CFArrayFromSV((AV *)SvRV(def));
+		appName = MakeCFString(app);
+
+		CFDictionaryAddValue(note,GROWL_APP_NAME,appName);
+		CFDictionaryAddValue(note,GROWL_NOTIFICATIONS_ALL,allArray);
+		CFDictionaryAddValue(note,GROWL_NOTIFICATIONS_DEFAULT,defArray);
+
+		CFNotificationCenterPostNotification(distCenter, GROWL_APP_REGISTRATION, NULL, note, FALSE);
+
+		/*CFRelease(allArray);
+		CFRelease(defArray);
+		CFRelease(appName);
+		CFRelease(note);*/
+		
+void PostNotification(app, noteName, title, description)
+		const char * app
+		const char * noteName
+		const char * title
+		const char * description
+	INIT:
+		CFNotificationCenterRef distCenter = CFNotificationCenterGetDistributedCenter();
+		CFMutableDictionaryRef note = CFDictionaryCreateMutable(
+											kCFAllocatorDefault,
+											4,
+											NULL, NULL);
+		
+	CODE:
+		CFDictionaryAddValue(note, GROWL_NOTIFICATION_TITLE,MakeCFString(title));
+		CFDictionaryAddValue(note, GROWL_NOTIFICATION_DESCRIPTION, MakeCFString(description));
+		CFDictionaryAddValue(note, GROWL_APP_NAME, MakeCFString(app));
+		CFNotificationCenterPostNotification(distCenter, MakeCFString(noteName), NULL, note, TRUE);
+		
+		/*CFRelease(note);*/
+

perl/Mac-Growl/GrowlDefinesCarbon.h

+//
+//  GrowlDefines.h
+//  Growl
+//
+//  Created by Karl Adam on Mon May 17 2004.
+//  Copyright (c) 2004 __MyCompanyName__. All rights reserved.
+//
+
+// User Info Keys For Registration
+#define GROWL_APP_NAME					CFSTR("ApplicationName")
+#define GROWL_NOTIFICATIONS_DEFAULT		CFSTR("DefaultNotifications")
+#define GROWL_NOTIFICATIONS_ALL			CFSTR("AllNotifications")
+
+// User Info Keys For Notifications
+#define GROWL_NOTIFICATION_TITLE		CFSTR("NotificationTitle")
+#define GROWL_NOTIFICATION_DESCRIPTION  CFSTR("NotificationDescription")
+#define GROWL_NOTIFICATION_ICON			CFSTR("NotificationIcon")
+
+// Notifications
+#define GROWL_APP_REGISTRATION			CFSTR("GrowlApplicationRegistrationNotification")

perl/Mac-Growl/MANIFEST

+Changes
+Growl.xs
+GrowlDefinesCarbon.h
+Makefile.PL
+MANIFEST
+ppport.h
+README
+t/Mac-Growl.t
+lib/Mac/Growl.pm

perl/Mac-Growl/Makefile.PL

+use 5.008001;
+use ExtUtils::MakeMaker;
+use Config;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    NAME              => 'Mac::Growl',
+    VERSION_FROM      => 'lib/Mac/Growl.pm', # finds $VERSION
+    PREREQ_PM         => {}, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM  => 'lib/Mac/Growl.pm', # retrieve abstract from module
+       AUTHOR         => 'Nelson Elhage <nelhage@gmail.com>') : ()),
+    LIBS              => [''], # e.g., '-lm'
+	LDDLFLAGS         => $Config{lddlflags} . " -framework CoreFoundation", #Link Core Foundation framework
+    DEFINE            => '', # e.g., '-DHAVE_SOMETHING'
+    INC               => '-I.', # e.g., '-I. -I/usr/include/other'
+	# Un-comment this if you add C files to link with later:
+    # OBJECT            => '$(O_FILES)', # link all the C files too
+);

perl/Mac-Growl/README

+Mac-Growl version 0.20
+======================
+
+Mac::Growl provides an interface for perl scripts to connect to Growl,
+allowing them to register with it, and send it notifications to be
+displayed.
+
+Consult man Mac::Growl or perldoc Mac::Growl after installation for
+more details, or perldoc lib/Mac/Growl.pm beforehand.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+make test will register "PerlApp" with growl with Growl, with one
+notification, "PerlApp-Test", and then post that notification with a message.
+Please note, the first time you make test, the notification make take a
+significant amount of time to appear, while Growl searches for an icon for
+the non-existent "PerlApp". This will be fixed in a later version.
+Also note, since there is currently no Growl->Caller communication, there is
+no way for the test script to tell if it's working, and therefore will always
+report sucess. If you don't see the notification, check console, wait a while
+and try again, and/or ask in #growl on irc.freenode.net.
+
+DEPENDENCIES
+
+This module should work on any Mac OS X system, although it requires
+the developer tools to build and install.
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2004 by Nelson Elhage
+
+This Library is released under the BSD license. I hate legalese, so
+someone who hates it slightly less will have to fix this section.
+
+

perl/Mac-Growl/lib/Mac/Growl.pm

+package Mac::Growl;
+
+use 5.008001;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+
+# This allows declaration	use Mac::Growl ':all';
+# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
+# will save memory.
+our %EXPORT_TAGS = ( 'all' => [ qw(
+RegisterNotification PostNotifications
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+	
+);
+
+our $VERSION = '0.20';
+
+require XSLoader;
+XSLoader::load('Mac::Growl', $VERSION);
+
+# Preloaded methods go here.
+
+1;
+__END__
+
+=head1 NAME
+
+Mac::Growl - Perl extension for registering and sending Growl Notifications on OS X
+
+=head1 SYNOPSIS
+
+  use Mac::Growl qw{RegisterNotifications, PostNotification};
+
+  RegisterNotifications("MyPerlApp", \@allNotifications, \@defaultNotifications);
+  PostNotification("MyPerlApp", $notificationName, $notificationTitle, $notificationDescription);
+
+=head1 DESCRIPTION
+
+Mac::Growl provides a simple notification for perl apps to register themselves with and send notifications to the OS X notification application Growl.
+	
+Mac::Growl defines two methods:
+	
+=over 4
+
+=item RegisterNotifications(appname, allNotifications, defaultNotifications);
+
+RegisterNotifications takes the name of the application sending notifications, as well as a reference to a list of all notifications the app sends out, and a reference to an array of all the notifications to be enabled by default.
+
+=item PostNotification(appname, name, title, description);
+
+PostNotification takes the name of the sending application (normally the same as passed to the Register call), the name of the notification (should be one of the list passed to Register, and a title and description to be displayed by Growl
+
+=back
+
+=head2 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+http://sourceforge.net/projects/growl
+
+#growl on irc.freenode.net
+
+=head1 AUTHOR
+
+Nelson Elhage, E<lt>nelhage@gmail.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2004 by Nelson Elhage
+
+This Library is released under the BSD license. I hate legalese, so
+someone who hates it slightly less will have to fix this section.
+
+=cut

perl/Mac-Growl/ppport.h

+
+/* ppport.h -- Perl/Pollution/Portability Version 2.007 
+ *
+ * Automatically Created by Devel::PPPort on Wed Jun  2 16:53:51 2004 
+ *
+ * Do NOT edit this file directly! -- Edit PPPort.pm instead.
+ *
+ * Version 2.x, Copyright (C) 2001, Paul Marquess.
+ * Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+ * This code may be used and distributed under the same license as any
+ * version of Perl.
+ * 
+ * This version of ppport.h is designed to support operation with Perl
+ * installations back to 5.004, and has been tested up to 5.8.1.
+ *
+ * If this version of ppport.h is failing during the compilation of this
+ * module, please check if a newer version of Devel::PPPort is available
+ * on CPAN before sending a bug report.
+ *
+ * If you are using the latest version of Devel::PPPort and it is failing
+ * during compilation of this module, please send a report to perlbug@perl.com
+ *
+ * Include all following information:
+ *
+ *  1. The complete output from running "perl -V"
+ *
+ *  2. This file.
+ *
+ *  3. The name & version of the module you were trying to build.
+ *
+ *  4. A full log of the build that failed.
+ *
+ *  5. Any other information that you think could be relevant.
+ *
+ *
+ * For the latest version of this code, please retreive the Devel::PPPort
+ * module from CPAN.
+ * 
+ */
+
+/*
+ * In order for a Perl extension module to be as portable as possible
+ * across differing versions of Perl itself, certain steps need to be taken.
+ * Including this header is the first major one, then using dTHR is all the
+ * appropriate places and using a PL_ prefix to refer to global Perl
+ * variables is the second.
+ *
+ */
+
+
+/* If you use one of a few functions that were not present in earlier
+ * versions of Perl, please add a define before the inclusion of ppport.h
+ * for a static include, or use the GLOBAL request in a single module to
+ * produce a global definition that can be referenced from the other
+ * modules.
+ * 
+ * Function:            Static define:           Extern define:
+ * newCONSTSUB()        NEED_newCONSTSUB         NEED_newCONSTSUB_GLOBAL
+ *
+ */
+ 
+
+/* To verify whether ppport.h is needed for your module, and whether any
+ * special defines should be used, ppport.h can be run through Perl to check
+ * your source code. Simply say:
+ * 
+ * 	perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
+ * 
+ * The result will be a list of patches suggesting changes that should at
+ * least be acceptable, if not necessarily the most efficient solution, or a
+ * fix for all possible problems. It won't catch where dTHR is needed, and
+ * doesn't attempt to account for global macro or function definitions,
+ * nested includes, typemaps, etc.
+ * 
+ * In order to test for the need of dTHR, please try your module under a
+ * recent version of Perl that has threading compiled-in.
+ *
+ */ 
+
+
+/*
+#!/usr/bin/perl
+@ARGV = ("*.xs") if !@ARGV;
+%badmacros = %funcs = %macros = (); $replace = 0;
+foreach (<DATA>) {
+	$funcs{$1} = 1 if /Provide:\s+(\S+)/;
+	$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
+	$replace = $1 if /Replace:\s+(\d+)/;
+	$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
+	$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
+}
+foreach $filename (map(glob($_),@ARGV)) {
+	unless (open(IN, "<$filename")) {
+		warn "Unable to read from $file: $!\n";
+		next;
+	}
+	print "Scanning $filename...\n";
+	$c = ""; while (<IN>) { $c .= $_; } close(IN);
+	$need_include = 0; %add_func = (); $changes = 0;
+	$has_include = ($c =~ /#.*include.*ppport/m);
+
+	foreach $func (keys %funcs) {
+		if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
+			if ($c !~ /\b$func\b/m) {
+				print "If $func isn't needed, you don't need to request it.\n" if
+				$changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
+			} else {
+				print "Uses $func\n";
+				$need_include = 1;
+			}
+		} else {
+			if ($c =~ /\b$func\b/m) {
+				$add_func{$func} =1 ;
+				print "Uses $func\n";
+				$need_include = 1;
+			}
+		}
+	}
+
+	if (not $need_include) {
+		foreach $macro (keys %macros) {
+			if ($c =~ /\b$macro\b/m) {
+				print "Uses $macro\n";
+				$need_include = 1;
+			}
+		}
+	}
+
+	foreach $badmacro (keys %badmacros) {
+		if ($c =~ /\b$badmacro\b/m) {
+			$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
+			print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
+			$need_include = 1;
+		}
+	}
+	
+	if (scalar(keys %add_func) or $need_include != $has_include) {
+		if (!$has_include) {
+			$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
+			       "#include \"ppport.h\"\n";
+			$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
+		} elsif (keys %add_func) {
+			$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
+			$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
+		}
+		if (!$need_include) {
+			print "Doesn't seem to need ppport.h.\n";
+			$c =~ s/^.*#.*include.*ppport.*\n//m;
+		}
+		$changes++;
+	}
+	
+	if ($changes) {
+		open(OUT,">/tmp/ppport.h.$$");
+		print OUT $c;
+		close(OUT);
+		open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
+		while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
+		close(DIFF);
+		unlink("/tmp/ppport.h.$$");
+	} else {
+		print "Looks OK\n";
+	}
+}
+__DATA__
+*/
+
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
+#ifndef PERL_REVISION
+#   ifndef __PATCHLEVEL_H_INCLUDED__
+#       include <patchlevel.h>
+#   endif
+#   if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
+#       include <could_not_find_Perl_patchlevel.h>
+#   endif
+#   ifndef PERL_REVISION
+#	define PERL_REVISION	(5)
+        /* Replace: 1 */
+#       define PERL_VERSION	PATCHLEVEL
+#       define PERL_SUBVERSION	SUBVERSION
+        /* Replace PERL_PATCHLEVEL with PERL_VERSION */
+        /* Replace: 0 */
+#   endif
+#endif
+
+#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
+
+/* It is very unlikely that anyone will try to use this with Perl 6 
+   (or greater), but who knows.
+ */
+#if PERL_REVISION != 5
+#	error ppport.h only works with Perl version 5
+#endif /* PERL_REVISION != 5 */
+
+#ifndef ERRSV
+#	define ERRSV perl_get_sv("@",FALSE)
+#endif
+
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
+/* Replace: 1 */
+#	define PL_Sv		Sv
+#	define PL_compiling	compiling
+#	define PL_copline	copline
+#	define PL_curcop	curcop
+#	define PL_curstash	curstash
+#	define PL_defgv		defgv
+#	define PL_dirty		dirty
+#	define PL_dowarn	dowarn
+#	define PL_hints		hints
+#	define PL_na		na
+#	define PL_perldb	perldb
+#	define PL_rsfp_filters	rsfp_filters
+#	define PL_rsfpv		rsfp
+#	define PL_stdingv	stdingv
+#	define PL_sv_no		sv_no
+#	define PL_sv_undef	sv_undef
+#	define PL_sv_yes	sv_yes
+/* Replace: 0 */
+#endif
+
+#ifdef HASATTRIBUTE
+#  if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+#    define PERL_UNUSED_DECL
+#  else
+#    define PERL_UNUSED_DECL __attribute__((unused))
+#  endif
+#else
+#  define PERL_UNUSED_DECL
+#endif
+
+#ifndef dNOOP
+#  define NOOP (void)0
+#  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef dTHR
+#  define dTHR          dNOOP
+#endif
+
+#ifndef dTHX
+#  define dTHX          dNOOP
+#  define dTHXa(x)      dNOOP
+#  define dTHXoa(x)     dNOOP
+#endif
+
+#ifndef pTHX
+#    define pTHX	void
+#    define pTHX_
+#    define aTHX
+#    define aTHX_
+#endif         
+
+/* IV could also be a quad (say, a long long), but Perls
+ * capable of those should have IVSIZE already. */
+#if !defined(IVSIZE) && defined(LONGSIZE)
+#   define IVSIZE LONGSIZE
+#endif
+#ifndef IVSIZE
+#   define IVSIZE 4 /* A bold guess, but the best we can make. */
+#endif
+
+#ifndef UVSIZE
+#   define UVSIZE IVSIZE
+#endif
+
+#ifndef NVTYPE
+#   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
+#       define NVTYPE long double
+#   else
+#       define NVTYPE double
+#   endif
+typedef NVTYPE NV;
+#endif
+
+#ifndef INT2PTR
+
+#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
+#  define PTRV                  UV
+#  define INT2PTR(any,d)        (any)(d)
+#else
+#  if PTRSIZE == LONGSIZE
+#    define PTRV                unsigned long
+#  else
+#    define PTRV                unsigned
+#  endif
+#  define INT2PTR(any,d)        (any)(PTRV)(d)
+#endif
+#define NUM2PTR(any,d)  (any)(PTRV)(d)
+#define PTR2IV(p)       INT2PTR(IV,p)
+#define PTR2UV(p)       INT2PTR(UV,p)
+#define PTR2NV(p)       NUM2PTR(NV,p)
+#if PTRSIZE == LONGSIZE
+#  define PTR2ul(p)     (unsigned long)(p)
+#else
+#  define PTR2ul(p)     INT2PTR(unsigned long,p)        
+#endif
+
+#endif /* !INT2PTR */
+
+#ifndef boolSV
+#	define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+#endif
+
+#ifndef gv_stashpvn
+#	define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
+#endif
+
+#ifndef newSVpvn
+#	define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
+#endif
+
+#ifndef newRV_inc
+/* Replace: 1 */
+#	define newRV_inc(sv) newRV(sv)
+/* Replace: 0 */
+#endif
+
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+#  define DEFSV	GvSV(PL_defgv)
+#endif
+
+#ifndef SAVE_DEFSV
+#    define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#endif
+
+#ifndef newRV_noinc
+#  ifdef __GNUC__
+#    define newRV_noinc(sv)               \
+      ({                                  \
+          SV *nsv = (SV*)newRV(sv);       \
+          SvREFCNT_dec(sv);               \
+          nsv;                            \
+      })
+#  else
+#    if defined(USE_THREADS)
+static SV * newRV_noinc (SV * sv)
+{
+          SV *nsv = (SV*)newRV(sv);       
+          SvREFCNT_dec(sv);               
+          return nsv;                     
+}
+#    else
+#      define newRV_noinc(sv)    \
+        (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
+#    endif
+#  endif
+#endif
+
+/* Provide: newCONSTSUB */
+
+/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
+#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
+
+#if defined(NEED_newCONSTSUB)
+static
+#else
+extern void newCONSTSUB(HV * stash, char * name, SV *sv);
+#endif
+
+#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
+void
+newCONSTSUB(stash,name,sv)
+HV *stash;
+char *name;
+SV *sv;
+{
+	U32 oldhints = PL_hints;
+	HV *old_cop_stash = PL_curcop->cop_stash;
+	HV *old_curstash = PL_curstash;
+	line_t oldline = PL_curcop->cop_line;
+	PL_curcop->cop_line = PL_copline;
+
+	PL_hints &= ~HINT_BLOCK_SCOPE;
+	if (stash)
+		PL_curstash = PL_curcop->cop_stash = stash;
+
+	newSUB(
+
+#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
+     /* before 5.003_22 */
+		start_subparse(),
+#else
+#  if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
+     /* 5.003_22 */
+     		start_subparse(0),
+#  else
+     /* 5.003_23  onwards */
+     		start_subparse(FALSE, 0),
+#  endif
+#endif
+
+		newSVOP(OP_CONST, 0, newSVpv(name,0)),
+		newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
+		newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+	);
+
+	PL_hints = oldhints;
+	PL_curcop->cop_stash = old_cop_stash;
+	PL_curstash = old_curstash;
+	PL_curcop->cop_line = oldline;
+}
+#endif
+
+#endif /* newCONSTSUB */
+
+#ifndef START_MY_CXT
+
+/*
+ * Boilerplate macros for initializing and accessing interpreter-local
+ * data from C.  All statics in extensions should be reworked to use
+ * this, if you want to make the extension thread-safe.  See ext/re/re.xs
+ * for an example of the use of these macros.
+ *
+ * Code that uses these macros is responsible for the following:
+ * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
+ * 2. Declare a typedef named my_cxt_t that is a structure that contains
+ *    all the data that needs to be interpreter-local.
+ * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
+ * 4. Use the MY_CXT_INIT macro such that it is called exactly once
+ *    (typically put in the BOOT: section).
+ * 5. Use the members of the my_cxt_t structure everywhere as
+ *    MY_CXT.member.
+ * 6. Use the dMY_CXT macro (a declaration) in all the functions that
+ *    access MY_CXT.
+ */
+
+#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
+    defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
+
+/* This must appear in all extensions that define a my_cxt_t structure,
+ * right after the definition (i.e. at file scope).  The non-threads
+ * case below uses it to declare the data as static. */
+#define START_MY_CXT
+
+#if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
+/* Fetches the SV that keeps the per-interpreter data. */
+#define dMY_CXT_SV \
+	SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
+#else /* >= perl5.004_68 */
+#define dMY_CXT_SV \
+	SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,		\
+				  sizeof(MY_CXT_KEY)-1, TRUE)
+#endif /* < perl5.004_68 */
+
+/* This declaration should be used within all functions that use the
+ * interpreter-local data. */
+#define dMY_CXT	\
+	dMY_CXT_SV;							\
+	my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
+
+/* Creates and zeroes the per-interpreter data.
+ * (We allocate my_cxtp in a Perl SV so that it will be released when
+ * the interpreter goes away.) */
+#define MY_CXT_INIT \
+	dMY_CXT_SV;							\
+	/* newSV() allocates one more than needed */			\
+	my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+	Zero(my_cxtp, 1, my_cxt_t);					\
+	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+
+/* This macro must be used to access members of the my_cxt_t structure.
+ * e.g. MYCXT.some_data */
+#define MY_CXT		(*my_cxtp)
+
+/* Judicious use of these macros can reduce the number of times dMY_CXT
+ * is used.  Use is similar to pTHX, aTHX etc. */
+#define pMY_CXT		my_cxt_t *my_cxtp
+#define pMY_CXT_	pMY_CXT,
+#define _pMY_CXT	,pMY_CXT
+#define aMY_CXT		my_cxtp
+#define aMY_CXT_	aMY_CXT,
+#define _aMY_CXT	,aMY_CXT
+
+#else /* single interpreter */
+
+#define START_MY_CXT	static my_cxt_t my_cxt;
+#define dMY_CXT_SV	dNOOP
+#define dMY_CXT		dNOOP
+#define MY_CXT_INIT	NOOP
+#define MY_CXT		my_cxt
+
+#define pMY_CXT		void
+#define pMY_CXT_
+#define _pMY_CXT
+#define aMY_CXT
+#define aMY_CXT_
+#define _aMY_CXT
+
+#endif 
+
+#endif /* START_MY_CXT */
+
+#ifndef IVdf
+#  if IVSIZE == LONGSIZE
+#       define	IVdf		"ld"
+#       define	UVuf		"lu"
+#       define	UVof		"lo"
+#       define	UVxf		"lx"
+#       define	UVXf		"lX"
+#   else
+#       if IVSIZE == INTSIZE
+#           define	IVdf	"d"
+#           define	UVuf	"u"
+#           define	UVof	"o"
+#           define	UVxf	"x"
+#           define	UVXf	"X"
+#       endif
+#   endif
+#endif
+
+#ifndef NVef
+#   if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
+	defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ 
+#       define NVef		PERL_PRIeldbl
+#       define NVff		PERL_PRIfldbl
+#       define NVgf		PERL_PRIgldbl
+#   else
+#       define NVef		"e"
+#       define NVff		"f"
+#       define NVgf		"g"
+#   endif
+#endif
+
+#ifndef AvFILLp			/* Older perls (<=5.003) lack AvFILLp */
+#   define AvFILLp AvFILL
+#endif
+
+#ifdef SvPVbyte
+#   if PERL_REVISION == 5 && PERL_VERSION < 7
+       /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
+#       undef SvPVbyte
+#       define SvPVbyte(sv, lp) \
+          ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+           ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
+       static char *
+       my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
+       {   
+           sv_utf8_downgrade(sv,0);
+           return SvPV(sv,*lp);
+       }
+#   endif
+#else
+#   define SvPVbyte SvPV
+#endif
+
+#ifndef SvPV_nolen
+#   define SvPV_nolen(sv) \
+        ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+         ? SvPVX(sv) : sv_2pv_nolen(sv))
+    static char *
+    sv_2pv_nolen(pTHX_ register SV *sv)
+    {   
+        STRLEN n_a;
+        return sv_2pv(sv, &n_a);
+    }
+#endif
+
+#ifndef get_cv
+#   define get_cv(name,create) perl_get_cv(name,create)
+#endif
+
+#ifndef get_sv
+#   define get_sv(name,create) perl_get_sv(name,create)
+#endif
+
+#ifndef get_av
+#   define get_av(name,create) perl_get_av(name,create)
+#endif
+
+#ifndef get_hv
+#   define get_hv(name,create) perl_get_hv(name,create)
+#endif
+
+#ifndef call_argv
+#   define call_argv perl_call_argv
+#endif
+
+#ifndef call_method
+#   define call_method perl_call_method
+#endif
+
+#ifndef call_pv
+#   define call_pv perl_call_pv
+#endif
+
+#ifndef call_sv
+#   define call_sv perl_call_sv
+#endif
+
+#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
+#   define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef PERL_SCAN_SILENT_ILLDIGIT
+#   define PERL_SCAN_SILENT_ILLDIGIT 0x04
+#endif
+
+#ifndef PERL_SCAN_ALLOW_UNDERSCORES
+#   define PERL_SCAN_ALLOW_UNDERSCORES 0x01
+#endif
+
+#ifndef PERL_SCAN_DISALLOW_PREFIX
+#   define PERL_SCAN_DISALLOW_PREFIX 0x02
+#endif
+
+#if (PERL_VERSION >= 6)
+#define I32_CAST
+#else
+#define I32_CAST (I32*)
+#endif
+
+#ifndef grok_hex
+static UV _grok_hex (char *string, STRLEN *len, I32 *flags, NV *result) {
+    NV r = scan_hex(string, *len, I32_CAST len);
+    if (r > UV_MAX) {
+        *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
+        if (result) *result = r;
+        return UV_MAX;
+    }
+    return (UV)r;
+}
+        
+#   define grok_hex(string, len, flags, result)     \
+        _grok_hex((string), (len), (flags), (result))
+#endif 
+
+#ifndef grok_oct
+static UV _grok_oct (char *string, STRLEN *len, I32 *flags, NV *result) {
+    NV r = scan_oct(string, *len, I32_CAST len);
+    if (r > UV_MAX) {
+        *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
+        if (result) *result = r;
+        return UV_MAX;
+    }
+    return (UV)r;
+}
+
+#   define grok_oct(string, len, flags, result)     \
+        _grok_oct((string), (len), (flags), (result))
+#endif
+
+#ifndef grok_bin
+static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) {
+    NV r = scan_bin(string, *len, I32_CAST len);
+    if (r > UV_MAX) {
+        *flags |= PERL_SCAN_GREATER_THAN_UV_MAX;
+        if (result) *result = r;
+        return UV_MAX;
+    }
+    return (UV)r;
+}
+
+#   define grok_bin(string, len, flags, result)     \
+        _grok_bin((string), (len), (flags), (result))
+#endif
+
+#ifndef IN_LOCALE
+#   define IN_LOCALE \
+	(PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+#endif
+
+#ifndef IN_LOCALE_RUNTIME
+#   define IN_LOCALE_RUNTIME   (PL_curcop->op_private & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE_COMPILETIME
+#   define IN_LOCALE_COMPILETIME   (PL_hints & HINT_LOCALE)
+#endif
+
+
+#ifndef IS_NUMBER_IN_UV
+#   define IS_NUMBER_IN_UV		            0x01   
+#   define IS_NUMBER_GREATER_THAN_UV_MAX    0x02
+#   define IS_NUMBER_NOT_INT	            0x04
+#   define IS_NUMBER_NEG		            0x08
+#   define IS_NUMBER_INFINITY	            0x10 
+#   define IS_NUMBER_NAN                    0x20  
+#endif
+   
+#ifndef grok_numeric_radix
+#   define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
+
+#define grok_numeric_radix Perl_grok_numeric_radix
+    
+bool
+Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
+{
+#ifdef USE_LOCALE_NUMERIC
+#if (PERL_VERSION >= 6)
+    if (PL_numeric_radix_sv && IN_LOCALE) { 
+        STRLEN len;
+        char* radix = SvPV(PL_numeric_radix_sv, len);
+        if (*sp + len <= send && memEQ(*sp, radix, len)) {
+            *sp += len;
+            return TRUE; 
+        }
+    }
+#else
+    /* pre5.6.0 perls don't have PL_numeric_radix_sv so the radix
+     * must manually be requested from locale.h */
+#include <locale.h>
+    struct lconv *lc = localeconv();
+    char *radix = lc->decimal_point;
+    if (radix && IN_LOCALE) { 
+        STRLEN len = strlen(radix);
+        if (*sp + len <= send && memEQ(*sp, radix, len)) {
+            *sp += len;
+            return TRUE; 
+        }
+    }
+#endif /* PERL_VERSION */
+#endif /* USE_LOCALE_NUMERIC */
+    /* always try "." if numeric radix didn't match because
+     * we may have data from different locales mixed */
+    if (*sp < send && **sp == '.') {
+        ++*sp;
+        return TRUE;
+    }
+    return FALSE;
+}
+#endif /* grok_numeric_radix */
+
+#ifndef grok_number
+
+#define grok_number Perl_grok_number
+
+int
+Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
+{
+  const char *s = pv;
+  const char *send = pv + len;
+  const UV max_div_10 = UV_MAX / 10;
+  const char max_mod_10 = UV_MAX % 10;
+  int numtype = 0;
+  int sawinf = 0;
+  int sawnan = 0;
+
+  while (s < send && isSPACE(*s))
+    s++;
+  if (s == send) {
+    return 0;
+  } else if (*s == '-') {
+    s++;
+    numtype = IS_NUMBER_NEG;
+  }
+  else if (*s == '+')
+  s++;
+
+  if (s == send)
+    return 0;
+
+  /* next must be digit or the radix separator or beginning of infinity */
+  if (isDIGIT(*s)) {
+    /* UVs are at least 32 bits, so the first 9 decimal digits cannot
+       overflow.  */
+    UV value = *s - '0';
+    /* This construction seems to be more optimiser friendly.
+       (without it gcc does the isDIGIT test and the *s - '0' separately)
+       With it gcc on arm is managing 6 instructions (6 cycles) per digit.
+       In theory the optimiser could deduce how far to unroll the loop
+       before checking for overflow.  */
+    if (++s < send) {
+      int digit = *s - '0';
+      if (digit >= 0 && digit <= 9) {
+        value = value * 10 + digit;
+        if (++s < send) {
+          digit = *s - '0';
+          if (digit >= 0 && digit <= 9) {
+            value = value * 10 + digit;
+            if (++s < send) {
+              digit = *s - '0';
+              if (digit >= 0 && digit <= 9) {
+                value = value * 10 + digit;
+		        if (++s < send) {
+                  digit = *s - '0';
+                  if (digit >= 0 && digit <= 9) {
+                    value = value * 10 + digit;
+                    if (++s < send) {
+                      digit = *s - '0';
+                      if (digit >= 0 && digit <= 9) {
+                        value = value * 10 + digit;
+                        if (++s < send) {
+                          digit = *s - '0';
+                          if (digit >= 0 && digit <= 9) {
+                            value = value * 10 + digit;
+                            if (++s < send) {
+                              digit = *s - '0';
+                              if (digit >= 0 && digit <= 9) {
+                                value = value * 10 + digit;
+                                if (++s < send) {
+                                  digit = *s - '0';
+                                  if (digit >= 0 && digit <= 9) {
+                                    value = value * 10 + digit;
+                                    if (++s < send) {
+                                      /* Now got 9 digits, so need to check
+                                         each time for overflow.  */
+                                      digit = *s - '0';
+                                      while (digit >= 0 && digit <= 9
+                                             && (value < max_div_10
+                                                 || (value == max_div_10
+                                                     && digit <= max_mod_10))) {
+                                        value = value * 10 + digit;
+                                        if (++s < send)
+                                          digit = *s - '0';
+                                        else
+                                          break;
+                                      }
+                                      if (digit >= 0 && digit <= 9
+                                          && (s < send)) {
+                                        /* value overflowed.
+                                           skip the remaining digits, don't
+                                           worry about setting *valuep.  */
+                                        do {
+                                          s++;
+                                        } while (s < send && isDIGIT(*s));
+                                        numtype |=
+                                          IS_NUMBER_GREATER_THAN_UV_MAX;
+                                        goto skip_value;
+                                      }
+                                    }
+                                  }
+				                }
+                              }
+                            }
+                          }
+                        }
+                      }
+                    }
+                  }
+                }
+              }
+            }
+          }
+	    }
+      }
+    }
+    numtype |= IS_NUMBER_IN_UV;
+    if (valuep)
+      *valuep = value;
+
+  skip_value:
+    if (GROK_NUMERIC_RADIX(&s, send)) {
+      numtype |= IS_NUMBER_NOT_INT;
+      while (s < send && isDIGIT(*s))  /* optional digits after the radix */
+        s++;
+    }
+  }
+  else if (GROK_NUMERIC_RADIX(&s, send)) {
+    numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
+    /* no digits before the radix means we need digits after it */
+    if (s < send && isDIGIT(*s)) {
+      do {
+        s++;
+      } while (s < send && isDIGIT(*s));
+      if (valuep) {
+        /* integer approximation is valid - it's 0.  */
+        *valuep = 0;
+      }
+    }
+    else
+      return 0;
+  } else if (*s == 'I' || *s == 'i') {
+    s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+    s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
+    s++; if (s < send && (*s == 'I' || *s == 'i')) {
+      s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+      s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
+      s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
+      s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
+      s++;
+    }
+    sawinf = 1;
+  } else if (*s == 'N' || *s == 'n') {
+    /* XXX TODO: There are signaling NaNs and quiet NaNs. */
+    s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
+    s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+    s++;
+    sawnan = 1;
+  } else
+    return 0;
+
+  if (sawinf) {
+    numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
+    numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+  } else if (sawnan) {
+    numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
+    numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+  } else if (s < send) {
+    /* we can have an optional exponent part */
+    if (*s == 'e' || *s == 'E') {
+      /* The only flag we keep is sign.  Blow away any "it's UV"  */
+      numtype &= IS_NUMBER_NEG;
+      numtype |= IS_NUMBER_NOT_INT;
+      s++;
+      if (s < send && (*s == '-' || *s == '+'))
+        s++;
+      if (s < send && isDIGIT(*s)) {
+        do {
+          s++;
+        } while (s < send && isDIGIT(*s));
+      }
+      else
+      return 0;
+    }
+  }
+  while (s < send && isSPACE(*s))
+    s++;
+  if (s >= send)
+    return numtype;
+  if (len == 10 && memEQ(pv, "0 but true", 10)) {
+    if (valuep)
+      *valuep = 0;
+    return IS_NUMBER_IN_UV;
+  }
+  return 0;
+}
+#endif /* grok_number */
+#endif /* _P_P_PORTABILITY_H_ */
+
+/* End of File ppport.h */

perl/Mac-Growl/t/Mac-Growl.t

+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl Mac-Growl.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 1;
+BEGIN { use_ok('Mac::Growl') };
+
+#########################
+
+Mac::Growl::RegisterNotifications("PerlApp",["PerlApp-Test"],["PerlApp-Test"]);
+sleep(1);	#A brief delay for Growl to process the notification
+Mac::Growl::PostNotification("PerlApp","PerlApp-Test","Congratulations","Mac::Growl is working.");

perl/irssi/growl.pl

+use strict;
+use warnings;
+
+use vars qw($VERSION %IRSSI $Notes $AppName);
+
+use Mac::Growl;
+
+use Irssi;
+
+
+$VERSION = 0.01;
+%IRSSI = (
+	authors		=>	'Nelson Elhage',
+	contact		=>	'Hanji@users.sourceforge.net',
+	name			=>	'Growl',
+	description	=>	'Sends out Growl notifications for irssi.',
+	license		=>	'BSD'
+);
+
+#This is a simple irssi script to send out Growl notifications using
+#Mac::Growl. At the moment, it just sends out notifications for every
+#privmsg you receive.
+
+$Notes = ["irssi-privmsg"];
+$AppName = "irssi";
+
+Mac::Growl::RegisterNotifications($AppName,$Notes,$Notes);
+
+sub event_privmsg
+{
+	my ($server, $data, $nick, $address) = @_;
+	Mac::Growl::PostNotification($AppName,"irssi-privmsg","$nick","$data");
+}
+
+Irssi::signal_add_last("message private","event_privmsg");