Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 760 lines (577 sloc) 19.581 kb
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
1 #!/usr/bin/perl
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
2 #
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
3 # Copyright (C) 2004-2011, Parrot Foundation.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
4 #
07b9ece A bit of refactoring of the POD parser to integrate Parrot-specific form...
Michael Scott authored
5
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
6 eval 'exec perl -w -S $0 ${1+"$@"}'
b4edd15 @paultcochrane Using warnings properly now.
paultcochrane authored
7 if $running_under_some_shell;
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
8
4838fb6 - use strict is our friend
Jerome Quelin authored
9 use strict;
b4edd15 @paultcochrane Using warnings properly now.
paultcochrane authored
10 use warnings;
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
11
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
12 use Config;
13 use File::Spec;
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
14 use Getopt::Long;
15
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
16
895d5d5 @rurban [cage] enable spaces in $editor pathname. patch by bsdz on #parrot
rurban authored
17 my $VERSION = "1.0";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
18
514b65a - no need for storing updir
Jerome Quelin authored
19 my $parrotdir = File::Spec->curdir();
42d74f6 - version 0.3.1
Jerome Quelin authored
20 my ( %opts, %parrot, %report );
21 my ( $editor, $user, $domain, $msgid, $tmpfile );
514b65a - no need for storing updir
Jerome Quelin authored
22 my ( $is_linux, $is_macos, $is_mswin32, $is_os2, $is_vms );
c8be334 @ambs Added a bug category for 'languages'
ambs authored
23 my @categories = qw[ core docs install library utilities languages ];
42d74f6 - version 0.3.1
Jerome Quelin authored
24 my @severities = qw[ critical high medium low wishlist none ];
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
25
26
4b46d98 - guessing return address
Jerome Quelin authored
27 #------------------------------------------------------------#
28 # Main program. #
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
29
30 init();
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
31 help() if $opts{help};
32 version() if $opts{version};
42d74f6 - version 0.3.1
Jerome Quelin authored
33 explain_parrotbug() unless $opts{quiet};
34 query_missing_info();
35 what_next();
28c84ea - version 0.4.0
Jerome Quelin authored
36 unlink $tmpfile;
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
37 exit;
38
39
42d74f6 - version 0.3.1
Jerome Quelin authored
40
41 # Explain what C<parrotbug> is.
6861224 - version 0.0.2
Jerome Quelin authored
42 sub explain_parrotbug {
b22284e - version 0.4.1
Jerome Quelin authored
43 print <<EOT;
6861224 - version 0.0.2
Jerome Quelin authored
44
45 This program provides an easy way to create a message reporting a bug
30b79e6 small typo fix
Jens Rieks authored
46 in parrot, and e-mail it to the parrot developers.
6861224 - version 0.0.2
Jerome Quelin authored
47
48 It is *NOT* intended for:
49 - sending test messages,
3c1710d @Util Fix typos.
Util authored
50 - or reporting bugs in languages targeting parrot,
6861224 - version 0.0.2
Jerome Quelin authored
51 - or reporting bugs in some library bindings for parrot,
52 - or simply verifying that parrot works.
53
54 It is *ONLY* a mean of reporting verifiable problems with the core
55 parrot distribution, and any solutions to such problems, to parrot
d599b7a typo fixed
Jens Rieks authored
56 developers.
6861224 - version 0.0.2
Jerome Quelin authored
57
58 If you're just looking for help with parrot, subscribe to the parrot
66ddda2 @Infinoid [docs] Fix up old references to submitting/subscribing/archives for the ...
Infinoid authored
59 mailing list, parrot-dev<at>lists.parrot.org.
6861224 - version 0.0.2
Jerome Quelin authored
60
61
62
b22284e - version 0.4.1
Jerome Quelin authored
63 EOT
ab940f6 - reorganizing subs
Jerome Quelin authored
64 }
65
66
67
68
69 #------------------------------------------------------------#
70 # Utils subs. #
71
0627f54 Back out pod for subs
Michael Scott authored
72 # Generate random filename to edit report.
ab940f6 - reorganizing subs
Jerome Quelin authored
73 sub generate_filename {
74 my $dir = File::Spec->tmpdir();
75 my $filename = "bugrep0$$";
76 $filename++ while -e File::Spec->catfile($dir, $filename);
77 $filename = File::Spec->catfile($dir, $filename);
78 return $filename;
79 }
80
eed8bf2 - some pod =begin forgotten
Jerome Quelin authored
81
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
82 # Check whether a summary is trivial. A summary is not considered trivial
0627f54 Back out pod for subs
Michael Scott authored
83 # if it's an ok or a nok report.
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
84 # Return 1 if trivial, 0 otherwise (summary acceptable).
85 sub trivial_summary {
86 my $summary = shift;
ab940f6 - reorganizing subs
Jerome Quelin authored
87
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
88 return 0 if $opts{ok} || $opts{nok};
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
89 if ( $summary =~
ab940f6 - reorganizing subs
Jerome Quelin authored
90 /^(y(es)?|no?|help|parrot( (bug|problem))?|bug|problem)$/i ||
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
91 length($summary) < 4 ||
92 $summary !~ /\s/ ) {
ab940f6 - reorganizing subs
Jerome Quelin authored
93 return 1;
f09c81b @petdance uncuddling elses
petdance authored
94 }
95 else {
96 return 0;
ab940f6 - reorganizing subs
Jerome Quelin authored
97 }
98 }
99
100
101
102
103 #------------------------------------------------------------#
104 # Init subs. #
105
0627f54 Back out pod for subs
Michael Scott authored
106 # Initialize the program.
107 #
108 # Get parrot information, process the options, create the message
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
109 # information (summary, to, body, etc.) depending on the type of report
0627f54 Back out pod for subs
Michael Scott authored
110 # (ok, nok or bug report).
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
111 sub init {
112 $is_linux = lc($^O) eq 'linux';
514b65a - no need for storing updir
Jerome Quelin authored
113 $is_mswin32 = $^O eq 'MSWin32';
114 $is_os2 = $^O eq 'os2';
115 $is_vms = $^O eq 'VMS';
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
116
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
117 ##
118 ## Fetch Parrot information.
119 ##
120
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
121 # Get parrot version.
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
122 # There will always be an up-to-date $parrot/VERSION
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
123 my $filename = File::Spec->catfile($parrotdir, "VERSION");
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
124 open my $VERSION, '<', $filename or die "Cannot open '$filename': $!";
125 $parrot{version} = <$VERSION>;
42d74f6 - version 0.3.1
Jerome Quelin authored
126 chomp $parrot{version};
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
127 close $VERSION or die "Cannot close '$filename': $!";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
128
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
129 # Get parrot configuration, stored in $parrot/myconfig
130 $filename = File::Spec->catfile($parrotdir, "myconfig");
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
131 open my $MYCONFIG, '<', $filename or die "Cannot open '$filename': $!";
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
132 {
133 local $/;
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
134 $parrot{myconfig} = <$MYCONFIG>;
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
135 }
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
136 close $MYCONFIG or die "Cannot close '$filename': $!";
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
137
138
139 ##
140 ## Process options.
141 ##
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
142 Getopt::Long::Configure("no_bundling", "no_ignore_case", "auto_abbrev");
143 help() unless GetOptions
144 ( \%opts,
42d74f6 - version 0.3.1
Jerome Quelin authored
145 "help|h", "version|V",
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
146 "dump", "save",
42d74f6 - version 0.3.1
Jerome Quelin authored
147 "from|f=s", "to|test|t=s", "editor|e=s",
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
148 "summary|s=s", "category|C=s", "severity|S=s",
42d74f6 - version 0.3.1
Jerome Quelin authored
149 "input|input-file|i=s", "output|output-file|o=s",
150 "ok", "nok", "ack!", "quiet|q!" );
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
151
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
152 ##
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
153 ## Report to be sent.
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
154 ##
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
155 sw: {
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
156 ok_report: {
157 last ok_report unless defined $opts{ok};
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
158
159 # This is an ok report, woohoo!
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
160 $report{summary} = "OK: parrot $parrot{version} "
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
161 . "on $Config{archname} $Config{osvers}";
42d74f6 - version 0.3.1
Jerome Quelin authored
162 $report{body} = "Parrot reported to build OK on this system.\n";
163 $report{category} = "install";
164 $report{severity} = "none";
165 $report{body} = "";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
166 last sw;
167 };
168
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
169 # Ok reports do not need body, but nok and bug reports do need
42d74f6 - version 0.3.1
Jerome Quelin authored
170 # a body.
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
171 if ( $opts{input} ) {
42d74f6 - version 0.3.1
Jerome Quelin authored
172 # Report was pre-written, slurp it.
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
173 open my $BODY, '<', $opts{input} or die "Can't open '$opts{input}': $!";
42d74f6 - version 0.3.1
Jerome Quelin authored
174 local $/;
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
175 $report{body} = <$BODY>;
176 close $BODY or die "Can't close '$opts{input}': $!";
f09c81b @petdance uncuddling elses
petdance authored
177 }
178 else {
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
179 # No file provided...
42d74f6 - version 0.3.1
Jerome Quelin authored
180 $report{body} = "";
e09ecda - can provide an -b switch with a nok flag
Jerome Quelin authored
181 }
182
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
183 nok_report: {
184 last nok_report unless defined $opts{nok};
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
185
186 # This a nok report, how sad... :-(
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
187 $report{summary} = "Not OK: parrot $parrot{version} "
e79a97a - cvs $Id$ tag
Jerome Quelin authored
188 . "on $Config{archname} $Config{osvers}";
42d74f6 - version 0.3.1
Jerome Quelin authored
189 $report{category} = "install";
190 $report{severity} = "none";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
191 last sw;
192 };
193
e79a97a - cvs $Id$ tag
Jerome Quelin authored
194 # Neither an ok nor a nok.
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
195 $report{summary} = $opts{summary} || "";
42d74f6 - version 0.3.1
Jerome Quelin authored
196 $report{category} = $opts{category} || "";
197 $report{severity} = $opts{severity} || "";
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
198 };
199
3c1710d @Util Fix typos.
Util authored
200 # Test message, shortcutting recipient.
42d74f6 - version 0.3.1
Jerome Quelin authored
201 $report{to} = $opts{to} if $opts{to};
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
202
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
203 ##
960e359 - process -e (editor) flag
Jerome Quelin authored
204 ## User information.
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
205 ##
206
514b65a - no need for storing updir
Jerome Quelin authored
207 # Username.
960e359 - process -e (editor) flag
Jerome Quelin authored
208 $user = $is_mswin32 ? $ENV{USERNAME}
209 : $is_os2 ? $ENV{USER} || $ENV{LOGNAME}
210 : $is_macos ? $ENV{USER}
514b65a - no need for storing updir
Jerome Quelin authored
211 : eval { getpwuid($<) }; # May be missing
212
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
213 # User address, used in message
42d74f6 - version 0.3.1
Jerome Quelin authored
214 $report{from} = $opts{from} || "";
9286c79 - test for Mail::Util done where needed, not in BEGIN
Jerome Quelin authored
215
960e359 - process -e (editor) flag
Jerome Quelin authored
216 # Editor
be5da30 - version 0.0.4
Jerome Quelin authored
217 $editor = $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
42d74f6 - version 0.3.1
Jerome Quelin authored
218 || ( $is_vms && "edit/tpu" )
219 || ( $is_mswin32 && "notepad" )
220 || ( $is_macos && "" )
221 || "vi";
960e359 - process -e (editor) flag
Jerome Quelin authored
222
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
223 }
224
225
ab940f6 - reorganizing subs
Jerome Quelin authored
226
227 #------------------------------------------------------------#
228 # Querying subs. #
229
0627f54 Back out pod for subs
Michael Scott authored
230 # Query missing information in order to have a complete report.
42d74f6 - version 0.3.1
Jerome Quelin authored
231 sub query_missing_info {
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
232 $report{summary} = "" if trivial_summary( $report{summary} );
233 $report{summary} = ask_for_summary() unless $report{summary};
42d74f6 - version 0.3.1
Jerome Quelin authored
234 $report{category} = ask_for_alternative( "category", \@categories)
235 unless $report{category};
236 $report{severity} = ask_for_alternative( "severity", \@severities)
237 unless $report{severity};
238 $report{from} = ask_for_return_address() unless $report{from};
239 $report{body} = ask_for_body() unless $report{body};
e9d08a2 - version 0.0.3
Jerome Quelin authored
240 }
241
42d74f6 - version 0.3.1
Jerome Quelin authored
242
0627f54 Back out pod for subs
Michael Scott authored
243 # Prompt for alternatives from a set of choices.
244 #
245 # The arguments are: the name of alternative, the choices (as an array
42d74f6 - version 0.3.1
Jerome Quelin authored
246 # ref), and the default answer. (first element if undef)
0627f54 Back out pod for subs
Michael Scott authored
247 #
248 # Return the lowercased alternative chosen.
249 #
250 # Die if more than 5 wrong answers.
e9d08a2 - version 0.0.3
Jerome Quelin authored
251 sub ask_for_alternative {
252 my ( $what, $choices, $default ) = @_;
253
f88625f - version 0.6.0
Jerome Quelin authored
254 print <<EOT unless $opts{quiet};
e9d08a2 - version 0.0.3
Jerome Quelin authored
255 Please pick a $what from the following:
256 @{$choices}
257
b22284e - version 0.4.1
Jerome Quelin authored
258 EOT
e9d08a2 - version 0.0.3
Jerome Quelin authored
259
42d74f6 - version 0.3.1
Jerome Quelin authored
260 $default ||= $choices->[0];
e9d08a2 - version 0.0.3
Jerome Quelin authored
261 my $alt;
262 my $err = 0;
263 do {
4838fb6 - use strict is our friend
Jerome Quelin authored
264 die "Invalid $alt: aborting.\n" if $err++ > 5;
e9d08a2 - version 0.0.3
Jerome Quelin authored
265 print "Please enter a $what [$default]: ";
42d74f6 - version 0.3.1
Jerome Quelin authored
266 $alt = <STDIN>;
e9d08a2 - version 0.0.3
Jerome Quelin authored
267 chomp $alt;
268 $alt = $default if $alt =~ /^\s*$/;
269 } until ( ($alt) = grep /^$alt/i, @$choices );
270
271 print "\n\n\n";
272 return lc $alt;
6861224 - version 0.0.2
Jerome Quelin authored
273 }
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
274
ab940f6 - reorganizing subs
Jerome Quelin authored
275
42d74f6 - version 0.3.1
Jerome Quelin authored
276 # Prompt for a body, through an external editor.
ab940f6 - reorganizing subs
Jerome Quelin authored
277 sub ask_for_body {
f88625f - version 0.6.0
Jerome Quelin authored
278 unless ( $opts{quiet} ) {
279 print <<EOT;
6861224 - version 0.0.2
Jerome Quelin authored
280 Now you need to supply the bug report. Try to make the report concise
281 but descriptive. Include any relevant detail. If you are reporting
282 something that does not work as you think it should, please try to
283 include example of both the actual result, and what you expected.
960e359 - process -e (editor) flag
Jerome Quelin authored
284
6861224 - version 0.0.2
Jerome Quelin authored
285 Some information about your local parrot configuration will
286 automatically be included at the end of the report. If you are using
287 any unusual version of parrot, please try and confirm exactly which
288 versions are relevant.
960e359 - process -e (editor) flag
Jerome Quelin authored
289
b22284e - version 0.4.1
Jerome Quelin authored
290 EOT
514b65a - no need for storing updir
Jerome Quelin authored
291
f88625f - version 0.6.0
Jerome Quelin authored
292 print "Press 'Enter' to continue...\n";
293 scalar <STDIN>;
294 }
42d74f6 - version 0.3.1
Jerome Quelin authored
295
6861224 - version 0.0.2
Jerome Quelin authored
296 # Prompt for editor to use if none supplied.
c54718c use of Getop::Long instead of Getopt::Std
Jerome Quelin authored
297 if ( $opts{editor} ) {
298 $editor = $opts{editor};
be5da30 - version 0.0.4
Jerome Quelin authored
299
f09c81b @petdance uncuddling elses
petdance authored
300 }
301 else {
f88625f - version 0.6.0
Jerome Quelin authored
302 ask_for_editor($opts{quiet} ? "" : <<EOT);
6861224 - version 0.0.2
Jerome Quelin authored
303 You will probably want to use an editor to enter the report. If the
304 default editor proposed below is the editor you want to use, then just
305 press the 'Enter' key, otherwise type in the name of the editor you
306 would like to use.
b22284e - version 0.4.1
Jerome Quelin authored
307 EOT
be5da30 - version 0.0.4
Jerome Quelin authored
308 }
514b65a - no need for storing updir
Jerome Quelin authored
309
be5da30 - version 0.0.4
Jerome Quelin authored
310 # Launch editor.
42d74f6 - version 0.3.1
Jerome Quelin authored
311 $tmpfile = generate_filename();
312 my $body = "";
313 my $err = 0;
314 do {
315 edit_bug_report( $tmpfile );
316 # Slurp bug report.
317 open BODY, "<$tmpfile" or die "Can't open '$tmpfile': $!";
318 {
319 local $/;
320 $body = <BODY>;
321 }
322 close BODY or die "Can't close '$tmpfile': $!";
323 unless ( $body ) {
324 print "\nYou provided an empty bug report!\n";
325 print "Press 'Enter' to continue...\n";
326 scalar <STDIN>;
327 }
328 die "Aborting.\n" if $err++ == 5;
329 } until ( $body );
330
331 return $body;
6861224 - version 0.0.2
Jerome Quelin authored
332 }
514b65a - no need for storing updir
Jerome Quelin authored
333
ab940f6 - reorganizing subs
Jerome Quelin authored
334
eed8bf2 - some pod =begin forgotten
Jerome Quelin authored
335 # Prompt for editor to use.
ab940f6 - reorganizing subs
Jerome Quelin authored
336 sub ask_for_editor {
6861224 - version 0.0.2
Jerome Quelin authored
337 print shift() . "Editor [$editor]: ";
42d74f6 - version 0.3.1
Jerome Quelin authored
338 my $entry = <STDIN>;
6861224 - version 0.0.2
Jerome Quelin authored
339 chomp $entry;
340 $editor = $entry if $entry ne "";
73c5591 - version 0.5.0
Jerome Quelin authored
341 $opts{editor} = $editor;
6861224 - version 0.0.2
Jerome Quelin authored
342 }
343
ab940f6 - reorganizing subs
Jerome Quelin authored
344
42d74f6 - version 0.3.1
Jerome Quelin authored
345 # Prompt for return address, return it.
ab940f6 - reorganizing subs
Jerome Quelin authored
346 sub ask_for_return_address {
f88625f - version 0.6.0
Jerome Quelin authored
347 print <<EOT unless $opts{quiet};
4b46d98 - guessing return address
Jerome Quelin authored
348 Your e-mail address will be useful if you need to be contacted. If the
349 default shown below is not your full internet e-mail address, please
350 correct it.
b22284e - version 0.4.1
Jerome Quelin authored
351 EOT
6861224 - version 0.0.2
Jerome Quelin authored
352
353 # Try and guess return address
42d74f6 - version 0.3.1
Jerome Quelin authored
354 my ($from, $guess);
2d089e3 @paultcochrane Commenting out old MacOS Classic-specific code so the warnings don't app...
paultcochrane authored
355 $guess = $ENV{'REPLY-TO'} || $ENV{REPLYTO} || "";
4b46d98 - guessing return address
Jerome Quelin authored
356
6861224 - version 0.0.2
Jerome Quelin authored
357 if ( ! $guess ) {
358 # Use $domain if we can.
359 if ( $domain ) {
360 $guess = $is_vms && !$Config{d_socket} ?
361 "$domain\:\:$user" : "$user\@$domain";
4b46d98 - guessing return address
Jerome Quelin authored
362 }
960e359 - process -e (editor) flag
Jerome Quelin authored
363 }
364
6861224 - version 0.0.2
Jerome Quelin authored
365 # Verify our guess.
366 print "Your address [$guess]: ";
42d74f6 - version 0.3.1
Jerome Quelin authored
367 $from = <STDIN>;
6861224 - version 0.0.2
Jerome Quelin authored
368 chomp $from;
369 $from = $guess if $from eq "";
370 print "\n\n\n";
42d74f6 - version 0.3.1
Jerome Quelin authored
371 return $from;
6861224 - version 0.0.2
Jerome Quelin authored
372 }
960e359 - process -e (editor) flag
Jerome Quelin authored
373
374
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
375 # Prompt for summary of message.
42d74f6 - version 0.3.1
Jerome Quelin authored
376 #
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
377 # Return the summary chosen.
42d74f6 - version 0.3.1
Jerome Quelin authored
378 #
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
379 # Die if more than 5 wrong summaries.
380 sub ask_for_summary {
f88625f - version 0.6.0
Jerome Quelin authored
381 print <<EOT unless $opts{quiet};
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
382 First of all, please provide a summary for the message. It should be a
6861224 - version 0.0.2
Jerome Quelin authored
383 concise description of the bug or problem. "parrot bug" or "parrot
384 problem" is not a concise description.
960e359 - process -e (editor) flag
Jerome Quelin authored
385
b22284e - version 0.4.1
Jerome Quelin authored
386 EOT
960e359 - process -e (editor) flag
Jerome Quelin authored
387
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
388 my $summary;
6861224 - version 0.0.2
Jerome Quelin authored
389 my $err = 0;
390 do {
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
391 $err and print "\nThat doesn't look like a good summary. "
6861224 - version 0.0.2
Jerome Quelin authored
392 . "Please be more verbose.\n";
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
393 print "Summary: ";
394 $summary = <STDIN>;
395 $summary = q{} unless defined $summary;
396 chomp $summary;
6861224 - version 0.0.2
Jerome Quelin authored
397 die "Aborting.\n" if $err++ == 5;
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
398 } while ( trivial_summary($summary) );
6861224 - version 0.0.2
Jerome Quelin authored
399 print "\n\n\n";
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
400 return $summary;
9fe1ff2 Initial revision of parrotbug
Jerome Quelin authored
401 }
402
ab940f6 - reorganizing subs
Jerome Quelin authored
403
eed8bf2 - some pod =begin forgotten
Jerome Quelin authored
404 # Launch an editor in which to edit the bug report.
be5da30 - version 0.0.4
Jerome Quelin authored
405 sub edit_bug_report {
406 my $filename = shift;
407
408 # Launch editor.
409 my $retval;
895d5d5 @rurban [cage] enable spaces in $editor pathname. patch by bsdz on #parrot
rurban authored
410 $retval = system($editor, $filename);
be5da30 - version 0.0.4
Jerome Quelin authored
411
412 # Check whether editor run was successful.
b22284e - version 0.4.1
Jerome Quelin authored
413 die <<EOT if $retval;
be5da30 - version 0.0.4
Jerome Quelin authored
414 The editor you chose ('$editor') could apparently not be run! Did you
415 mistype the name of your editor?
416
b22284e - version 0.4.1
Jerome Quelin authored
417 EOT
be5da30 - version 0.0.4
Jerome Quelin authored
418
419 }
420
421
ab940f6 - reorganizing subs
Jerome Quelin authored
422
423 #------------------------------------------------------------#
60312d6 - version 0.1.0
Jerome Quelin authored
424 # Action subs. #
425
42d74f6 - version 0.3.1
Jerome Quelin authored
426
427 # Display everything collected.
73c5591 - version 0.5.0
Jerome Quelin authored
428 sub dump_report {
28c84ea - version 0.4.0
Jerome Quelin authored
429 print "==> Dumping message...\n";
d13af73 @coke use PAGER if set.
coke authored
430 my $report = format_message();
431
432 if ( defined($ENV{PAGER}) ) {
433 open(my $ofh, '|-', $ENV{PAGER});
434 print {$ofh} $report;
435 close $ofh;
436 }
437 else {
438 print $report;
439 }
440
28c84ea - version 0.4.0
Jerome Quelin authored
441 }
42d74f6 - version 0.3.1
Jerome Quelin authored
442
443
73c5591 - version 0.5.0
Jerome Quelin authored
444 # Last chance to edit report.
445 sub edit_report {
446 # Prompt for editor to use if none supplied.
447 unless ( $opts{editor} ) {
448 ask_for_editor(<<EOT);
449 You will probably want to use an editor to modify the report. If the
450 default editor proposed below is the editor you want to use, then just
451 press the 'Enter' key, otherwise type in the name of the editor you
452 would like to use.
453 EOT
454 }
455
456 $tmpfile ||= $opts{input};
457 my $err = 0;
458 my $body;
459 do {
460 edit_bug_report( $tmpfile );
461 # Slurp bug report.
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
462 open my $BODY, '<', $tmpfile or die "Can't open '$tmpfile': $!";
73c5591 - version 0.5.0
Jerome Quelin authored
463 {
464 local $/;
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
465 $body = <$BODY>;
73c5591 - version 0.5.0
Jerome Quelin authored
466 }
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
467 close $BODY or die "Can't close '$tmpfile': $!";
73c5591 - version 0.5.0
Jerome Quelin authored
468 unless ( $body ) {
469 print "\nYou provided an empty bug report!\n";
470 print "Press 'Enter' to continue...\n";
471 scalar <STDIN>;
472 }
473 die "Aborting.\n" if $err++ == 5;
474 } until ( $body );
475
476 $report{body} = $body;
477 }
478
42d74f6 - version 0.3.1
Jerome Quelin authored
479 # Format the message with everything collected and return it.
480 sub format_message {
481 my $report = "";
60312d6 - version 0.1.0
Jerome Quelin authored
482
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
483 # ... summary ...
484 $report .= "Summary: $report{summary}\n";
485
486 # ... sender ...
487 $report .= "Reported by: $report{from}\n";
488
489 # ... bug report ...
490 $report .= "---\n$report{body}\n";
491
5ad437a - version 0.2.1
Jerome Quelin authored
492 # OS, arch, compiler...
b22284e - version 0.4.1
Jerome Quelin authored
493 $report .= <<EOT;
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
494
5ad437a - version 0.2.1
Jerome Quelin authored
495 ---
496 osname= $Config{osname}
497 osvers= $Config{osvers}
498 arch= $Config{archname}
b22284e - version 0.4.1
Jerome Quelin authored
499 EOT
5ad437a - version 0.2.1
Jerome Quelin authored
500
501 my $cc = $Config{cc};
b4edd15 @paultcochrane Using warnings properly now.
paultcochrane authored
502 #$report .= "cc= $cc $Config{${cc}.'version'}\n";
503 $report .= "cc= $cc\n";
5ad437a - version 0.2.1
Jerome Quelin authored
504
505
506 # ... flags...
b22284e - version 0.4.1
Jerome Quelin authored
507 $report .= <<EOT;
60312d6 - version 0.1.0
Jerome Quelin authored
508 ---
509 Flags:
42d74f6 - version 0.3.1
Jerome Quelin authored
510 category=$report{category}
511 severity=$report{severity}
b22284e - version 0.4.1
Jerome Quelin authored
512 EOT
42d74f6 - version 0.3.1
Jerome Quelin authored
513 $report .= " ack=no\n" if ! $opts{ack};
514
60312d6 - version 0.1.0
Jerome Quelin authored
515 # ... myconfig ...
42d74f6 - version 0.3.1
Jerome Quelin authored
516 $report .= "---\n$parrot{myconfig}\n---\n";
60312d6 - version 0.1.0
Jerome Quelin authored
517
518 # ... and environment.
42d74f6 - version 0.3.1
Jerome Quelin authored
519 $report .= "Environment:\n";
60312d6 - version 0.1.0
Jerome Quelin authored
520 my @env = qw[ PATH LD_LIBRARY_PATH LANG SHELL HOME LOGDIR LANGUAGE ];
521 push @env, $Config{ldlibpthname} if $Config{ldlibpthname} ne '';
522 push @env, grep /^(?:PERL|LC_|LANG|CYGWIN)/, keys %ENV;
2d089e3 @paultcochrane Commenting out old MacOS Classic-specific code so the warnings don't app...
paultcochrane authored
523 my %env;
524 @env{@env} = @env;
60312d6 - version 0.1.0
Jerome Quelin authored
525 for my $env (sort keys %env) {
b4edd15 @paultcochrane Using warnings properly now.
paultcochrane authored
526 my $env_value = exists $ENV{$env} ? "=$ENV{$env}\n" : " (unset)\n";
527 $report .= " $env $env_value";
60312d6 - version 0.1.0
Jerome Quelin authored
528 }
42d74f6 - version 0.3.1
Jerome Quelin authored
529
530 return $report;
531 }
532
533
534 # Print synopsis + help message and exit.
535 sub help {
b22284e - version 0.4.1
Jerome Quelin authored
536 print <<EOT;
42d74f6 - version 0.3.1
Jerome Quelin authored
537
538 A program to help generate bug reports about parrot, and mail them.
539 It is designed to be used interactively. Normally no arguments will
540 be needed.
541
542 Simplest usage: run '$0', and follow the prompts.
543 Usage: $0 [OPTIONS] [ACTIONS]
544
545 Options:
546 --ok Report successful build on this system to parrot
73ba72d [perl #36057] [PATCH] Fix some typos - 5
Leopold Toetsch authored
547 developers. Only use --ok if *everything* was ok:
42d74f6 - version 0.3.1
Jerome Quelin authored
548 if there were *any* problems at all, use --nok.
549 --nok Report unsuccessful build on this system.
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
550 --summary <summary> Summary to include with the message.
42d74f6 - version 0.3.1
Jerome Quelin authored
551 --category <category> Category of the bug report.
552 --severity <severity> Severity of the bug report.
553 --from <address> Your email address.
554 --editor <editor> Editor to use for editing the bug report.
555 --ack, --noack Don't send a bug received acknowledgement.
556 --input-file File containing the body of the report. Use this
557 to quickly send a prepared message.
558 --output-file File where parrotbug will save its bug report.
559
560 Note: you will be prompted if the program miss some information.
561
562 Actions:
563 --dump Dump message.
564 --save Save message.
565 --help Print this help message and exit.
566 --version Print version information and exit.
567
b22284e - version 0.4.1
Jerome Quelin authored
568 EOT
42d74f6 - version 0.3.1
Jerome Quelin authored
569 exit;
60312d6 - version 0.1.0
Jerome Quelin authored
570 }
571
28c84ea - version 0.4.0
Jerome Quelin authored
572 # Save message to file.
73c5591 - version 0.5.0
Jerome Quelin authored
573 sub save_report {
28c84ea - version 0.4.0
Jerome Quelin authored
574 print "\n==> Saving message to file...\n";
575 if ( ! $opts{output} ) {
576 print "Enter filename to save bug report: ";
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
577 chomp($opts{output} = <STDIN>);
28c84ea - version 0.4.0
Jerome Quelin authored
578 }
579
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
580 open my $OUTPUT, ">", $opts{output}
581 or die "Cannot open '$opts{output}': $!";
582 print $OUTPUT format_message();
3db09f0 @Util Fix error message in parrotbug
Util authored
583 close $OUTPUT or die "Cannot close '$opts{output}': $!";
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
584
585 print <<TRAC;
586 Message saved. Please go to
dc3d65b @moritz replace some references to trac.parrot.org with the appropriate links to...
moritz authored
587 https://github.com/parrot/parrot/issues
588 and paste content of saved file into 'Description'
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
589 TRAC
28c84ea - version 0.4.0
Jerome Quelin authored
590 }
591
592
42d74f6 - version 0.3.1
Jerome Quelin authored
593
594 # Print version information (of the parrotbug program) and exit.
595 sub version {
b22284e - version 0.4.1
Jerome Quelin authored
596 print <<"EOT";
42d74f6 - version 0.3.1
Jerome Quelin authored
597
598 This is $0, version $VERSION.
599
b22284e - version 0.4.1
Jerome Quelin authored
600 EOT
42d74f6 - version 0.3.1
Jerome Quelin authored
601 exit;
602 }
603
604
605 # Check whether actions have been provided on comand-line, otherwise
606 # prompt for what to do with bug report.
607 sub what_next {
73c5591 - version 0.5.0
Jerome Quelin authored
608 dump_report() if $opts{dump};
609 save_report() if $opts{save};
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
610 return if $opts{dump} || $opts{save};
42d74f6 - version 0.3.1
Jerome Quelin authored
611
612 # No actions provided on command-line, prompt for action.
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
613 print describe_actions();
42d74f6 - version 0.3.1
Jerome Quelin authored
614
615 my $action;
616 do {
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
617 print "Action (display,edit,save,quit): ";
42d74f6 - version 0.3.1
Jerome Quelin authored
618 $action = <STDIN>;
619 sw: for ($action) {
73c5591 - version 0.5.0
Jerome Quelin authored
620 dump_report(), last sw if /^d/i;
621 edit_report(), last sw if /^e/i;
622 save_report(), last sw if /^sa/i;
42d74f6 - version 0.3.1
Jerome Quelin authored
623 print "Uh?\n" unless /^q/i;
624 };
625 } until ( $action =~ /^q/i );
626 }
627
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
628 sub describe_actions {
629 my $str = <<ACTION;
42d74f6 - version 0.3.1
Jerome Quelin authored
630
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
631 Please choose among the following Actions:
632
633 display:
634 Displays on STDOUT your bug report summary, bug description,
635 operating system information, bug report flags, summary of
636 your Parrot configuration and environment. Returns you to
637 a new Action prompt.
638
639 edit:
640 Opens your editor and permits you to edit the bug description.
641 Returns you to a new Action prompt.
642
643 save:
644 Prompts you to enter a filename to save the bug report. Once
645 the file has been saved, displays filing instructions, then
646 returns you to a new Action prompt.
647
648 quit:
649 Quits; returns you to your terminal's command prompt.
650
651 ACTION
652 return $str;
653 }
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
654 __END__
655
656 =head1 NAME
657
70fc35e @coke Make POD conform to 'make html' expectations a bit more.
coke authored
658 Parrot Bug Reporter
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
659
660 =head1 SYNOPSIS
661
b22284e - version 0.4.1
Jerome Quelin authored
662 % ./parrotbug [options] [actions]
663
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
664 =head1 DESCRIPTION
665
666 A program to help generate bug reports about parrot, and mail them.
667 It is designed to be used interactively. Normally no arguments will
668 be needed.
669
b22284e - version 0.4.1
Jerome Quelin authored
670
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
671 =head1 COMMAND-LINE SWITCHES
b22284e - version 0.4.1
Jerome Quelin authored
672
673
674 =head2 Options
675
676 Note: you will be prompted if the program miss some information.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
677
678 =over 4
679
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
680 =item B<--nok>
b22284e - version 0.4.1
Jerome Quelin authored
681
73ba72d [perl #36057] [PATCH] Fix some typos - 5
Leopold Toetsch authored
682 Report unsuccessful build on this system to parrot developers.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
683
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
684 =item B<--ok>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
685
73ba72d [perl #36057] [PATCH] Fix some typos - 5
Leopold Toetsch authored
686 Report successful build on this system to parrot developers Only use
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
687 C<--ok> if B<everything> was ok; if there were B<any> problems at all,
b22284e - version 0.4.1
Jerome Quelin authored
688 use C<--nok>.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
689
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
690 =item B<--summary>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
691
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
692 Summary of the report. You will be prompted if you don't supply one on
b22284e - version 0.4.1
Jerome Quelin authored
693 the command-line.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
694
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
695 =item B<--category>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
696
b22284e - version 0.4.1
Jerome Quelin authored
697 Category of the bug report. You will be prompted if you don't supply
698 one on the command-line.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
699
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
700 =item B<--severity>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
701
b22284e - version 0.4.1
Jerome Quelin authored
702 Severity of the bug report. You will be prompted if you don't supply
703 one on the command-line.
704
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
705 =item B<--address>
b22284e - version 0.4.1
Jerome Quelin authored
706
707 Your email address. The program will try to guess one if you don't
708 provide one, but you'll still need to validate it.
709
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
710 =item B<--editor>
b22284e - version 0.4.1
Jerome Quelin authored
711
712 Editor to use for editing the bug report.
713
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
714 =item B<--output-file>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
715
b22284e - version 0.4.1
Jerome Quelin authored
716 File where parrotbug will save its bug report, if you ask it to do so.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
717
b22284e - version 0.4.1
Jerome Quelin authored
718 =back
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
719
720
b22284e - version 0.4.1
Jerome Quelin authored
721 =head2 Actions
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
722
b22284e - version 0.4.1
Jerome Quelin authored
723 You can provide more than one action on the command-line. If none is
724 supplied, then you will be prompted for what to do.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
725
b22284e - version 0.4.1
Jerome Quelin authored
726 =over 4
727
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
728 =item B<--dump>
b22284e - version 0.4.1
Jerome Quelin authored
729
730 Dump formatted report on standard output.
731
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
732 =item B<--save>
b22284e - version 0.4.1
Jerome Quelin authored
733
734 Save message to a file, in order for you to send it later from your
735 own. See C<--output> flag.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
736
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
737 =item B<--help>
b22284e - version 0.4.1
Jerome Quelin authored
738
739 Print a short synopsis and exit.
740
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
741 =item B<--version>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
742
743 Print version information and exit.
744
07b9ece A bit of refactoring of the POD parser to integrate Parrot-specific form...
Michael Scott authored
745 =back
746
b22284e - version 0.4.1
Jerome Quelin authored
747
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
748 =head1 SEE ALSO
749
750 perlbug(1), parrot(1), diff(1), patch(1)
07b9ece A bit of refactoring of the POD parser to integrate Parrot-specific form...
Michael Scott authored
751
752 =cut
753
b4edd15 @paultcochrane Using warnings properly now.
paultcochrane authored
754 # Local Variables:
755 # mode: cperl
756 # cperl-indent-level: 4
757 # fill-column: 100
758 # End:
759 # vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.