lib/Mouse.pm

   1 #!perl
   2 package Mouse;
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.01';
   7
   8 use Sub::Exporter;
   9 use Carp 'confess';
  10 use Scalar::Util 'blessed';
  11
  12 use Mouse::Attribute;
  13 use Mouse::Class;
  14 use Mouse::Object;
  15
  16 do {
  17     my $CALLER;
  18
  19     my %exports = (
  20         meta => sub {
  21             my $meta = Mouse::Class->initialize($CALLER);
  22             return sub { $meta };
  23         },
  24
  25         extends => sub {
  26             my $caller = $CALLER;
  27             return sub {
  28                 $caller->meta->superclasses(@_);
  29             };
  30         },
  31
  32         has => sub {
  33             return sub {
  34                 my $package = caller;
  35                 my $names = shift;
  36                 $names = [$names] if !ref($names);
  37
  38                 for my $name (@$names) {
  39                     Mouse::Attribute->create($package, $name, @_);
  40                 }
  41             };
  42         },
  43
  44         confess => sub {
  45             return \&Carp::confess;
  46         },
  47
  48         blessed => sub {
  49             return \&Scalar::Util::blessed;
  50         },
  51     );
  52
  53     my $exporter = Sub::Exporter::build_exporter({
  54         exports => \%exports,
  55         groups  => { default => [':all'] },
  56     });
  57
  58     sub import {
  59         $CALLER = caller;
  60
  61         strict->import;
  62         warnings->import;
  63
  64         no strict 'refs';
  65         @{ $CALLER . '::ISA' } = 'Mouse::Object';
  66
  67         goto $exporter;
  68     }
  69
  70     sub unimport {
  71         my $caller = caller;
  72
  73         no strict 'refs';
  74         for my $keyword (keys %exports) {
  75             next if $keyword eq 'meta'; # we don't delete this one
  76             delete ${ $caller . '::' }{$keyword};
  77         }
  78     }
  79 };
  80
  81 sub load_class {
  82     my $class = shift;
  83
  84     (my $file = "$class.pm") =~ s{::}{/}g;
  85
  86     eval { CORE::require($file) };
  87     confess "Could not load class ($class) because : $@"
  88         if $@
  89         && $@ !~ /^Can't locate .*? at /;
  90
  91     return 1;
  92 }
  93
  94 1;
  95
  96 __END__
  97
  98 =head1 NAME
  99
 100 Mouse - miniature Moose near the speed of light
 101
 102 =head1 VERSION
 103
 104 Version 0.01 released ???
 105
 106 =head1 SYNOPSIS
 107
 108     package Point;
 109     use Mouse;
 110
 111     has x => (
 112         is => 'rw',
 113     );
 114
 115     has y => (
 116         is        => 'rw',
 117         default   => 0,
 118         predicate => 'has_y',
 119         clearer   => 'clear_y',
 120     );
 121
 122 =head1 DESCRIPTION
 123
 124 Moose.
 125
 126 =head1 INTERFACE
 127
 128 =head2 meta -> Mouse::Class
 129
 130 Returns this class' metaclass instance.
 131
 132 =head2 extends superclasses
 133
 134 Sets this class' superclasses.
 135
 136 =head2 has (name|names) => parameters
 137
 138 Adds an attribute (or if passed an arrayref of names, multiple attributes) to
 139 this class.
 140
 141 =head2 confess error -> BOOM
 142
 143 L<Carp/confess> for your convenience.
 144
 145 =head2 blessed value -> ClassName | undef
 146
 147 L<Scalar::Util/blessed> for your convenience.
 148
 149 =head1 MISC
 150
 151 =head2 import
 152
 153 Importing Mouse will set your class' superclass list to L<Mouse::Object>.
 154 You may use L</extends> to replace the superclass list.
 155
 156 =head2 unimport
 157
 158 Please unimport Mouse so that if someone calls one of the keywords (such as
 159 L</extends>) it will break loudly instead breaking subtly.
 160
 161 =head1 FUNCTIONS
 162
 163 =head2 load_class Class::Name
 164
 165 This will load a given Class::Name> (or die if it's not loadable).
 166 This function can be used in place of tricks like
 167 C<eval "use $module"> or using C<require>.
 168
 169 =head1 AUTHOR
 170
 171 Shawn M Moore, C<< <sartak at gmail.com> >>
 172
 173 =head1 BUGS
 174
 175 No known bugs.
 176
 177 Please report any bugs through RT: email
 178 C<bug-mouse at rt.cpan.org>, or browse
 179 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mouse>.
 180
 181 =head1 COPYRIGHT AND LICENSE
 182
 183 Copyright 2008 Shawn M Moore.
 184
 185 This program is free software; you can redistribute it and/or modify it
 186 under the same terms as Perl itself.
 187
 188 =cut
 189