1.61KiB; Perl | 2020-09-25 19:36:59+02 | Statements 30 | SLOC 59
1
#!/usr/bin/perl
2
3
package Devel::FIXME::Rules::PerlFile;
4
use base qw/Devel::FIXME/;
5
6
use strict;
7
use warnings;
8
9
use Devel::FIXME qw/:constants/;
10
11
my @rules;
12
my $rulesfile;
13
14
BEGIN {
15
	my $base = $ENV{FIXME_RULEFILE} || '/.fixme/rules.pl';
16
	$rulesfile = $ENV{HOME} . $base;
17
}
18
19
sub rules {
20
	my $self = shift;
21
22
	if(!@rules) {
23
		if((!$ENV{FIXME_NOFILTER}} and (-f $rulesfile)) {
24
			@rules = @{ require $rulesfile };
25
		} else {
26
			@rules = ( sub { return SHOUT } );
27
		}
28
	}
29
30
	return @rules;
31 1
}
32
33 1
__PACKAGE__
34
35
__END__
36
37
=pod
38
39
=head1 NAME
40
41
Devel::FIXME::Rules::PerlFile - Support for rules stored as perl code in a file.
42
43
=head1 SYNOPSIS
44
45
	% vim ~/.fixme/rules.pl
46
47
=head1 DESCRIPTION
48
49
The file in the L<SYNOPSIS>, or the file specified by the C<FIXME_RULEFILE>
50
environment variable, needs to return an array reference, containing code
51
references.
52
53
These code references are the rules that are applied as methods on the fixme
54
object.
55
56
=head1 EXAMPLE
57
58
This is a really silly rules file, but it does show what you can do:
59
60
	[
61
		sub {
62
			my $self = shift;
63
			# discard any file that is writable (assume not checked in to SCM)
64
			return DROP unless -w $self->{file};
65
		},
66
		sub {
67
			my $self = shift;
68
			# any FIXME's in my dir are warned about
69
			return SHOUT if $self->{file} =~ m!my/src/dir/!;
70
		},
71
	];
72
73
The fixme object contains some fields. See L<Devel::FIXME>'s implementation.
74
75
=head1 AUTHOR
76
77
Yuval Kogman <nothingmuch@woobling.org>
78
79
=head1 COPYRIGHT & LICNESE
80
81
	Copyright (c) 2004 Yuval Kogman. All rights reserved
82
	This program is free software; you can redistribute
83
	it and/or modify it under the same terms as Perl itself.
84
85
=head1 SEE ALSO
86
87
L<Devel::FIXME>