Commit | Line | Data |
e59193fb |
1 | |
e59193fb |
2 | package MooseX::Storage; |
ec9c1923 |
3 | use Moose qw(confess); |
e59193fb |
4 | |
5 | sub import { |
6 | my $pkg = caller(); |
ec9c1923 |
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 | |
e59193fb |
13 | $pkg->meta->alias_method('Storage' => sub { |
4d1850a6 |
14 | my %params = @_; |
15 | |
ec9c1923 |
16 | $params{'base'} ||= 'Basic'; |
17 | |
4d1850a6 |
18 | my @roles = ( |
ec9c1923 |
19 | ('MooseX::Storage::' . $params{'base'}), |
4d1850a6 |
20 | ); |
21 | |
ec9c1923 |
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 |
4d1850a6 |
33 | if (exists $params{'io'}) { |
ec9c1923 |
34 | (exists $params{'format'}) |
35 | || confess "You must specify a format role in order to use an IO role"; |
4d1850a6 |
36 | push @roles => 'MooseX::Storage::IO::' . $params{'io'}; |
4d1850a6 |
37 | } |
38 | |
ec9c1923 |
39 | Class::MOP::load_class($_) |
40 | || die "Could not load role (" . $_ . ") for package ($pkg)" |
41 | foreach @roles; |
42 | |
4d1850a6 |
43 | return @roles; |
e59193fb |
44 | }); |
45 | } |
46 | |
ec9c1923 |
47 | 1; |
e59193fb |
48 | |
ec9c1923 |
49 | __END__ |
e59193fb |
50 | |
ec9c1923 |
51 | =pod |
e59193fb |
52 | |
ec9c1923 |
53 | =head1 NAME |
e9739624 |
54 | |
ec9c1923 |
55 | MooseX::Storage - A persistence framework for Moose classes |
e59193fb |
56 | |
ec9c1923 |
57 | =head1 SYNOPSIS |
e9739624 |
58 | |
ec9c1923 |
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. |
e9739624 |
97 | |
98 | =cut |