lib/MooseX/Storage.pm

   1
   2 package MooseX::Storage;
   3 use Moose qw(confess);
   4
   5 sub import {
   6     my $pkg = caller();
   7
   8     return if $pkg eq 'main';
   9
  10     ($pkg->can('meta'))
  11         || confess "This package can only be used in Moose based classes";
  12
  13     $pkg->meta->alias_method('Storage' => sub {
  14         my %params = @_;
  15
  16         $params{'base'} ||= 'Basic';
  17
  18         my @roles = (
  19             ('MooseX::Storage::' . $params{'base'}),
  20         );
  21
  22         # NOTE:
  23         # you don't have to have a format
  24         # role, this just means you dont
  25         # get anything other than pack/unpack
  26         push @roles => 'MooseX::Storage::Format::' . $params{'format'}
  27             if exists $params{'format'};
  28
  29         # NOTE:
  30         # if you do choose an IO role, then
  31         # you *must* have a format role chosen
  32         # since load/store require freeze/thaw
  33         if (exists $params{'io'}) {
  34             (exists $params{'format'})
  35                 || confess "You must specify a format role in order to use an IO role";
  36             push @roles => 'MooseX::Storage::IO::' . $params{'io'};
  37         }
  38
  39         Class::MOP::load_class($_)
  40             || die "Could not load role (" . $_ . ") for package ($pkg)"
  41                 foreach @roles;
  42
  43         return @roles;
  44     });
  45 }
  46
  47 1;
  48
  49 __END__
  50
  51 =pod
  52
  53 =head1 NAME
  54
  55 MooseX::Storage - A persistence framework for Moose classes
  56
  57 =head1 SYNOPSIS
  58
  59 =head1 DESCRIPTION
  60
  61 =head1 METHODS
  62
  63 =over 4
  64
  65 =item B<import>
  66
  67 =back
  68
  69 =head2 Introspection
  70
  71 =over 4
  72
  73 =item B<meta>
  74
  75 =back
  76
  77 =head1 BUGS
  78
  79 All complex software has bugs lurking in it, and this module is no
  80 exception. If you find a bug please either email me, or add the bug
  81 to cpan-RT.
  82
  83 =head1 AUTHOR
  84
  85 Chris Prather E<lt>chris.prather@iinteractive.comE<gt>
  86
  87 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
  88
  89 =head1 COPYRIGHT AND LICENSE
  90
  91 Copyright 2007 by Infinity Interactive, Inc.
  92
  93 L<http://www.iinteractive.com>
  94
  95 This library is free software; you can redistribute it and/or modify
  96 it under the same terms as Perl itself.
  97
  98 =cut