Perl Sugar

Using Perl with Sugar

Why would anyone want to use Perl instead of Python? Perhaps that particular holy war is best left to the mailing lists and along side the vi versus emacs debates. Thanks to Inline::Python, it is not necessary to re-implement the wheel -- Perl can call directly into the Python libraries to interact with the Gtk toolkit and all of the Activity functions written in Python.

HelloWorldActivity

A sample activity written in Perl, directly copied from Sugar Activity Tutorial

#!/usr/bin/perl
# Perl translation of the HelloWorldActivity
#
#	http://wiki.laptop.org/go/Sugar_Activity_Tutorial
#
package HelloWorldActivity;
use warnings;
use strict;
use Sugar;
use base 'Sugar::Activity';


sub new
{
	my $class = shift;
	my $handle = shift;

	# Call our base class constructor to initialize the activity
	my $self = $class->SUPER::new( $handle, 0 );

	# Rebless it into our own class
	$self = bless $self, $class;

	# Creates the Toolbox. It contains the Activity Toolbar, which is the
	# bar that appears on every Sugar window and contains essential
	# functionalities, such as the 'Collaborate' and 'Close' buttons.
	my $toolbox = Sugar::ActivityToolbox->new( $self );
	$self->set_toolbox( $toolbox );
	$toolbox->show();
 
	# Creates a new button with the label "Hello World".
	my $button = Sugar::Gtk::Button->new( "Hello, World\nFrom Perl!" );
     
	# When the button receives the "clicked" signal, it will call the
	# closure to print that it was clicked.
	$button->connect( clicked => sub {
		Sugar::logging_info( "Hello, world!" );
		print "Clicked!\n";
	} );
     
	# Set the button to be our canvas. The canvas is the main section of
	# every Sugar Window. It fills all the area below the toolbox.
	$self->set_canvas( $button );

	# The final step is to display this newly created widget.
	$button->show();
	
	return $self;
}

"0, but true";
__END__

Sugar.pm

The top level library that wraps most of the Python code is Sugar.pm:

#!/usr/bin/perl
package Sugar;
use warnings;
use strict;

use Inline Python => q
{
#
# Bring in all of the Sugar classes that we'll need
#
from sugar.activity.activity import *
from sugar.activity.activityhandle import ActivityHandle
from sugar.bundle.bundle import Bundle
from sugar.bundle.activitybundle import ActivityBundle
from sugar.graphics.window import Window
from logging import info as logging_info

#
# Update the Python environment hash from a Perl value
# since the values in the Python dictionary are only read
# at time of the import of the Inline::Python class
#
import os
def update_py_environment( key, value ):
        os.environ[key] = value

#
# Get the attributes of an object
#
def dict( obj ) :
	return obj.__dict__

def attr( key, obj ) :
	return obj.__dict__[key]

};



package Sugar::Gtk;

use Inline Python => q{
#
# Provide a way to call the gtk mainloop
#
from pygtk import *
from gtk import *
from gtk.gdk import *
import gobject

def gtk_main():
	gtk.main()

def gtk_main_quit():
	gtk.main_quit()

def connect( self, event, func ) :
	def cb( win, ev ) :
		print "Callback"
		func( win, ev )
	self.connect( event, cb )
};



#
# Gtk events are implemented as C structures and Perl is not
# able to read them directly.  These Python helpers will extract
# the attributes for us instead.
#
package Sugar::Gtk::Event;

use Inline Python => q{
def keyval( ev ) :
	return ev.keyval

def keyval_name( ev ) :
	return gtk.gdk.keyval_name( ev.keyval )

};

"0, but true";
__END__

perl-sugar-activity

The launcher program:

#!/usr/bin/perl
use warnings;
use strict;

#
# Setup the environment before we use the Sugar module.
# That way the Python routines are able to find these variables
# before we go into the activity.
#
BEGIN {
$ENV{SUGAR_BUNDLE_PATH}	||= '.';
$ENV{GTK2_RC_FILES}	||= '/usr/share/sugar/data/sugar-xo.gtkrc';
$ENV{SUGAR_PATH}	||= '/usr/share/sugar';
$ENV{SUGAR_PREFIX}	||= '/usr';
}

use Sugar;

my $bundle = Sugar::ActivityBundle->new( $ENV{SUGAR_BUNDLE_PATH} );

# Extract the details from the bundle and update the environment
my $id = $ENV{SUGAR_BUNDLE_ID}		= $bundle->get_bundle_id;
my $name = $ENV{SUGAR_BUNDLE_NAME}	= $bundle->get_name;

Sugar::update_py_environment( $_ => $ENV{$_} )
	for qw/
		SUGAR_BUNDLE_NAME
		SUGAR_BUNDLE_ID
		SUGAR_BUNDLE_PATH
		SUGAR_PATH
		SUGAR_PREFIX
		GTK2_RC_FILES
	/;


# Load the file now that our parameters have been set
my $file = shift
	or die "$0: No activity specified\n";

eval { require "$file" };
die "$0: $@\n" if $@;

# We could set activity id, object id and uri here
my $handle = Sugar::ActivityHandle->new( $name );

my $activity = "$file"->new( $handle )
	or die "$file: Creation failed\n";

$activity->connect( destroy => sub { Sugar::Gtk::gtk_main_quit } );
$activity->show;

Sugar::Gtk::gtk_main;

Fix for Inline::Python

A bug fix for Inline::Python's use of C derived classes when they are wrapped in Python objects:

diff -u --recursive ./pristine/Inline-Python-0.22/Python.xs ./Inline-Python-0.22/Python.xs
--- ./pristine/Inline-Python-0.22/Python.xs	2004-07-27 01:02:05.000000000 -0400
+++ ./Inline-Python-0.22/Python.xs	2008-03-23 15:01:55.000000000 -0400
@@ -290,7 +290,10 @@
 
   Printf(("inst {%p} successfully passed the PVMG test\n", inst));
 
-  if (!(PyInstance_Check(inst) || inst->ob_type->tp_flags & Py_TPFLAGS_HEAPTYPE)) {
+  if (!(PyInstance_Check(inst)
+  || inst->ob_type->tp_flags & Py_TPFLAGS_HEAPTYPE
+  || inst->ob_type->tp_flags & Py_TPFLAGS_HAVE_CLASS
+  )) {
     croak("Attempted to call method '%s' on a non-instance", mname);
     XSRETURN_EMPTY;
   }
diff -u --recursive ./pristine/Inline-Python-0.22/py2pl.c ./Inline-Python-0.22/py2pl.c
--- ./pristine/Inline-Python-0.22/py2pl.c	2005-01-10 01:19:33.000000000 -0500
+++ ./Inline-Python-0.22/py2pl.c	2008-03-23 16:52:08.000000000 -0400
@@ -74,39 +74,22 @@
 	else
 #endif
 
-	/* wrap an instance of a Python class */
-	/* elw: here we need to make these look like instances: */
-	if ((obj->ob_type->tp_flags & Py_TPFLAGS_HEAPTYPE) || PyInstance_Check(obj)) {
-
-		/* This is a Python class instance -- bless it into an
-		 * Inline::Python::Object. If we're being called from an
-		 * Inline::Python class, it will be re-blessed into whatever
-		 * class that is.
-		 */
-		SV *inst_ptr = newSViv(0);
-		SV *inst;
-		MAGIC *mg;
-		_inline_magic priv;
-
-		inst = newSVrv(inst_ptr, "Inline::Python::Object");
-
-		/* set up magic */
-		priv.key = INLINE_MAGIC_KEY;
-		sv_magic(inst, inst, '~', (char *) &priv, sizeof(priv));
-		mg = mg_find(inst, '~');
-		mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
-		mg->mg_virtual->svt_free = free_inline_py_obj;
-
-		sv_setiv(inst, (IV) obj);
-		/*SvREADONLY_on(inst); *//* to uncomment this means I can't
-			re-bless it */
-		Py_INCREF(obj);
-		Printf(("Py2Pl: Instance\n"));
-		return inst_ptr;
+	/* a string (or number) with no overloading */
+	if( PyString_CheckExact(obj)
+	||  PyInt_CheckExact(obj)
+	||  PyFloat_CheckExact(obj)
+	) {
+		PyObject *string = PyObject_Str(obj);	/* new reference */
+		char *str = PyString_AsString(string);
+		SV *s2 = newSVpv(str, PyString_Size(string));
+		Printf(("Py2Pl: string / number\n"));
+		Py_DECREF(string);
+		return s2;
 	}
 
 	/* a tuple or a list */
-	else if (PySequence_Check(obj) && !PyString_Check(obj)) {
+	else if( PySequence_Check(obj) )
+	{
 		AV *retval = newAV();
 		int i;
 		int sz = PySequence_Length(obj);
@@ -124,7 +107,8 @@
 
 	/* a dictionary or fake Mapping object */
 	/* elw: PyMapping_Check() now returns true for strings */
-	else if (! PyString_Check(obj) && PyMapping_Check(obj)) {
+	else if( PyMapping_Check(obj) )
+	{
 		HV *retval = newHV();
 		int i;
 		int sz = PyMapping_Length(obj);
@@ -180,14 +164,34 @@
 		return newRV_noinc((SV *) retval);
 	}
 
-	/* a string (or number) */
+	/* wrap an instance of a Python class */
+	/* elw: here we need to make these look like instances: */
 	else {
-		PyObject *string = PyObject_Str(obj);	/* new reference */
-		char *str = PyString_AsString(string);
-		SV *s2 = newSVpv(str, PyString_Size(string));
-		Printf(("Py2Pl: string / number\n"));
-		Py_DECREF(string);
-		return s2;
+		/* This is a Python class instance -- bless it into an
+		 * Inline::Python::Object. If we're being called from an
+		 * Inline::Python class, it will be re-blessed into whatever
+		 * class that is.
+		 */
+		SV *inst_ptr = newSViv(0);
+		SV *inst;
+		MAGIC *mg;
+		_inline_magic priv;
+
+		inst = newSVrv(inst_ptr, "Inline::Python::Object");
+
+		/* set up magic */
+		priv.key = INLINE_MAGIC_KEY;
+		sv_magic(inst, inst, '~', (char *) &priv, sizeof(priv));
+		mg = mg_find(inst, '~');
+		mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
+		mg->mg_virtual->svt_free = free_inline_py_obj;
+
+		sv_setiv(inst, (IV) obj);
+		/*SvREADONLY_on(inst); *//* to uncomment this means I can't
+			re-bless it */
+		Py_INCREF(obj);
+		Printf(("Py2Pl: Instance\n"));
+		return inst_ptr;
 	}
 }