MooseX::YAML - DWIM loading of Moose objects from YAML


MooseX-YAML documentation Contained in the MooseX-YAML distribution.

Index


Code Index:

NAME

Top

MooseX::YAML - DWIM loading of Moose objects from YAML

SYNOPSIS

Top

	# given some class:

	package My::Module;
	use Moose;

	has package => (
		is => "ro",
		init_arg => "name",
	);

	has version => (
		is  => "rw",
		init_arg => undef,
	);

	sub BUILD { shift->version(3) }







	# load an object like so:	

	use MooseX::YAML qw(Load -xs);

	my $obj = Load(<<'YAML');
	--- !My::Module # this syntax requires YAML::XS
	name: "MooseX::YAML"
	YAML

	$obj->package; # "MooseX::YAML"
	$obj->version; # 3, BUILD was called

DESCRIPTION

Top

This module provides DWIM loading of Moose based objects from YAML documents.

Any hashes blessed into a Moose class will be replaced with a properly constructed instance (respecting init args, BUILDALL, and the meta instance type).

This is similar to YAML::Active in that certain nodes in the loaded YAML documented are treated specially.

EXPORTS

Top

All exports are setup by Sub::Exporter using currying.

-xs, -syck or -pp can be specified to specify YAML::XS, YAML::Syck or YAML on a per import basis.

If no driver is explicitly chosen YAML::XS will be tried first, falling back to YAML.

Load
LoadFile

VERSION CONTROL

Top

This module is maintained using Darcs. You can get the latest version from http://nothingmuch.woobling.org/code, and use darcs send to commit changes.

AUTHOR

Top

Yuval Kogman <nothingmuch@woobling.org>

COPYRIGHT

Top


MooseX-YAML documentation Contained in the MooseX-YAML distribution.

#!/usr/bin/perl

package MooseX::YAML;

use strict;
use warnings;

our $VERSION = "0.04";

use Carp qw(croak);

use MooseX::Blessed::Reconstruct;

my $v;
sub fixup { ($v ||= MooseX::Blessed::Reconstruct->new)->visit(@_) }

use namespace::clean;

use Sub::Exporter -setup => {
	exports => [qw(Load LoadFile)],
	collectors => [ "-xs", "-syck", "-pp" ],
	generator => sub {
		foreach my $export ( @_ ) {
			my $r = $export->{class}->_resolve($export->{name}, $export->{col});
			return sub { fixup( $r->(@_) ) };
		}
	},
};

sub _resolve {
	my ( $class, $routine, $flags ) = @_;

	if ( keys %$flags ) {
		croak "Can't use more than one of -xs, -syck or -pp" if keys %$flags > 1;

		if ( exists $flags->{-xs} ) {
			require YAML::XS;
			return YAML::XS->can($routine);
		} elsif ( exists $flags->{-syck} ) {
			require YAML::Syck;
			return YAML::Syck->can($routine);
		} else {
			require YAML;
			return YAML->can($routine);
		}
	} else {
		my $drv = (
			do { local $@; eval { require YAML::XS; "YAML::XS" } }
				or
			require YAML && "YAML"
		);
		
		return $drv->can($routine) || croak "Can't find a provided for $routine (fallback is $drv)";
	}
}

my $load;
sub Load {
    $load ||= __PACKAGE__->_resolve("Load");
    fixup( $load->(@_) );
}

my $loadfile;
sub LoadFile {
    $loadfile ||= __PACKAGE__->_resolve("LoadFile");
    fixup( $loadfile->(@_) );
}

__PACKAGE__

__END__