The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME

Handel::Manual::Cookbook::WritingCustomStorage - Step by Step example of writing a custom storage class.

DESCRIPTION

This document will cover the basic steps needed to write a custom storage class for Handel 1.0. For this exercise, we will write an XML storage class that will store a cart and its items in a single xml file with the ability to do wildcard searches just like our DBIC storage class. The new storage class could be used for order and order items as well.

Writing a custom storage class is just a matter of subclassing Handel::Storage and Handel::Storage::Result and implementing the methods necessary to create/delete/search carts and items as well as begin/commit/rollback transactions and update calls.

The example code below demonstrates how to write a custom storage class in Handel. While it covers the basic steps, it is by no means a complete implementation of all possible features, including things like column default values, parameter validation, etc. Those are left as an exercise for the reader to implement based on their particular situation and application needs.

GETTING STARTED

Create A Blank XML File

First, let's create the xml file we'll use to store shopping carts in:

    <?xml version="1.0"?>
    <carts/>

Save this as carts.xml in a location of your choosing. As we add to this file later, it will take on the following format:

    <?xml version="1.0"?>
    <carts>
        <cart id="1" shopper="1" name="My Cart">
            <item id="1" sku="ABC-123" quantity="1" price="1.23"/>
        </cart>
    </cart>

Create Storage and Storage Result Subclasses

First, lets create the basic modules for the new xml storage:

    package Handel::Storage::XML;
    use strict;
    use warnings;
    
    BEGIN {
        use base qw/Handel::Storage/;
    };
    
    __PACKAGE__->result_class('Handel::Storage::XML::Result');
    
    1;

and the xml storage results:

    package Handel::Storage::XML::Result;
    use strict;
    use warnings;
    
    BEGIN {
        use base qw/Handel::Storage::Result/;
    };
    
    1;

Pretty straight forward stuff so far. We've subclassed Handel::Storage and Handel::Storage::Result and told Storage::XML to use the XML::Result class for its results.

Setup Private Storage Mechanism

Next, in Storage::XML, we will load the necessary XML modules and find a place to store a parser object.

    BEGIN {
        use base qw/Handel::Storage/;
        use XML::LibXML;
        use XML::LibXML::XPathContext;
        
        # we use Class::Accessor::Grouped in this here town
        __PACKAGE__->mk_group_accessors('inherited', qw/parser/);
    };
    
    # create a default xml parser
    __PACKAGE__->parser(XML::LibXML->new);

We're going to use XML::LibXML as the parser and XML::LibXML::XPathContext for the wildcard XPath searches using a custom XPath function in perl.

Next we need to load our newly created carts xml document. For that, we'll need to specify the file name, load the xml document and set the document root. First, let's setup an option for storing a file name. It will be used later when we create a new instance of Storage::XML.

    BEGIN {
        use base qw/Handel::Storage/;
        use XML::LibXML;
        use XML::LibXML::XPathContext;
        use Handel::Exception qw/:try/;
        
        __PACKAGE__->mk_group_accessors('inherited', qw/parser file_name/);
    };
    
    __PACKAGE__->parser(XML::LibXML->new);

and setup a method to load and return the XML::Document object:

    sub document {
        my $self = shift;
    
        # if no document has been loaded, load it from file_name
        if (!$self->{'xmldoc'}) {
            $self->{'xmldoc'} = $self->parser->parse_file($self->file_name);
        };
    
        return $self->{'xmldoc'};
    };

Now that we can load the xml file, let's create a method to save it back to the original file.

    sub save_file {
        my $self = shift;
        $self->document->toFile($self->file_name);
    };

Next, we'll create a method to get the document root. Just for the sake of configurability, let's make a preference for the parent node and child node names. Those will be set later when we create a new instance of Storage::XML.

    BEGIN {
        use base qw/Handel::Storage/;
        use XML::LibXML;
        use XML::LibXML::XPathContext;
        
        __PACKAGE__->mk_group_accessors('inherited', qw/parser file_name parent_node child_node/);
    };
    
    __PACKAGE__->parser(XML::LibXML->new);
    
    sub document_root {
        my $self = shift;
    
        # if we havn't set root, do so
        if (!$self->{'xmldocroot'}) {
            my $root = XML::LibXML::XPathContext->new(
                $self->document->getDocumentElement
            );
    
            # register a new function in XPath
            $root->registerFunction('attr_matches', sub {
                my ($nodelist, $pattern) = @_;
                my $node = $nodelist->get_node(0);
    
                if ($node->getValue =~ /^$pattern$/i) {
                    return $node;
                };
    
                return;
            });
    
            $self->{'xmldocroot'} = $root;
        };
    
        return $self->{'xmldocroot'};
    };

If no document root is set, we create a new context object and register our wildcard matching function called 'attr_matches'. Now, anytime we write an XPath query, we can use that function:

    /carts[attr_match(@name, 'foo.*')]

Now that we can get XML results using wildcards, we need a method to convert our standard search filters into XPath attribute queries:

    sub filter_to_xpath {
        my ($self, $filter) = @_;
        my @attrs = map {
            my $value = $filter->{$_} || '';
            $value =~ s/'/"/g;
    
            # turn % into regex .* and do attr_match
            if ($value =~ s/%/.*/g) {
                "attr_matches(\@$_, '$value')";
            # just a straight compare thanks
            } else {
                "\@$_='$value'";
            };
        } keys %{$filter};
    
        return @attrs ? '[' . join(' and ', @attrs) . ']' : undef;
    };

The method above turns each hash key/value pair into XPath attribute match statements:

    print $self->filter_to_xpath({
        shopper => 1,
        name    => 'My%'
    });
    
    # prints [@shopper=1 and attr_match('@name', .*)]

We'll see later how to use that during search operations and in create operations to check if a cart exists before we create another one.

CART ACTIONS

Now that we have a rough framework for reading an xml document and matching wildcards using XPath, it's time to start adding methods to create/search/delete cart records from the xml file.

Create

To create a new cart record, we need to accept a hash full of data and write a new xml node if no node exists with the same primary key value.

    sub create {
        my ($self, $data) = @_;
        
        # turn the hash data into an xpath compare for the primary columns
        my %filter = map {$_ => $data->{$_}} $self->primary_columns;
        my $attributes = $self->filter_to_xpath(\%filter);
    
        # look for an existing cart and die if it exists
        if ($self->document_root->find($self->child_node . $attributes)) {
            throw Handel::Exception::Storage( -text => 'Cart already exists with that id');
        } else {
            # create a new cart node
            my $cart = $self->document->createElement($self->child_node);
    
            # set all of the attributes using the supplied data
            map {$cart->setAttribute($_ => $data->{$_})} keys %{$data};
    
            # using document instead of document_root due to issue w/ XPathContext
            # Can't locate auto/XML/LibXML/XPathContext/appendChild.al in @INC
            # $self->document_root->appendChild($cart);
            # may be my install
            #
            # append the new cart node to the document and save the changes
            $self->document->getDocumentElement->appendChild($cart);
            $self->save_file;
    
            # now return a new result object containing the new node
            return $self->result_class->create_instance($cart, $self);
        };
    };

Now that we can create a new xml node, it would be nice to be able to load it and other nodes. We need to search all nodes and create an iterator containing the results.

    sub search {
        my ($self, $filter) = @_;
    
        # turn the hash filter into an xpath attribute query
        my $attributes = $self->filter_to_xpath($filter);
    
        # find all cart nodes matching the query
        my @nodes = $self->document_root->findnodes($self->child_node . $attributes);
    
        # create an iterator of results
        my $iterator = $self->iterator_class->new({
            data         => \@nodes,
            result_class => $self->result_class,
            storage      => $self
        });
    
        # return the iterator in scalar, or all in list context
        return wantarray ? $iterator->all : $iterator;
    };

The default result iterator class in storage is Handel::Iterator::List. It simply takes an array reference, and iterates over the list contents.

Delete

Last but not least in this section, we need to be able to remove carts matching the specified filter. We could reuse search here, but for the sake of example, let's do the search again ourselves.

    sub delete {
        my ($self, $filter) = @_;
    
        # turn the hash filter into an xpath attribute query
        my $attributes = $self->filter_to_xpath($filter);
    
        # find all cart nodes matching the query
        my @nodes = $self->document_root->findnodes($self->child_node . $attributes);
    
        foreach my $node (@nodes) {
            $node->unbindNode;
        };
        $self->save_file;
    };

ITEM ACTIONS

Now that we can create, search and delete carts, we need to do the same thing for cart items. Now would be a good time to review "Items_As_Second_Class_Objects" in Handel::Manual::Storage. Since carts and their items reside in the same file, we shall consider items and the Item class used later as second class objects. They will hold configuration information about items, but will do none of the work and the same storage instance will take care of reading/writing cart and cart items.

Adding Items

To create a new item record, we simply need to make sure on item doesn't already exist with the supplied id, then create a new node, populate it and insert it into the cart nodes child node collection.

    sub add_item {
        my ($self, $result, $data) = @_;
        my $item_storage = $self->item_storage;
        
        # get the cart node
        my $cart = $result->storage_result;
        
        # convert the data into a primary key filter
        my %filter = map {$_ => $data->{$_}} $item_storage->primary_columns;
        my $attributes = $self->filter_to_xpath(\%filter);
    
        # see if there is already an item in this cart matching the id
        if ($cart->find($item_storage->child_node . $attributes)) {
            throw Handel::Exception::Storage( -text => 'Cart item already exists with that id');
        # create a new item node and insert it into the cart node
        } else {
            my $item = $self->document->createElement($item_storage->child_node);
            map {$item->setAttribute($_ => $data->{$_})} keys %{$data};
    
            $cart->appendChild($item);
            $self->save_file;
    
            return $item_storage->result_class->create_instance($item, $self);
        };
    };

Searching Items

Now that we can add cart items, we need to be able to fetch them later.

    sub search_items {
        my ($self, $result, $filter) = @_;
        my $item_storage = $self->item_storage;
        
        # get the cart node
        my $cart = $result->storage_result;
        
        # convert the filter to a xpath statement
        my $attributes = $self->filter_to_xpath($filter);
        
        # get items in this cart matching the xpath
        my @nodes = $self->document_root->findnodes($item_storage->child_node . $attributes, $cart);
    
        my $iterator = $self->iterator_class->new({
            data         => \@nodes,
            result_class => $item_storage->result_class,
            storage      => $self
        });
    
        return wantarray ? $iterator->all : $iterator;
    };

Just like the cart search, we just need to create an XPath query from the supplied filter, and return any found nodes wrapped in storage results.

Counting Items

To make Cart::count happy, we also need a way to count the number of items in a cart. Again, we could just use search_items and count the number of results, but this is more efficient.

    sub count_items {
        my ($self, $result) = @_;
        my $item_storage = $self->item_storage;
        my $cart = $result->storage_result;
    
        # find all ./item nodes in the current cart
        return $cart->find($item_storage->child_node)->size;
    };

Deleting Items

Last on the list again, we need to be able to delete items. This should look pretty familiar by now.

    sub delete_items {
        my ($self, $result, $filter) = @_;
        my $item_storage = $self->item_storage;
        
        # get the cart node
        my $cart = $result->storage_result;
        
        # make an xpath wquery from the filter if we have one
        my $attributes = $self->filter_to_xpath($filter);
        my @nodes = $self->document_root->findnodes($item_storage->child_node . $attributes, $cart);
    
        foreach my $node (@nodes) {
            $node->unbindNode;
        };
        $self->save_file;
    };

Transaction Support

Each custom storage class should strive to support transactions if possible. If it is not possible, you need to override the base classes methods to keep them from throwing 'not implemented' exceptions.

    sub txn_begin {};
    sub txn_rollback {};
    sub txn_commit {};
    sub discard_changes {};

STORAGE RESULTS

Mapping Methods to XML Attributes

Now that we have created the basic XML storage class, we need to create a results class that knows how to update individual xml nodes. The default Storage::Result class simply passes methods to the underlying storage result:

    $result->id;
    
    # the same as:
    $result->storage_result->id;

Since XML::Node objects only expose attributes using set/getAttribute, we need to write a custom AUTOLOAD method to redirect method calls.

    package Handel::Storage::XML::Result;
    use strict;
    use warnings;
    
    BEGIN {
        use base qw/Handel::Storage::Result/;
    };
    
    sub AUTOLOAD {
        my $self = shift;
    
        # leave DESTROY alone
        return if (our $AUTOLOAD) =~ /::DESTROY$/;
    
        $AUTOLOAD =~ s/^.*:://;
    
        return unless $self->storage->has_column($AUTOLOAD);
    
        # if we are setting, call setAttribute
        if (scalar @_) {
            $self->storage_result->setAttribute($AUTOLOAD, shift);
        };
    
        # return from getAttribute
        $self->storage_result->getAttribute($AUTOLOAD);
    };
    
    1;

This is the easiest way to make results and the underlying storage results talk to each other. Using this method, you can use the same result class for carts, order and cart/order items even if their fields differ.

If have a particular hatred for AUTOLOAD, you could just as well create two result classes: Handel::Storage::XML::Cart::Result and Handel::Storage::XML::Cart::Item::Result and assign them to the corresponding storage classes:

    package Handel::Storage::XML::Cart;
    use strict;
    use warnings;
    use base qw/Handel::Storage::XML/;
    __PACKAGE__->result_class('Handel::Storage::XML::Cart::Result');
    1;
    
    package Handel::Storage::XML::Cart::Item;
    use strict;
    use warnings;
    use base qw/Handel::Storage::XML/;
    __PACKAGE__->result_class('Handel::Storage::XML::Cart::Item::Result');
    1;

In each result class, you could map actual attributes to real methods instead of using autoload:

    package Handel::Storage::XML::Cart::Result;
    use strict
    use warnings;
    use base qw/Handel::Storage::Result/;
    
    sub id {
        my ($self, $value) = @_;
        
        if ($value) {
            $self->storage_result->setAttribute('id', $value);
        };
    
        return $self->storage_result->getAttribute('id');
    };

Updating Results

When autoupdates are off, one has to call update manually to save the changes made to cart and item nodes. When autoupdates are enabled, update will be called automatically on each result. To support updates we need to create an update method on the custom result class:

    sub update {
        my ($self, $data) = @_;
    
        if ($data) {
            foreach my $key (keys %{$data}) {
                $self->storage_result->setAttribute($key, $data->{$key});
            };
        };
    
        $self->storage->save_file;
    };

When update is called, the xml file is saved. If a hashref of data is supplied, it will set the appropriate attributes and then save the changes to the xml file.

Deleting Results

Each result needs to be able to remove itself from storage. To do so, we simply need to add a delete method to the result that removes itself and updates the file:

    sub delete {
        my $self = shift;
    
        $self->storage_result->unbindNode;
        $self->update;
    };

USING YOUR NEW STORAGE CLASS

Now that we have a shiny new XML storage class, we need to use it. There are two ways we can go about using our new storage class. The easiest way would be to load and configure them directly in the Cart and Item interface classes:

    package My::Cart;
    use strict;
    use warnings;
    use base qw/Handel::Cart/;
    __PACKAGE__->item_class('My::Cart::Item');
    __PACKAGE__->storage_class('Handel::Storage::XML');
    __PACKAGE__->storage({
        add_columns     => [qw/id shopper name description type/],
        primary_columns => [qw/id/],
        file_name       => 'carts.xml',
        parent_node     => 'carts',
        child_node      => 'cart',
    });
    
    1;

While this way works, it has one problem. If you decide to change storage classes later, it may not take the same options that this storage class does.

Create Cart and Item Storage Classes

In order to make changing storage classes less painful, it is recommended that you make subclasses of your custom storage class to set storage options, and then use those subclasses within your Cart and Item interface classes:

    package My::Storage::Cart;
    use strict;
    use warnings;
    use base qw/Handel::Storage::XML/;
    
    __PACKAGE__->item_storage_class('My::Storage::Cart::Item');
    
    __PACKAGE__->setup({
        file_name       => 'carts.xml',
        parent_node     => 'carts',
        child_node      => 'cart',
        add_columns     => [qw/id shopper name description type/],
        primary_columns => [qw/id/],
    });
    
    1;
    
    package My::Storage::Cart::Item;
    use strict;
    use warnings;
    use base qw/Handel::Storage::XML/;
    
    __PACKAGE__->setup({
        parent_node     => 'items',
        child_node      => 'item',
        add_columns     => [qw/id sku quantity price description/],
        primary_columns => [qw/id/]
    });
    
    1;

Create Cart and Item Classes

Now that we have custom storage subclasses for Carts and Items, we just need to tell our cart and item classes to use them:

    package My::Cart;
    use strict;
    use warnings;
    use base qw/Handel::Cart/;
    
    __PACKAGE__->item_class('My::Cart::Item');
    __PACKAGE__->storage_class('My::Storage::Cart');
    
    1;
    
    package My::Cart::Item;
    use strict;
    use warnings;
    use base qw/Handel::Cart::Item/;
    
    __PACKAGE__->storage_class('My::Storage::Cart::Item');
    
    1;

Now that we have some separation between the Cart/Items classes and the storage classes, changing storage classes in the future just means changing My::Storage::Cart and My::Storage::Cart::Item.

All Hands on Deck

That's all there is to it. Using the same techniques above, you should be able to write a custom storage class for just about anything; LDAP, INI files, SOAP/XMLRPC, etc.

CAVEATS

The example above is by no means complete. It makes no effort to deal with constraints, default values or data validation. It also does not make any attempt to support transactions in any meaningful way nor does it deal with concurrency issues with xml file reading and writing.

Given more time, I may work on making this example into a supported Storage::XML class.

AUTHOR

    Christopher H. Laco
    CPAN ID: CLACO
    claco@chrislaco.com
    http://today.icantfocus.com/blog/