Perl Sugar
Jump to navigation
Jump to search
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; } }