lib/MooseX/Storage.pm

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