Implement strict constructors, which will warn unkown constructor arguments
[gitmo/Mouse.git] / tool / generate-mouse-tiny.pl
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use File::Find;
5 use Fatal qw(open close);
6 #use File::Slurp 'slurp';
7 #use List::MoreUtils 'uniq';
8 #use autodie;
9
10 print "Generate Mouse::Tiny ...\n";
11
12 sub slurp {
13     open my $in, '<', $_[0];
14     local $/;
15     return scalar <$in>;
16 }
17 sub uniq{
18     my %seen;
19     return grep{ !$seen{$_}++ } @_;
20 }
21
22 require 'lib/Mouse/Spec.pm';
23
24 my $MouseTinyFile = shift || 'lib/Mouse/Tiny.pm';
25
26 my @files;
27
28 find({
29     wanted => sub {
30         push @files, $_
31             if -f $_
32             &&  /\.pm$/
33             && !/Squirrel/
34             && !/Tiny/
35             && !/Test/         # only for testing
36             && !/Spec/         # has no functionality
37             && !/TypeRegistry/ # deprecated
38             && !/\bouse/       # ouse.pm
39     },
40     no_chdir => 1,
41 }, 'lib');
42
43 my $mouse_tiny = '';
44
45 for my $file (uniq
46         'lib/Mouse/PurePerl.pm',
47         'lib/Mouse/Exporter.pm',
48         'lib/Mouse/Util.pm',
49         'lib/Mouse/Meta/TypeConstraint.pm',
50         'lib/Mouse/Util/TypeConstraints.pm',
51             sort @files) {
52
53     my $contents = slurp $file;
54
55     $contents =~ s/__END__\b.*//s;          # remove documentation
56     $contents =~ s/1;\n*$//;                # remove success indicator
57
58     $contents =~ s{^( (?:[ ]{4})+ )}{ "\t" x (length($1) / 4) }xmsge; # spaces to tabs
59
60     $mouse_tiny .= "BEGIN{ # $file\n";
61     $mouse_tiny .= $contents;
62     $mouse_tiny .= "}\n";
63 }
64
65 open my $handle, ">$MouseTinyFile";
66
67 print { $handle } << "EOF";
68 # This file was generated by $0 from Mouse $Mouse::Spec::VERSION.
69 #
70 # ANY CHANGES MADE HERE WILL BE LOST!
71
72 EOF
73
74 print { $handle } << 'EOF';
75 # if regular Mouse is loaded, bail out
76 unless ($INC{'Mouse.pm'}) {
77 # tell Perl we already have all of the Mouse files loaded:
78 EOF
79
80 for my $file (@files) {
81     (my $inc = $file) =~ s{^lib/}{};
82     printf { $handle } "%-45s = __FILE__;\n", "\$INC{'$inc'}";
83 }
84
85 print { $handle } << 'EOF';
86 eval sprintf("#line %d %s\n", __LINE__, __FILE__) . <<'END_OF_TINY';
87 EOF
88
89 print { $handle } "\n# and now their contents\n\n";
90
91 print { $handle } $mouse_tiny;
92
93 print { $handle } << 'EOF';
94 END_OF_TINY
95     die $@ if $@;
96 } # unless Mouse.pm is loaded
97 EOF
98
99 print { $handle } << "EOF";
100 package Mouse::Tiny;
101
102 our \$VERSION = '$Mouse::Spec::VERSION';
103
104 Mouse::Exporter->setup_import_methods(also => 'Mouse');
105
106 1;
107 EOF
108
109 close $handle;
110
111 print "done.\n";