Saturday, September 24, 2011

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.

Friday, September 23, 2011

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;


Friday, September 9, 2011

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]);

Wednesday, August 31, 2011

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);
}

Wednesday, August 24, 2011

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;
}

Sunday, May 29, 2011

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.


Friday, October 22, 2010

Do admins and savvy programmers not remember how to use the shell?

I stumbled upon this blog page when googling info on how to use meld as a git diff tool.


In short he says you do this if you want to use meld as your diff tool for git:

My response: are you kidding me? Did you never think, "Hmm, I wonder if the shell I use every day for executing commands would be good for..." wait for it, "Executing a command!".


Maybe this is better instead of writing a whole python script to swap command line arguments around:

If you are using git I'm assuming you are a developer or an administrator on some level. And, if you are using meld I'm also going to assume that using a variant of UNIX; which means, that the first and most powerful tool you have at your disposal is your shell. So really guys, stop thinking that you absolutely must use an interpreted scripting language for everything and just start thinking. Because honestly if I put this on a qualification test to see if I would hire you and you used a python script to modify the argument order of a system call: I wouldn't hire you.