Commit | Line | Data |
ba87bd32 |
1 | #line 1 "inc/Module/Install/Metadata.pm - /Library/Perl/5.8.1/Module/Install/Metadata.pm" |
2 | # $File: //depot/cpan/Module-Install/lib/Module/Install/Metadata.pm $ $Author: autrijus $ |
3 | # $Revision: #32 $ $Change: 1885 $ $DateTime: 2004/03/11 05:55:27 $ vim: expandtab shiftwidth=4 |
4 | |
5 | package Module::Install::Metadata; |
6 | use Module::Install::Base; @ISA = qw(Module::Install::Base); |
7 | |
8 | $VERSION = '0.04'; |
9 | |
10 | use strict 'vars'; |
11 | use vars qw($VERSION); |
12 | |
13 | sub Meta { shift } |
14 | |
15 | my @scalar_keys = qw( |
16 | name module_name version abstract author license |
17 | distribution_type sign perl_version |
18 | ); |
19 | my @tuple_keys = qw(build_requires requires recommends bundles); |
20 | |
21 | foreach my $key (@scalar_keys) { |
22 | *$key = sub { |
23 | my $self = shift; |
24 | return $self->{'values'}{$key} unless @_; |
25 | $self->{'values'}{$key} = shift; |
26 | return $self; |
27 | }; |
28 | } |
29 | |
30 | foreach my $key (@tuple_keys) { |
31 | *$key = sub { |
32 | my $self = shift; |
33 | return $self->{'values'}{$key} unless @_; |
34 | my @rv; |
35 | while (@_) { |
36 | my $module = shift or last; |
37 | my $version = shift || 0; |
38 | if ($module eq 'perl') { |
39 | $version =~ s{^(\d+)\.(\d+)\.(\d+)} |
40 | {$1 + $2/1_000 + $3/1_000_000}e; |
41 | $self->perl_version($version); |
42 | next; |
43 | } |
44 | my $rv = [$module, $version]; |
45 | push @{$self->{'values'}{$key}}, $rv; |
46 | push @rv, $rv; |
47 | } |
48 | return @rv; |
49 | }; |
50 | } |
51 | |
52 | sub features { |
53 | my $self = shift; |
54 | while (my ($name, $mods) = splice(@_, 0, 2)) { |
55 | my $count = 0; |
56 | push @{$self->{'values'}{'features'}}, ($name => [ |
57 | map { (++$count % 2 and ref($_) and ($count += $#$_)) ? @$_ : $_ } @$mods |
58 | ] ); |
59 | } |
60 | return @{$self->{'values'}{'features'}}; |
61 | } |
62 | |
63 | sub no_index { |
64 | my $self = shift; |
65 | my $type = shift; |
66 | push @{$self->{'values'}{'no_index'}{$type}}, @_ if $type; |
67 | return $self->{'values'}{'no_index'}; |
68 | } |
69 | |
70 | sub _dump { |
71 | my $self = shift; |
72 | my $package = ref($self->_top); |
73 | my $version = $self->_top->VERSION; |
74 | my %values = %{$self->{'values'}}; |
75 | |
76 | delete $values{sign}; |
77 | if (my $perl_version = delete $values{perl_version}) { |
78 | # Always canonical to three-dot version |
79 | $perl_version =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2), int($3))}e |
80 | if $perl_version >= 5.006; |
81 | $values{requires} = [ |
82 | [perl => $perl_version], |
83 | @{$values{requires}||[]}, |
84 | ]; |
85 | } |
86 | |
87 | warn "No license specified, setting license = 'unknown'\n" |
88 | unless $values{license}; |
89 | |
90 | $values{license} ||= 'unknown'; |
91 | $values{distribution_type} ||= 'module'; |
92 | $values{name} ||= do { |
93 | my $name = $values{module_name}; |
94 | $name =~ s/::/-/g; |
95 | $name; |
96 | } if $values{module_name}; |
97 | |
98 | if ($values{name} =~ /::/) { |
99 | my $name = $values{name}; |
100 | $name =~ s/::/-/g; |
101 | die "Error in name(): '$values{name}' should be '$name'!\n"; |
102 | } |
103 | |
104 | my $dump = ''; |
105 | foreach my $key (@scalar_keys) { |
106 | $dump .= "$key: $values{$key}\n" if exists $values{$key}; |
107 | } |
108 | foreach my $key (@tuple_keys) { |
109 | next unless exists $values{$key}; |
110 | $dump .= "$key:\n"; |
111 | foreach (@{$values{$key}}) { |
112 | $dump .= " $_->[0]: $_->[1]\n"; |
113 | } |
114 | } |
115 | |
116 | if (my $no_index = $values{no_index}) { |
117 | push @{$no_index->{'directory'}}, 'inc'; |
118 | require YAML; |
119 | local $YAML::UseHeader = 0; |
120 | $dump .= YAML::Dump({ no_index => $no_index}); |
121 | } |
122 | else { |
123 | $dump .= << "META"; |
124 | no_index: |
125 | directory: |
126 | - inc |
127 | META |
128 | } |
129 | |
130 | $dump .= "generated_by: $package version $version\n"; |
131 | return $dump; |
132 | } |
133 | |
134 | sub read { |
135 | my $self = shift; |
136 | $self->include_deps( 'YAML', 0 ); |
137 | require YAML; |
138 | my $data = YAML::LoadFile( 'META.yml' ); |
139 | # Call methods explicitly in case user has already set some values. |
140 | while ( my ($key, $value) = each %$data ) { |
141 | next unless $self->can( $key ); |
142 | if (ref $value eq 'HASH') { |
143 | while (my ($module, $version) = each %$value) { |
144 | $self->$key( $module => $version ); |
145 | } |
146 | } |
147 | else { |
148 | $self->$key( $value ); |
149 | } |
150 | } |
151 | return $self; |
152 | } |
153 | |
154 | sub write { |
155 | my $self = shift; |
156 | return $self unless $self->is_admin; |
157 | |
158 | META_NOT_OURS: { |
159 | local *FH; |
160 | if (open FH, "META.yml") { |
161 | while (<FH>) { |
162 | last META_NOT_OURS if /^generated_by: Module::Install\b/; |
163 | } |
164 | return $self if -s FH; |
165 | } |
166 | } |
167 | |
168 | warn "Writing META.yml\n"; |
169 | open META, "> META.yml" or warn "Cannot write to META.yml: $!"; |
170 | print META $self->_dump; |
171 | close META; |
172 | return $self; |
173 | } |
174 | |
175 | sub version_from { |
176 | my ($self, $version_from) = @_; |
177 | require ExtUtils::MM_Unix; |
178 | $self->version(ExtUtils::MM_Unix->parse_version($version_from)); |
179 | } |
180 | |
181 | sub abstract_from { |
182 | my ($self, $abstract_from) = @_; |
183 | require ExtUtils::MM_Unix; |
184 | $self->abstract( |
185 | bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix') |
186 | ->parse_abstract($abstract_from) |
187 | ); |
188 | } |
189 | |
190 | 1; |