1 |
commit: f425f8c63cced5fcac32e7c7d1367b2655a93201 |
2 |
Author: Kent Fredric <kentfredric <AT> gmail <DOT> com> |
3 |
AuthorDate: Sun Feb 26 01:49:24 2012 +0000 |
4 |
Commit: Kent Fredric <kentfredric <AT> gmail <DOT> com> |
5 |
CommitDate: Sun Feb 26 02:26:00 2012 +0000 |
6 |
URL: http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=f425f8c6 |
7 |
|
8 |
[scripts/gen_ebuild.pl] Improve non-debug mode tracing, remove warning errors, show deps early, skip resolving recommended deps as we dont codify them at present anyway |
9 |
|
10 |
--- |
11 |
scripts/gen_ebuild.pl | 46 +++++++++++---- |
12 |
scripts/lib/dep/handler/stdout/simple.pm | 93 ++++++++++++++++++++++++++++++ |
13 |
2 files changed, 126 insertions(+), 13 deletions(-) |
14 |
|
15 |
diff --git a/scripts/gen_ebuild.pl b/scripts/gen_ebuild.pl |
16 |
index ab0dc2d..2d9d1e5 100755 |
17 |
--- a/scripts/gen_ebuild.pl |
18 |
+++ b/scripts/gen_ebuild.pl |
19 |
@@ -17,7 +17,7 @@ my $flags; |
20 |
my $singleflags; |
21 |
|
22 |
@ARGV = grep { defined } map { |
23 |
- $_ =~ /^--(\w+)/ |
24 |
+ $_ =~ /^--(.+)/ |
25 |
? do { $flags->{$1}++; undef } |
26 |
: do { |
27 |
$_ =~ /^-(\w+)/ |
28 |
@@ -26,6 +26,11 @@ my $singleflags; |
29 |
} |
30 |
} @ARGV; |
31 |
|
32 |
+for my $k ( keys %{$flags} ) { |
33 |
+ if ( $k =~ /^([^=]+)=(.*$)/ ) { |
34 |
+ $flags->{$1} = $2; |
35 |
+ } |
36 |
+} |
37 |
if ( $flags->{help} or $singleflags->{h} ) { print help(); exit 0; } |
38 |
|
39 |
# FILENAME: show_deptree.pl |
40 |
@@ -74,11 +79,22 @@ if ( not $release_info ) { |
41 |
die "Cannot find $release on MetaCPAN"; |
42 |
} |
43 |
my $dep_phases = deptools::get_dep_phases($release); |
44 |
+pp( $dep_phases->{phases} ); |
45 |
|
46 |
+#warn "Found $#{$dep_phases} phases"; |
47 |
my @queue; |
48 |
|
49 |
for my $module ( keys %{ $dep_phases->{modules} } ) { |
50 |
for my $declaration ( @{ $dep_phases->{modules}->{$module} } ) { |
51 |
+ if ( $declaration->[3] eq 'recommends' ) { |
52 |
+ warn "skipped dep on recommended module $module"; |
53 |
+ next; |
54 |
+ } |
55 |
+ if ( $declaration->[3] eq 'suggests' ) { |
56 |
+ warn "skipped dep on suggested module $module"; |
57 |
+ next; |
58 |
+ } |
59 |
+ |
60 |
push @queue, [ $module, $declaration ]; |
61 |
} |
62 |
} |
63 |
@@ -88,21 +104,25 @@ my @squeue = |
64 |
require dep::handler::bashcode; |
65 |
|
66 |
my $handler; |
67 |
+my $hc = 'dep::handler::stdout::simple'; |
68 |
|
69 |
-if ( defined $flags->{debug} and ( $flags->{debug} ne "1" or $flags->{debug} ne "2" ) ) { |
70 |
- $flags->{debug} = 1; |
71 |
+if ( defined $flags->{debug} ) { |
72 |
+ if ( $flags->{debug} eq "1" ) { |
73 |
+ $hc = 'dep::handler::stdout::terse'; |
74 |
+ } |
75 |
+ elsif ( $flags->{debug} eq "2" ) { |
76 |
+ $hc = 'dep::handler::stdout'; |
77 |
+ } |
78 |
+ else { |
79 |
+ $hc = 'dep::handler::stdout::terse'; |
80 |
+ } |
81 |
} |
82 |
|
83 |
-if ( $flags->{debug} == 1 ) { |
84 |
- require dep::handler::stdout::terse; |
85 |
- $handler = dep::handler::stdout::terse->new(); |
86 |
-} |
87 |
-if ( $flags->{debug} == 2 ) { |
88 |
- require dep::handler::stdout; |
89 |
- $handler = dep::handler::stdout->new(); |
90 |
-} |
91 |
+require Class::Load; |
92 |
+Class::Load::load_class($hc); |
93 |
+$handler = $hc->new(); |
94 |
|
95 |
-my $handler2 = dep::handler::bashcode->new( ( $flags->{debug} ? ( debug => 1 ) : () ), debug_handler => $handler, ); |
96 |
+my $handler2 = dep::handler::bashcode->new( debug => 1, debug_handler => $handler, ); |
97 |
|
98 |
for my $qi (@squeue) { |
99 |
deptools::dispatch_dependency_handler( $release, @{$qi}, $handler2 ); |
100 |
@@ -136,7 +156,7 @@ if ( not defined $release_info->{abstract} ) { |
101 |
} |
102 |
else { |
103 |
my $abstract = $release_info->{abstract}; |
104 |
- $abstract =~ s/'/'\\''/g; # ' => '\'' |
105 |
+ $abstract =~ s/'/'\\''/g; # ' => '\'' |
106 |
$fh->say( 'DESCRIPTION=\'' . $abstract . '\'' ); |
107 |
} |
108 |
|
109 |
|
110 |
diff --git a/scripts/lib/dep/handler/stdout/simple.pm b/scripts/lib/dep/handler/stdout/simple.pm |
111 |
new file mode 100644 |
112 |
index 0000000..ab55b86 |
113 |
--- /dev/null |
114 |
+++ b/scripts/lib/dep/handler/stdout/simple.pm |
115 |
@@ -0,0 +1,93 @@ |
116 |
+use strict; |
117 |
+use warnings; |
118 |
+ |
119 |
+package dep::handler::stdout::simple; |
120 |
+ |
121 |
+# FILENAME: simple.pm |
122 |
+# CREATED: 31/10/11 13:30:29 by Kent Fredric (kentnl) <kentfredric@×××××.com> |
123 |
+# ABSTRACT: Dispatch terse dependency information to STDOUT. |
124 |
+ |
125 |
+use Moose; |
126 |
+#extends 'dep::handler::stdout::terse'; |
127 |
+has 'indent' => ( is => 'rw' ); |
128 |
+has 'tail' => ( is => 'rw' ); |
129 |
+__PACKAGE__->meta->make_immutable; |
130 |
+ |
131 |
+sub begin_dep { |
132 |
+ my ( $self, $release, $module, $declaration ) = @_; |
133 |
+ return *STDOUT->print("\n\n" . $self->_want_string( $release, $module, $declaration ) . "\n"); |
134 |
+} |
135 |
+ |
136 |
+sub evt_not_any { |
137 |
+ my ( $self, $module, $declaration ) = @_; |
138 |
+ return *STDOUT->print(" No provider found for $module : @$declaration\n"); |
139 |
+} |
140 |
+ |
141 |
+sub evt_multi { |
142 |
+ my ( $self, $module, $declaration ) = @_; |
143 |
+ return *STDOUT->print(" Multiple Providers found for " . $self->_want_string( "", $module, $declaration) . "\n"); |
144 |
+} |
145 |
+ |
146 |
+sub set_latest { |
147 |
+ my ( $self, $dep, $pkg ) = @_; |
148 |
+ return *STDOUT->print(" Latest: @{$dep} => ${pkg}\n"); |
149 |
+} |
150 |
+ |
151 |
+sub _want_string { |
152 |
+ my ( $self, $release, $module, $declaration ) = @_; |
153 |
+ return $release . " -> " . $declaration->[2] . " " . $declaration->[3] . " -> " . $self->_depstring( $module, $declaration ); |
154 |
+} |
155 |
+ |
156 |
+sub _depstring { |
157 |
+ my ( $self, $module, $declaration ) = @_; |
158 |
+ |
159 |
+ my $depstring = $module; |
160 |
+ |
161 |
+ if ( $declaration->[1] ne '0.0.0' ) { |
162 |
+ $depstring .= " " . $declaration->[0] . " ( " . $declaration->[1] . " ) "; |
163 |
+ } |
164 |
+ return $depstring; |
165 |
+} |
166 |
+ |
167 |
+sub _xwrap { |
168 |
+ my $self = shift; |
169 |
+ require Text::Wrap; |
170 |
+ local $Text::Wrap::break = qr/,/; |
171 |
+ local $Text::Wrap::overflow = 'huge'; |
172 |
+ local $Text::Wrap::columns = 128; |
173 |
+ $Text::Wrap::overflow = 'huge'; |
174 |
+ my $pre = " "; |
175 |
+ my $lines = Text::Wrap::wrap( $pre, $pre, @_ ); |
176 |
+ return $lines; |
177 |
+} |
178 |
+sub perl_dep { |
179 |
+ my ( $self, $module, $declaration , $pkg ) = @_ ; |
180 |
+ *STDOUT->print(" -> $module : @{$declaration} via $pkg\n"); |
181 |
+} |
182 |
+sub provider_group { |
183 |
+ my ( $self, $data ) = @_; |
184 |
+ |
185 |
+ my $want_string = $self->_want_string( $data->{release}, $data->{module}, $data->{declaration} ); |
186 |
+ my $depstring = $self->_depstring( $data->{module}, $data->{declaration} ); |
187 |
+ |
188 |
+ *STDOUT->printf( " %s -> %s (%s)\n", $depstring, $data->{provider}, $data->{gentoo_pkg} ); |
189 |
+ #*STDOUT->printf( "%s newest: %s\e[0m\n", $self->indent, $data->{newest} ); |
190 |
+ #*STDOUT->printf( "%s oldest: %s\e[0m\n", $self->indent, $data->{oldest} ); |
191 |
+ |
192 |
+ my $v = $data->{closest}; |
193 |
+ if ( not $data->{has_closest} ) { $v = 'undef' } |
194 |
+ |
195 |
+ *STDOUT->print( " closest: $v\n" ); |
196 |
+ |
197 |
+ |
198 |
+} |
199 |
+ |
200 |
+sub done { |
201 |
+ my ( $self, $module, $declaration ) = @_; |
202 |
+ return *STDOUT->print( $self->tail ); |
203 |
+} |
204 |
+ |
205 |
+no Moose; |
206 |
+__PACKAGE__->meta->make_immutable; |
207 |
+1; |
208 |
+ |