Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 761 lines (578 sloc) 19.617 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
587 https://trac.parrot.org/parrot/newticket
588 and either paste content of saved file into 'Description'
589 or attach file to ticket.
590 TRAC
28c84ea - version 0.4.0
Jerome Quelin authored
591 }
592
593
42d74f6 - version 0.3.1
Jerome Quelin authored
594
595 # Print version information (of the parrotbug program) and exit.
596 sub version {
b22284e - version 0.4.1
Jerome Quelin authored
597 print <<"EOT";
42d74f6 - version 0.3.1
Jerome Quelin authored
598
599 This is $0, version $VERSION.
600
b22284e - version 0.4.1
Jerome Quelin authored
601 EOT
42d74f6 - version 0.3.1
Jerome Quelin authored
602 exit;
603 }
604
605
606 # Check whether actions have been provided on comand-line, otherwise
607 # prompt for what to do with bug report.
608 sub what_next {
73c5591 - version 0.5.0
Jerome Quelin authored
609 dump_report() if $opts{dump};
610 save_report() if $opts{save};
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
611 return if $opts{dump} || $opts{save};
42d74f6 - version 0.3.1
Jerome Quelin authored
612
613 # No actions provided on command-line, prompt for action.
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
614 print describe_actions();
42d74f6 - version 0.3.1
Jerome Quelin authored
615
616 my $action;
617 do {
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
618 print "Action (display,edit,save,quit): ";
42d74f6 - version 0.3.1
Jerome Quelin authored
619 $action = <STDIN>;
620 sw: for ($action) {
73c5591 - version 0.5.0
Jerome Quelin authored
621 dump_report(), last sw if /^d/i;
622 edit_report(), last sw if /^e/i;
623 save_report(), last sw if /^sa/i;
42d74f6 - version 0.3.1
Jerome Quelin authored
624 print "Uh?\n" unless /^q/i;
625 };
626 } until ( $action =~ /^q/i );
627 }
628
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
629 sub describe_actions {
630 my $str = <<ACTION;
42d74f6 - version 0.3.1
Jerome Quelin authored
631
ba03bd8 @jkeenan Provide better description of final Action selections.
jkeenan authored
632 Please choose among the following Actions:
633
634 display:
635 Displays on STDOUT your bug report summary, bug description,
636 operating system information, bug report flags, summary of
637 your Parrot configuration and environment. Returns you to
638 a new Action prompt.
639
640 edit:
641 Opens your editor and permits you to edit the bug description.
642 Returns you to a new Action prompt.
643
644 save:
645 Prompts you to enter a filename to save the bug report. Once
646 the file has been saved, displays filing instructions, then
647 returns you to a new Action prompt.
648
649 quit:
650 Quits; returns you to your terminal's command prompt.
651
652 ACTION
653 return $str;
654 }
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
655 __END__
656
657 =head1 NAME
658
70fc35e @coke Make POD conform to 'make html' expectations a bit more.
coke authored
659 Parrot Bug Reporter
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
660
661 =head1 SYNOPSIS
662
b22284e - version 0.4.1
Jerome Quelin authored
663 % ./parrotbug [options] [actions]
664
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
665 =head1 DESCRIPTION
666
667 A program to help generate bug reports about parrot, and mail them.
668 It is designed to be used interactively. Normally no arguments will
669 be needed.
670
b22284e - version 0.4.1
Jerome Quelin authored
671
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
672 =head1 COMMAND-LINE SWITCHES
b22284e - version 0.4.1
Jerome Quelin authored
673
674
675 =head2 Options
676
677 Note: you will be prompted if the program miss some information.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
678
679 =over 4
680
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
681 =item B<--nok>
b22284e - version 0.4.1
Jerome Quelin authored
682
73ba72d [perl #36057] [PATCH] Fix some typos - 5
Leopold Toetsch authored
683 Report unsuccessful build on this system to parrot developers.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
684
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
685 =item B<--ok>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
686
73ba72d [perl #36057] [PATCH] Fix some typos - 5
Leopold Toetsch authored
687 Report successful build on this system to parrot developers Only use
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
688 C<--ok> if B<everything> was ok; if there were B<any> problems at all,
b22284e - version 0.4.1
Jerome Quelin authored
689 use C<--nok>.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
690
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
691 =item B<--summary>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
692
3d4130b @allisonrandal [cage] Committing a modified version of Patrick's patch from TT #27.
allisonrandal authored
693 Summary of the report. You will be prompted if you don't supply one on
b22284e - version 0.4.1
Jerome Quelin authored
694 the command-line.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
695
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
696 =item B<--category>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
697
b22284e - version 0.4.1
Jerome Quelin authored
698 Category of the bug report. You will be prompted if you don't supply
699 one on the command-line.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
700
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
701 =item B<--severity>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
702
b22284e - version 0.4.1
Jerome Quelin authored
703 Severity of the bug report. You will be prompted if you don't supply
704 one on the command-line.
705
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
706 =item B<--address>
b22284e - version 0.4.1
Jerome Quelin authored
707
708 Your email address. The program will try to guess one if you don't
709 provide one, but you'll still need to validate it.
710
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
711 =item B<--editor>
b22284e - version 0.4.1
Jerome Quelin authored
712
713 Editor to use for editing the bug report.
714
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
715 =item B<--output-file>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
716
b22284e - version 0.4.1
Jerome Quelin authored
717 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
718
b22284e - version 0.4.1
Jerome Quelin authored
719 =back
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
720
721
b22284e - version 0.4.1
Jerome Quelin authored
722 =head2 Actions
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
723
b22284e - version 0.4.1
Jerome Quelin authored
724 You can provide more than one action on the command-line. If none is
725 supplied, then you will be prompted for what to do.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
726
b22284e - version 0.4.1
Jerome Quelin authored
727 =over 4
728
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
729 =item B<--dump>
b22284e - version 0.4.1
Jerome Quelin authored
730
731 Dump formatted report on standard output.
732
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
733 =item B<--save>
b22284e - version 0.4.1
Jerome Quelin authored
734
735 Save message to a file, in order for you to send it later from your
736 own. See C<--output> flag.
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
737
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
738 =item B<--help>
b22284e - version 0.4.1
Jerome Quelin authored
739
740 Print a short synopsis and exit.
741
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
742 =item B<--version>
c31eb2d pod belongs to the end of the script.
Jerome Quelin authored
743
744 Print version information and exit.
745
07b9ece A bit of refactoring of the POD parser to integrate Parrot-specific form...
Michael Scott authored
746 =back
747
b22284e - version 0.4.1
Jerome Quelin authored
748
cf25b15 - taking credit for parrotbug
Jerome Quelin authored
749 =head1 SEE ALSO
750
751 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
752
753 =cut
754
b4edd15 @paultcochrane Using warnings properly now.
paultcochrane authored
755 # Local Variables:
756 # mode: cperl
757 # cperl-indent-level: 4
758 # fill-column: 100
759 # End:
760 # vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.