Add Try::Tiny to Mouse or Moose

Here is a little snippet that shows how to extend Mouse (lightweight version of Moose) with Try::Tiny for better exception handling.

Here would be your application class:

package MyApp::Mouse;

use Mouse ();
use Mouse::Exporter;
use Try::Tiny;

Mouse::Exporter->setup_import_methods( 
	as_is => [qw[try catch finally]],
	also  => 'Mouse'
);

1;

Then you simply use MyApp::Mouse in place of the Mouse module for your classes:

package Foo;

use MyApp:::Mouse;

sub t {
	my ($self,$d) = @_;
	
	my $v = try {
		die "testing" if $d;
		'no';
	} catch {
		$_;
	}; 

	return $v;
}

1;

A simple test?

package Foo;

~$ perl -Mfeature=:5.12 -MFoo -e say Foo->new->t;
no

Of course this recipe works with Moose, simply replace the Mouse namespace with the Moose namespace and your in business.

Experimenting with #mojolicious experimental groups block

In the course of discussion via IRC in #mojo the groups block was added as an experimental feature to Mojolicious::Lite (originally called routes but shortly after renamed), here is the result of me playing with it in the context of a authentication and authorization:

use Mojolicious::Lite;

under sub { 
  my $self = shift;
  my ($user) = split /:/, $self->req->url->to_abs->userinfo;
  
  unless ($user) {
    $self->res->headers->www_authenticate('Basic realm=test');
    $self->render_text('You must log in', status => 401);
    return;
  } else {
    $self->stash( user => $user );
    return 1;
  }
};

helper greet => sub {
  sprintf(
    "Hello %s would you like to play a game",
    shift->stash('user')
  );
};

get '/' => sub { shift->greet; };

group {
  under '/gtw' => sub { shift->stash('user') eq 'david' };

  get sub {
    shift->render_text('The only way to win is to not play at all');
  };
};

get '/chess' => sub { shift->render_text('checkmate'); };
get '/bye'   => sub { shift->render_text('Bye!', status => 401); };

app->start;

Implementation of Pascal's Triangle with Perl and Moose

Probably not the best way to do it, but I thought I would give it a hack:

#!/usr/bin/perl

package Row;

use Moose;

has triangle => (
    is  => 'ro',
    isa => 'Triangle',
);

has prev => (
    is        => 'ro',
    isa       => 'Row',
);

has members => (
    is         => 'rw',
    isa        => 'ArrayRef[Int]',
    lazy_build => 1,
);

sub _build_members {
    my $self = shift;
    
    return [1] unless $self->prev;
    
    my @prev = @{ $self->prev->members };
    
    my @values = (1);
    
    for(my $i = 0; $i < ( scalar(@prev) - 1 ); $i++) {
        my $c = $prev[ $i ];
        my $n = $prev[ $i + 1 ] || 1;
        
        push @values, $c + $n;
    }
    
    push @values, 1;
    
    return \@values;
}

sub print {
    my $self = shift;
    print join ' ', @{ $self->members },"\n";
    return $self;
}

__PACKAGE__->meta->make_immutable;

no Moose;

package Triangle;

use Moose;

has rows => (
    is      => 'rw',
    isa     => 'ArrayRef[Row]',
    default => sub { [ Row->new({}) ] },
);

sub first {
    my $self = shift;
    return $self->rows->[0];
}

sub last {
    my $self = shift;
    return $self->rows->[ $#{ $self->rows } ];
}

sub next {
    my $self = shift;
    my $row = Row->new( prev => $self->last );
    push @{ $self->rows }, $row;
    return $self->last;
}

__PACKAGE__->meta->make_immutable;

package main;

die "Usage: $0 \n"
    unless $ARGV[0] > 1;
    
    
my $t = Triangle->new;

$t->next->prev->print foreach(1..$ARGV[0]);

Some more C musings

Still working on getting my C mojo back both for school and for a application project. Here is an example of some (attempting to be overrun safe) dynamic memory alocation:

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>


char *speak ( char *bs, unsigned int counter ) {
	char *str    = "Hello %d: %s";

	size_t bs_l  = strlen( bs );
	size_t str_l = strlen( str ) - 2;
	size_t c_l   = counter == 0? 1 : log(counter) / log(10) + 1;
	size_t alloc = str_l + c_l + bs_l;

	char *ptr    = malloc( alloc );
	int written  = snprintf( ptr, alloc, str, counter, bs );

	printf( "(%zd + %zd + %zd) = %zd <> %i: ", str_l, c_l, bs_l, alloc, written );

	return ptr;
}

int main ( void ) {

	unsigned int c;

	for( c = 0; c == c; c = c + 5 ) {
		char *foo = speak("Have a nice day!", c);
		printf("%s\r", foo);
		free( foo );
	} 

	exit(0);
}

Example of libxslt transform from a libcurl fetch

I've written various programs/network services that perform this function for one purpose or another. In light of some performance needs of one of these services I've been considering porting it from Perl to C in order to get the most performance possible. Being as I haven't written anything in C in a very long time I thought I would implement one aspect of the service as a simple command line tool.

This is the result:

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include <curl/curl.h>

#include <libxml/xmlmemory.h>

#include <libxslt/xslt.h>
#include <libxslt/xsltInternals.h>
#include <libxslt/transform.h>
#include <libxslt/xsltutils.h>

struct fetch {
	char *buffer;
	size_t size;
};

static size_t write_fetch ( void *chunk, size_t size, size_t nmemb, void *data ) {
	size_t realsize = size * nmemb;
	struct fetch *f = (struct fetch *)data;
	
	f->buffer = realloc( f->buffer, f->size + realsize + 1 );
	
	if ( f->buffer == NULL ) {
		fprintf( stderr, "Out of memory (realloc returned NULL)\n" );
		exit( EXIT_FAILURE );
	}

	memcpy( &( f->buffer[ f->size ] ), chunk, realsize );
	f->size += realsize;
	f->buffer[ f->size ] = 0;

	return realsize;
}

CURLcode get_curl_xml ( char *url, void *chunk ) {
	CURL *curl;
	CURLcode result;

	if ( curl = curl_easy_init() ) {
		curl_easy_setopt( curl, CURLOPT_URL, url );
		curl_easy_setopt( curl, CURLOPT_WRITEFUNCTION, write_fetch );
		curl_easy_setopt( curl, CURLOPT_WRITEDATA, chunk );

		if ( ( result = curl_easy_perform( curl ) ) != 0 ) {
			fprintf( stderr, "Error %i: %s\n", result, curl_easy_strerror( result ) );
			return result;	
		}
		
		curl_easy_cleanup( curl );
	} else {
		return -1;
	}

}

int main (int argc, char *argv[]) {

	struct fetch data;
	xsltStylesheetPtr xslt = NULL;
	xmlDocPtr source, normalized;
	
	data.buffer = malloc( 1 );
	data.size   = 0;

	if ( argc < 2 ) {
		fprintf( stderr, "Usage: %s <stylesheet> <url>\n", argv[0] );
		return 0;
	}


	get_curl_xml( argv[2], (void *)&data );

	fprintf( stderr, "Fetched %lu bytes\n", (long)data.size);
	fprintf( stderr, "Buffer size %lu\n", sizeof( data.buffer ) );

	if ( source = xmlReadMemory( data.buffer, data.size, "memory.xml", NULL, 0 ) ) {
		xslt       = xsltParseStylesheetFile( (const xmlChar *)argv[1] );
		normalized = xsltApplyStylesheet( xslt, source, NULL );
		
		fprintf( stderr, "Normlized XML data\n" );

		xmlSaveFile( "-", normalized );

	} else {
		fprintf( stderr, "Failed to parse XML document\n" );
	}

	xmlFreeDoc( source );
	xmlFreeDoc( normalized );
	xmlCleanupParser();

	free( data.buffer );

	return 0;
}

Send prowl notifications upon Irssi highlight.

Here is a script I wrote using WebService::Prowl to send prowl notifications when someone highlights my nickname in any of the channels I'm in when using Irssi.