Skip to content
This repository
Newer
Older
100755 760 lines (577 sloc) 19.581 kb
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
1 #!/usr/bin/perl
c31eb2df »
2004-03-28 pod belongs to the end of the script.
2 #
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
3 # Copyright (C) 2004-2011, Parrot Foundation.
c31eb2df »
2004-03-28 pod belongs to the end of the script.
4 #
07b9ecee »
2004-03-06 A bit of refactoring of the POD parser to integrate Parrot-specific f…
5
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
6 eval 'exec perl -w -S $0 ${1+"$@"}'
b4edd155 »
2007-03-18 Using warnings properly now.
7 if $running_under_some_shell;
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
8
4838fb61 »
2004-03-04 - use strict is our friend
9 use strict;
b4edd155 »
2007-03-18 Using warnings properly now.
10 use warnings;
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
11
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
12 use Config;
13 use File::Spec;
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
14 use Getopt::Long;
15
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
16
895d5d5e »
2009-02-28 [cage] enable spaces in $editor pathname. patch by bsdz on #parrot
17 my $VERSION = "1.0";
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
18
514b65ab »
2004-03-03 - no need for storing updir
19 my $parrotdir = File::Spec->curdir();
42d74f6d »
2004-05-17 - version 0.3.1
20 my ( %opts, %parrot, %report );
21 my ( $editor, $user, $domain, $msgid, $tmpfile );
514b65ab »
2004-03-03 - no need for storing updir
22 my ( $is_linux, $is_macos, $is_mswin32, $is_os2, $is_vms );
c8be334b »
2006-06-16 Added a bug category for 'languages'
23 my @categories = qw[ core docs install library utilities languages ];
42d74f6d »
2004-05-17 - version 0.3.1
24 my @severities = qw[ critical high medium low wishlist none ];
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
25
26
4b46d982 »
2004-03-03 - guessing return address
27 #------------------------------------------------------------#
28 # Main program. #
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
29
30 init();
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
31 help() if $opts{help};
32 version() if $opts{version};
42d74f6d »
2004-05-17 - version 0.3.1
33 explain_parrotbug() unless $opts{quiet};
34 query_missing_info();
35 what_next();
28c84ea5 »
2004-05-17 - version 0.4.0
36 unlink $tmpfile;
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
37 exit;
38
39
42d74f6d »
2004-05-17 - version 0.3.1
40
41 # Explain what C<parrotbug> is.
6861224c »
2004-03-04 - version 0.0.2
42 sub explain_parrotbug {
b22284e9 »
2004-05-17 - version 0.4.1
43 print <<EOT;
6861224c »
2004-03-04 - version 0.0.2
44
45 This program provides an easy way to create a message reporting a bug
30b79e66 »
2004-09-16 small typo fix
46 in parrot, and e-mail it to the parrot developers.
6861224c »
2004-03-04 - version 0.0.2
47
48 It is *NOT* intended for:
49 - sending test messages,
3c1710de »
2010-11-11 Fix typos.
50 - or reporting bugs in languages targeting parrot,
6861224c »
2004-03-04 - version 0.0.2
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
d599b7ac »
2005-04-11 typo fixed
56 developers.
6861224c »
2004-03-04 - version 0.0.2
57
58 If you're just looking for help with parrot, subscribe to the parrot
66ddda2e »
2009-02-09 [docs] Fix up old references to submitting/subscribing/archives for t…
59 mailing list, parrot-dev<at>lists.parrot.org.
6861224c »
2004-03-04 - version 0.0.2
60
61
62
b22284e9 »
2004-05-17 - version 0.4.1
63 EOT
ab940f67 »
2004-03-04 - reorganizing subs
64 }
65
66
67
68
69 #------------------------------------------------------------#
70 # Utils subs. #
71
0627f54e »
2004-03-10 Back out pod for subs
72 # Generate random filename to edit report.
ab940f67 »
2004-03-04 - reorganizing subs
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
eed8bf2a »
2004-03-10 - some pod =begin forgotten
81
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
82 # Check whether a summary is trivial. A summary is not considered trivial
0627f54e »
2004-03-10 Back out pod for subs
83 # if it's an ok or a nok report.
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
84 # Return 1 if trivial, 0 otherwise (summary acceptable).
85 sub trivial_summary {
86 my $summary = shift;
ab940f67 »
2004-03-04 - reorganizing subs
87
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
88 return 0 if $opts{ok} || $opts{nok};
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
89 if ( $summary =~
ab940f67 »
2004-03-04 - reorganizing subs
90 /^(y(es)?|no?|help|parrot( (bug|problem))?|bug|problem)$/i ||
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
91 length($summary) < 4 ||
92 $summary !~ /\s/ ) {
ab940f67 »
2004-03-04 - reorganizing subs
93 return 1;
f09c81b0 »
2007-06-17 uncuddling elses
94 }
95 else {
96 return 0;
ab940f67 »
2004-03-04 - reorganizing subs
97 }
98 }
99
100
101
102
103 #------------------------------------------------------------#
104 # Init subs. #
105
0627f54e »
2004-03-10 Back out pod for subs
106 # Initialize the program.
107 #
108 # Get parrot information, process the options, create the message
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
109 # information (summary, to, body, etc.) depending on the type of report
0627f54e »
2004-03-10 Back out pod for subs
110 # (ok, nok or bug report).
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
111 sub init {
112 $is_linux = lc($^O) eq 'linux';
514b65ab »
2004-03-03 - no need for storing updir
113 $is_mswin32 = $^O eq 'MSWin32';
114 $is_os2 = $^O eq 'os2';
115 $is_vms = $^O eq 'VMS';
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
116
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
117 ##
118 ## Fetch Parrot information.
119 ##
120
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
121 # Get parrot version.
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
122 # There will always be an up-to-date $parrot/VERSION
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
123 my $filename = File::Spec->catfile($parrotdir, "VERSION");
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
124 open my $VERSION, '<', $filename or die "Cannot open '$filename': $!";
125 $parrot{version} = <$VERSION>;
42d74f6d »
2004-05-17 - version 0.3.1
126 chomp $parrot{version};
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
127 close $VERSION or die "Cannot close '$filename': $!";
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
128
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
129 # Get parrot configuration, stored in $parrot/myconfig
130 $filename = File::Spec->catfile($parrotdir, "myconfig");
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
131 open my $MYCONFIG, '<', $filename or die "Cannot open '$filename': $!";
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
132 {
133 local $/;
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
134 $parrot{myconfig} = <$MYCONFIG>;
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
135 }
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
136 close $MYCONFIG or die "Cannot close '$filename': $!";
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
137
138
139 ##
140 ## Process options.
141 ##
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
142 Getopt::Long::Configure("no_bundling", "no_ignore_case", "auto_abbrev");
143 help() unless GetOptions
144 ( \%opts,
42d74f6d »
2004-05-17 - version 0.3.1
145 "help|h", "version|V",
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
146 "dump", "save",
42d74f6d »
2004-05-17 - version 0.3.1
147 "from|f=s", "to|test|t=s", "editor|e=s",
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
148 "summary|s=s", "category|C=s", "severity|S=s",
42d74f6d »
2004-05-17 - version 0.3.1
149 "input|input-file|i=s", "output|output-file|o=s",
150 "ok", "nok", "ack!", "quiet|q!" );
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
151
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
152 ##
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
153 ## Report to be sent.
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
154 ##
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
155 sw: {
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
156 ok_report: {
157 last ok_report unless defined $opts{ok};
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
158
159 # This is an ok report, woohoo!
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
160 $report{summary} = "OK: parrot $parrot{version} "
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
161 . "on $Config{archname} $Config{osvers}";
42d74f6d »
2004-05-17 - version 0.3.1
162 $report{body} = "Parrot reported to build OK on this system.\n";
163 $report{category} = "install";
164 $report{severity} = "none";
165 $report{body} = "";
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
166 last sw;
167 };
168
e09ecdaa »
2004-03-03 - can provide an -b switch with a nok flag
169 # Ok reports do not need body, but nok and bug reports do need
42d74f6d »
2004-05-17 - version 0.3.1
170 # a body.
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
171 if ( $opts{input} ) {
42d74f6d »
2004-05-17 - version 0.3.1
172 # Report was pre-written, slurp it.
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
173 open my $BODY, '<', $opts{input} or die "Can't open '$opts{input}': $!";
42d74f6d »
2004-05-17 - version 0.3.1
174 local $/;
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
175 $report{body} = <$BODY>;
176 close $BODY or die "Can't close '$opts{input}': $!";
f09c81b0 »
2007-06-17 uncuddling elses
177 }
178 else {
e09ecdaa »
2004-03-03 - can provide an -b switch with a nok flag
179 # No file provided...
42d74f6d »
2004-05-17 - version 0.3.1
180 $report{body} = "";
e09ecdaa »
2004-03-03 - can provide an -b switch with a nok flag
181 }
182
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
183 nok_report: {
184 last nok_report unless defined $opts{nok};
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
185
186 # This a nok report, how sad... :-(
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
187 $report{summary} = "Not OK: parrot $parrot{version} "
e79a97ae »
2004-03-03 - cvs $Id$ tag
188 . "on $Config{archname} $Config{osvers}";
42d74f6d »
2004-05-17 - version 0.3.1
189 $report{category} = "install";
190 $report{severity} = "none";
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
191 last sw;
192 };
193
e79a97ae »
2004-03-03 - cvs $Id$ tag
194 # Neither an ok nor a nok.
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
195 $report{summary} = $opts{summary} || "";
42d74f6d »
2004-05-17 - version 0.3.1
196 $report{category} = $opts{category} || "";
197 $report{severity} = $opts{severity} || "";
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
198 };
199
3c1710de »
2010-11-11 Fix typos.
200 # Test message, shortcutting recipient.
42d74f6d »
2004-05-17 - version 0.3.1
201 $report{to} = $opts{to} if $opts{to};
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
202
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
203 ##
960e359d »
2004-03-03 - process -e (editor) flag
204 ## User information.
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
205 ##
206
514b65ab »
2004-03-03 - no need for storing updir
207 # Username.
960e359d »
2004-03-03 - process -e (editor) flag
208 $user = $is_mswin32 ? $ENV{USERNAME}
209 : $is_os2 ? $ENV{USER} || $ENV{LOGNAME}
210 : $is_macos ? $ENV{USER}
514b65ab »
2004-03-03 - no need for storing updir
211 : eval { getpwuid($<) }; # May be missing
212
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
213 # User address, used in message
42d74f6d »
2004-05-17 - version 0.3.1
214 $report{from} = $opts{from} || "";
9286c796 »
2004-03-03 - test for Mail::Util done where needed, not in BEGIN
215
960e359d »
2004-03-03 - process -e (editor) flag
216 # Editor
be5da30d »
2004-03-04 - version 0.0.4
217 $editor = $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT}
42d74f6d »
2004-05-17 - version 0.3.1
218 || ( $is_vms && "edit/tpu" )
219 || ( $is_mswin32 && "notepad" )
220 || ( $is_macos && "" )
221 || "vi";
960e359d »
2004-03-03 - process -e (editor) flag
222
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
223 }
224
225
ab940f67 »
2004-03-04 - reorganizing subs
226
227 #------------------------------------------------------------#
228 # Querying subs. #
229
0627f54e »
2004-03-10 Back out pod for subs
230 # Query missing information in order to have a complete report.
42d74f6d »
2004-05-17 - version 0.3.1
231 sub query_missing_info {
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
232 $report{summary} = "" if trivial_summary( $report{summary} );
233 $report{summary} = ask_for_summary() unless $report{summary};
42d74f6d »
2004-05-17 - version 0.3.1
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};
e9d08a2f »
2004-03-04 - version 0.0.3
240 }
241
42d74f6d »
2004-05-17 - version 0.3.1
242
0627f54e »
2004-03-10 Back out pod for subs
243 # Prompt for alternatives from a set of choices.
244 #
245 # The arguments are: the name of alternative, the choices (as an array
42d74f6d »
2004-05-17 - version 0.3.1
246 # ref), and the default answer. (first element if undef)
0627f54e »
2004-03-10 Back out pod for subs
247 #
248 # Return the lowercased alternative chosen.
249 #
250 # Die if more than 5 wrong answers.
e9d08a2f »
2004-03-04 - version 0.0.3
251 sub ask_for_alternative {
252 my ( $what, $choices, $default ) = @_;
253
f88625f7 »
2004-05-17 - version 0.6.0
254 print <<EOT unless $opts{quiet};
e9d08a2f »
2004-03-04 - version 0.0.3
255 Please pick a $what from the following:
256 @{$choices}
257
b22284e9 »
2004-05-17 - version 0.4.1
258 EOT
e9d08a2f »
2004-03-04 - version 0.0.3
259
42d74f6d »
2004-05-17 - version 0.3.1
260 $default ||= $choices->[0];
e9d08a2f »
2004-03-04 - version 0.0.3
261 my $alt;
262 my $err = 0;
263 do {
4838fb61 »
2004-03-04 - use strict is our friend
264 die "Invalid $alt: aborting.\n" if $err++ > 5;
e9d08a2f »
2004-03-04 - version 0.0.3
265 print "Please enter a $what [$default]: ";
42d74f6d »
2004-05-17 - version 0.3.1
266 $alt = <STDIN>;
e9d08a2f »
2004-03-04 - version 0.0.3
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;
6861224c »
2004-03-04 - version 0.0.2
273 }
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
274
ab940f67 »
2004-03-04 - reorganizing subs
275
42d74f6d »
2004-05-17 - version 0.3.1
276 # Prompt for a body, through an external editor.
ab940f67 »
2004-03-04 - reorganizing subs
277 sub ask_for_body {
f88625f7 »
2004-05-17 - version 0.6.0
278 unless ( $opts{quiet} ) {
279 print <<EOT;
6861224c »
2004-03-04 - version 0.0.2
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.
960e359d »
2004-03-03 - process -e (editor) flag
284
6861224c »
2004-03-04 - version 0.0.2
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.
960e359d »
2004-03-03 - process -e (editor) flag
289
b22284e9 »
2004-05-17 - version 0.4.1
290 EOT
514b65ab »
2004-03-03 - no need for storing updir
291
f88625f7 »
2004-05-17 - version 0.6.0
292 print "Press 'Enter' to continue...\n";
293 scalar <STDIN>;
294 }
42d74f6d »
2004-05-17 - version 0.3.1
295
6861224c »
2004-03-04 - version 0.0.2
296 # Prompt for editor to use if none supplied.
c54718cd »
2004-03-28 use of Getop::Long instead of Getopt::Std
297 if ( $opts{editor} ) {
298 $editor = $opts{editor};
be5da30d »
2004-03-04 - version 0.0.4
299
f09c81b0 »
2007-06-17 uncuddling elses
300 }
301 else {
f88625f7 »
2004-05-17 - version 0.6.0
302 ask_for_editor($opts{quiet} ? "" : <<EOT);
6861224c »
2004-03-04 - version 0.0.2
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.
b22284e9 »
2004-05-17 - version 0.4.1
307 EOT
be5da30d »
2004-03-04 - version 0.0.4
308 }
514b65ab »
2004-03-03 - no need for storing updir
309
be5da30d »
2004-03-04 - version 0.0.4
310 # Launch editor.
42d74f6d »
2004-05-17 - version 0.3.1
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;
6861224c »
2004-03-04 - version 0.0.2
332 }
514b65ab »
2004-03-03 - no need for storing updir
333
ab940f67 »
2004-03-04 - reorganizing subs
334
eed8bf2a »
2004-03-10 - some pod =begin forgotten
335 # Prompt for editor to use.
ab940f67 »
2004-03-04 - reorganizing subs
336 sub ask_for_editor {
6861224c »
2004-03-04 - version 0.0.2
337 print shift() . "Editor [$editor]: ";
42d74f6d »
2004-05-17 - version 0.3.1
338 my $entry = <STDIN>;
6861224c »
2004-03-04 - version 0.0.2
339 chomp $entry;
340 $editor = $entry if $entry ne "";
73c55913 »
2004-05-17 - version 0.5.0
341 $opts{editor} = $editor;
6861224c »
2004-03-04 - version 0.0.2
342 }
343
ab940f67 »
2004-03-04 - reorganizing subs
344
42d74f6d »
2004-05-17 - version 0.3.1
345 # Prompt for return address, return it.
ab940f67 »
2004-03-04 - reorganizing subs
346 sub ask_for_return_address {
f88625f7 »
2004-05-17 - version 0.6.0
347 print <<EOT unless $opts{quiet};
4b46d982 »
2004-03-03 - guessing return address
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.
b22284e9 »
2004-05-17 - version 0.4.1
351 EOT
6861224c »
2004-03-04 - version 0.0.2
352
353 # Try and guess return address
42d74f6d »
2004-05-17 - version 0.3.1
354 my ($from, $guess);
2d089e3e »
2007-03-18 Commenting out old MacOS Classic-specific code so the warnings don't …
355 $guess = $ENV{'REPLY-TO'} || $ENV{REPLYTO} || "";
4b46d982 »
2004-03-03 - guessing return address
356
6861224c »
2004-03-04 - version 0.0.2
357 if ( ! $guess ) {
358 # Use $domain if we can.
359 if ( $domain ) {
360 $guess = $is_vms && !$Config{d_socket} ?
361 "$domain\:\:$user" : "$user\@$domain";
4b46d982 »
2004-03-03 - guessing return address
362 }
960e359d »
2004-03-03 - process -e (editor) flag
363 }
364
6861224c »
2004-03-04 - version 0.0.2
365 # Verify our guess.
366 print "Your address [$guess]: ";
42d74f6d »
2004-05-17 - version 0.3.1
367 $from = <STDIN>;
6861224c »
2004-03-04 - version 0.0.2
368 chomp $from;
369 $from = $guess if $from eq "";
370 print "\n\n\n";
42d74f6d »
2004-05-17 - version 0.3.1
371 return $from;
6861224c »
2004-03-04 - version 0.0.2
372 }
960e359d »
2004-03-03 - process -e (editor) flag
373
374
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
375 # Prompt for summary of message.
42d74f6d »
2004-05-17 - version 0.3.1
376 #
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
377 # Return the summary chosen.
42d74f6d »
2004-05-17 - version 0.3.1
378 #
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
379 # Die if more than 5 wrong summaries.
380 sub ask_for_summary {
f88625f7 »
2004-05-17 - version 0.6.0
381 print <<EOT unless $opts{quiet};
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
382 First of all, please provide a summary for the message. It should be a
6861224c »
2004-03-04 - version 0.0.2
383 concise description of the bug or problem. "parrot bug" or "parrot
384 problem" is not a concise description.
960e359d »
2004-03-03 - process -e (editor) flag
385
b22284e9 »
2004-05-17 - version 0.4.1
386 EOT
960e359d »
2004-03-03 - process -e (editor) flag
387
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
388 my $summary;
6861224c »
2004-03-04 - version 0.0.2
389 my $err = 0;
390 do {
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
391 $err and print "\nThat doesn't look like a good summary. "
6861224c »
2004-03-04 - version 0.0.2
392 . "Please be more verbose.\n";
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
393 print "Summary: ";
394 $summary = <STDIN>;
395 $summary = q{} unless defined $summary;
396 chomp $summary;
6861224c »
2004-03-04 - version 0.0.2
397 die "Aborting.\n" if $err++ == 5;
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
398 } while ( trivial_summary($summary) );
6861224c »
2004-03-04 - version 0.0.2
399 print "\n\n\n";
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
400 return $summary;
9fe1ff2f »
2004-03-03 Initial revision of parrotbug
401 }
402
ab940f67 »
2004-03-04 - reorganizing subs
403
eed8bf2a »
2004-03-10 - some pod =begin forgotten
404 # Launch an editor in which to edit the bug report.
be5da30d »
2004-03-04 - version 0.0.4
405 sub edit_bug_report {
406 my $filename = shift;
407
408 # Launch editor.
409 my $retval;
895d5d5e »
2009-02-28 [cage] enable spaces in $editor pathname. patch by bsdz on #parrot
410 $retval = system($editor, $filename);
be5da30d »
2004-03-04 - version 0.0.4
411
412 # Check whether editor run was successful.
b22284e9 »
2004-05-17 - version 0.4.1
413 die <<EOT if $retval;
be5da30d »
2004-03-04 - version 0.0.4
414 The editor you chose ('$editor') could apparently not be run! Did you
415 mistype the name of your editor?
416
b22284e9 »
2004-05-17 - version 0.4.1
417 EOT
be5da30d »
2004-03-04 - version 0.0.4
418
419 }
420
421
ab940f67 »
2004-03-04 - reorganizing subs
422
423 #------------------------------------------------------------#
60312d6b »
2004-03-04 - version 0.1.0
424 # Action subs. #
425
42d74f6d »
2004-05-17 - version 0.3.1
426
427 # Display everything collected.
73c55913 »
2004-05-17 - version 0.5.0
428 sub dump_report {
28c84ea5 »
2004-05-17 - version 0.4.0
429 print "==> Dumping message...\n";
d13af730 »
2010-05-19 use PAGER if set.
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
28c84ea5 »
2004-05-17 - version 0.4.0
441 }
42d74f6d »
2004-05-17 - version 0.3.1
442
443
73c55913 »
2004-05-17 - version 0.5.0
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.
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
462 open my $BODY, '<', $tmpfile or die "Can't open '$tmpfile': $!";
73c55913 »
2004-05-17 - version 0.5.0
463 {
464 local $/;
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
465 $body = <$BODY>;
73c55913 »
2004-05-17 - version 0.5.0
466 }
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
467 close $BODY or die "Can't close '$tmpfile': $!";
73c55913 »
2004-05-17 - version 0.5.0
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
42d74f6d »
2004-05-17 - version 0.3.1
479 # Format the message with everything collected and return it.
480 sub format_message {
481 my $report = "";
60312d6b »
2004-03-04 - version 0.1.0
482
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
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
5ad437ab »
2004-03-04 - version 0.2.1
492 # OS, arch, compiler...
b22284e9 »
2004-05-17 - version 0.4.1
493 $report .= <<EOT;
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
494
5ad437ab »
2004-03-04 - version 0.2.1
495 ---
496 osname= $Config{osname}
497 osvers= $Config{osvers}
498 arch= $Config{archname}
b22284e9 »
2004-05-17 - version 0.4.1
499 EOT
5ad437ab »
2004-03-04 - version 0.2.1
500
501 my $cc = $Config{cc};
b4edd155 »
2007-03-18 Using warnings properly now.
502 #$report .= "cc= $cc $Config{${cc}.'version'}\n";
503 $report .= "cc= $cc\n";
5ad437ab »
2004-03-04 - version 0.2.1
504
505
506 # ... flags...
b22284e9 »
2004-05-17 - version 0.4.1
507 $report .= <<EOT;
60312d6b »
2004-03-04 - version 0.1.0
508 ---
509 Flags:
42d74f6d »
2004-05-17 - version 0.3.1
510 category=$report{category}
511 severity=$report{severity}
b22284e9 »
2004-05-17 - version 0.4.1
512 EOT
42d74f6d »
2004-05-17 - version 0.3.1
513 $report .= " ack=no\n" if ! $opts{ack};
514
60312d6b »
2004-03-04 - version 0.1.0
515 # ... myconfig ...
42d74f6d »
2004-05-17 - version 0.3.1
516 $report .= "---\n$parrot{myconfig}\n---\n";
60312d6b »
2004-03-04 - version 0.1.0
517
518 # ... and environment.
42d74f6d »
2004-05-17 - version 0.3.1
519 $report .= "Environment:\n";
60312d6b »
2004-03-04 - version 0.1.0
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;
2d089e3e »
2007-03-18 Commenting out old MacOS Classic-specific code so the warnings don't …
523 my %env;
524 @env{@env} = @env;
60312d6b »
2004-03-04 - version 0.1.0
525 for my $env (sort keys %env) {
b4edd155 »
2007-03-18 Using warnings properly now.
526 my $env_value = exists $ENV{$env} ? "=$ENV{$env}\n" : " (unset)\n";
527 $report .= " $env $env_value";
60312d6b »
2004-03-04 - version 0.1.0
528 }
42d74f6d »
2004-05-17 - version 0.3.1
529
530 return $report;
531 }
532
533
534 # Print synopsis + help message and exit.
535 sub help {
b22284e9 »
2004-05-17 - version 0.4.1
536 print <<EOT;
42d74f6d »
2004-05-17 - version 0.3.1
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
73ba72d1 »
2005-06-01 [perl #36057] [PATCH] Fix some typos - 5
547 developers. Only use --ok if *everything* was ok:
42d74f6d »
2004-05-17 - version 0.3.1
548 if there were *any* problems at all, use --nok.
549 --nok Report unsuccessful build on this system.
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
550 --summary <summary> Summary to include with the message.
42d74f6d »
2004-05-17 - version 0.3.1
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
b22284e9 »
2004-05-17 - version 0.4.1
568 EOT
42d74f6d »
2004-05-17 - version 0.3.1
569 exit;
60312d6b »
2004-03-04 - version 0.1.0
570 }
571
28c84ea5 »
2004-05-17 - version 0.4.0
572 # Save message to file.
73c55913 »
2004-05-17 - version 0.5.0
573 sub save_report {
28c84ea5 »
2004-05-17 - version 0.4.0
574 print "\n==> Saving message to file...\n";
575 if ( ! $opts{output} ) {
576 print "Enter filename to save bug report: ";
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
577 chomp($opts{output} = <STDIN>);
28c84ea5 »
2004-05-17 - version 0.4.0
578 }
579
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
580 open my $OUTPUT, ">", $opts{output}
581 or die "Cannot open '$opts{output}': $!";
582 print $OUTPUT format_message();
3db09f07 »
2011-07-10 Fix error message in parrotbug
583 close $OUTPUT or die "Cannot close '$opts{output}': $!";
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
584
585 print <<TRAC;
586 Message saved. Please go to
dc3d65bd »
2012-01-17 replace some references to trac.parrot.org with the appropriate links…
587 https://github.com/parrot/parrot/issues
588 and paste content of saved file into 'Description'
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
589 TRAC
28c84ea5 »
2004-05-17 - version 0.4.0
590 }
591
592
42d74f6d »
2004-05-17 - version 0.3.1
593
594 # Print version information (of the parrotbug program) and exit.
595 sub version {
b22284e9 »
2004-05-17 - version 0.4.1
596 print <<"EOT";
42d74f6d »
2004-05-17 - version 0.3.1
597
598 This is $0, version $VERSION.
599
b22284e9 »
2004-05-17 - version 0.4.1
600 EOT
42d74f6d »
2004-05-17 - version 0.3.1
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 {
73c55913 »
2004-05-17 - version 0.5.0
608 dump_report() if $opts{dump};
609 save_report() if $opts{save};
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
610 return if $opts{dump} || $opts{save};
42d74f6d »
2004-05-17 - version 0.3.1
611
612 # No actions provided on command-line, prompt for action.
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
613 print describe_actions();
42d74f6d »
2004-05-17 - version 0.3.1
614
615 my $action;
616 do {
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
617 print "Action (display,edit,save,quit): ";
42d74f6d »
2004-05-17 - version 0.3.1
618 $action = <STDIN>;
619 sw: for ($action) {
73c55913 »
2004-05-17 - version 0.5.0
620 dump_report(), last sw if /^d/i;
621 edit_report(), last sw if /^e/i;
622 save_report(), last sw if /^sa/i;
42d74f6d »
2004-05-17 - version 0.3.1
623 print "Uh?\n" unless /^q/i;
624 };
625 } until ( $action =~ /^q/i );
626 }
627
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
628 sub describe_actions {
629 my $str = <<ACTION;
42d74f6d »
2004-05-17 - version 0.3.1
630
ba03bd82 »
2011-07-09 Provide better description of final Action selections.
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 }
c31eb2df »
2004-03-28 pod belongs to the end of the script.
654 __END__
655
656 =head1 NAME
657
70fc35eb »
2010-07-19 Make POD conform to 'make html' expectations a bit more.
658 Parrot Bug Reporter
c31eb2df »
2004-03-28 pod belongs to the end of the script.
659
660 =head1 SYNOPSIS
661
b22284e9 »
2004-05-17 - version 0.4.1
662 % ./parrotbug [options] [actions]
663
c31eb2df »
2004-03-28 pod belongs to the end of the script.
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
b22284e9 »
2004-05-17 - version 0.4.1
670
cf25b153 »
2004-07-13 - taking credit for parrotbug
671 =head1 COMMAND-LINE SWITCHES
b22284e9 »
2004-05-17 - version 0.4.1
672
673
674 =head2 Options
675
676 Note: you will be prompted if the program miss some information.
c31eb2df »
2004-03-28 pod belongs to the end of the script.
677
678 =over 4
679
cf25b153 »
2004-07-13 - taking credit for parrotbug
680 =item B<--nok>
b22284e9 »
2004-05-17 - version 0.4.1
681
73ba72d1 »
2005-06-01 [perl #36057] [PATCH] Fix some typos - 5
682 Report unsuccessful build on this system to parrot developers.
c31eb2df »
2004-03-28 pod belongs to the end of the script.
683
cf25b153 »
2004-07-13 - taking credit for parrotbug
684 =item B<--ok>
c31eb2df »
2004-03-28 pod belongs to the end of the script.
685
73ba72d1 »
2005-06-01 [perl #36057] [PATCH] Fix some typos - 5
686 Report successful build on this system to parrot developers Only use
cf25b153 »
2004-07-13 - taking credit for parrotbug
687 C<--ok> if B<everything> was ok; if there were B<any> problems at all,
b22284e9 »
2004-05-17 - version 0.4.1
688 use C<--nok>.
c31eb2df »
2004-03-28 pod belongs to the end of the script.
689
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
690 =item B<--summary>
c31eb2df »
2004-03-28 pod belongs to the end of the script.
691
3d4130bb »
2009-03-04 [cage] Committing a modified version of Patrick's patch from TT #27.
692 Summary of the report. You will be prompted if you don't supply one on
b22284e9 »
2004-05-17 - version 0.4.1
693 the command-line.
c31eb2df »
2004-03-28 pod belongs to the end of the script.
694
cf25b153 »
2004-07-13 - taking credit for parrotbug
695 =item B<--category>
c31eb2df »
2004-03-28 pod belongs to the end of the script.
696
b22284e9 »
2004-05-17 - version 0.4.1
697 Category of the bug report. You will be prompted if you don't supply
698 one on the command-line.
c31eb2df »
2004-03-28 pod belongs to the end of the script.
699
cf25b153 »
2004-07-13 - taking credit for parrotbug
700 =item B<--severity>
c31eb2df »
2004-03-28 pod belongs to the end of the script.
701
b22284e9 »
2004-05-17 - version 0.4.1
702 Severity of the bug report. You will be prompted if you don't supply
703 one on the command-line.
704
cf25b153 »
2004-07-13 - taking credit for parrotbug
705 =item B<--address>
b22284e9 »
2004-05-17 - version 0.4.1
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
cf25b153 »
2004-07-13 - taking credit for parrotbug
710 =item B<--editor>
b22284e9 »
2004-05-17 - version 0.4.1
711
712 Editor to use for editing the bug report.
713
cf25b153 »
2004-07-13 - taking credit for parrotbug
714 =item B<--output-file>
c31eb2df »
2004-03-28 pod belongs to the end of the script.
715
b22284e9 »
2004-05-17 - version 0.4.1
716 File where parrotbug will save its bug report, if you ask it to do so.
c31eb2df »
2004-03-28 pod belongs to the end of the script.
717
b22284e9 »
2004-05-17 - version 0.4.1
718 =back
c31eb2df »
2004-03-28 pod belongs to the end of the script.
719
720
b22284e9 »
2004-05-17 - version 0.4.1
721 =head2 Actions
c31eb2df »
2004-03-28 pod belongs to the end of the script.
722
b22284e9 »
2004-05-17 - version 0.4.1
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.
c31eb2df »
2004-03-28 pod belongs to the end of the script.
725
b22284e9 »
2004-05-17 - version 0.4.1
726 =over 4
727
cf25b153 »
2004-07-13 - taking credit for parrotbug
728 =item B<--dump>
b22284e9 »
2004-05-17 - version 0.4.1
729
730 Dump formatted report on standard output.
731
cf25b153 »
2004-07-13 - taking credit for parrotbug
732 =item B<--save>
b22284e9 »
2004-05-17 - version 0.4.1
733
734 Save message to a file, in order for you to send it later from your
735 own. See C<--output> flag.
c31eb2df »
2004-03-28 pod belongs to the end of the script.
736
cf25b153 »
2004-07-13 - taking credit for parrotbug
737 =item B<--help>
b22284e9 »
2004-05-17 - version 0.4.1
738
739 Print a short synopsis and exit.
740
cf25b153 »
2004-07-13 - taking credit for parrotbug
741 =item B<--version>
c31eb2df »
2004-03-28 pod belongs to the end of the script.
742
743 Print version information and exit.
744
07b9ecee »
2004-03-06 A bit of refactoring of the POD parser to integrate Parrot-specific f…
745 =back
746
b22284e9 »
2004-05-17 - version 0.4.1
747
cf25b153 »
2004-07-13 - taking credit for parrotbug
748 =head1 SEE ALSO
749
750 perlbug(1), parrot(1), diff(1), patch(1)
07b9ecee »
2004-03-06 A bit of refactoring of the POD parser to integrate Parrot-specific f…
751
752 =cut
753
b4edd155 »
2007-03-18 Using warnings properly now.
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.