Howdy,
I toyed around with symbol table manipulation and `use
overload::constant', but it seems that neither of those is appropriate
here. I finally implemented crap!1 using a source filter, which is
nowhere near as elegant as your original solution. Do with it as you
please, I had fun writing it anyway. The contextual diff follows, the
full source is attached.
Your young apprentice,
Victor Adam
--- old/Crap.pm 2013-03-22 15:39:28.461728689 +0100
+++ /home/grimy/perl/lib/site_perl/5.16.2/Acme/Crap.pm 2013-03-22
16:11:50.153755536 +0100
@@ -7,57 +7,32 @@
use strict;
use Carp;
-sub deref { my ($self) = @_; return ${$self}; }
+use Perl6::Export::Attrs;
+use Filter::Simple;
-use overload (
- q{!} => sub { Acme::Crap::Negated->new(&deref) },
- q{""} => \&deref,
- q{0+} => \&deref,
- q{bool} => \&deref,
-
- fallback => 1,
-);
-
-sub import {
- overload::constant q => sub { my $val = $_[1]; bless \$val, 'Acme::Crap' };
-
- no strict qw( refs );
- *{caller().'::crap'} = sub {
- local $Acme::Crap::no_negation = 1;
- @_ = map {"$_"} @_;
- goto &Carp::carp;
- }
-}
-
-package Acme::Crap::Negated;
-
-sub new {
- my ($class, $val) = @_;
- bless { val => $val, degree => 1 }, $class;
+FILTER_ONLY code_no_comments => sub {
+ # Pass trailing '!'s and '1's as the first argument to crap
+ # '§'s are supported for compatibility with azerty keyboards
+ s/ \b crap \b ( [!1§]* ) /crap q{$1},/gxms;
+};
+
+sub crap : Export(:DEFAULT) {
+ my ($suffix, @args) = @_;
+ $args[0] //= q{I just don't know what went wrong};
+ @_ = map { _emphasize(length $suffix, $_) } @args, $suffix;
+ goto &Carp::carp;
}
-sub value {
- my ($self) = @_;
- if ($Acme::Crap::no_negation) {
- given ($self->{degree}) {
- when (1) { return ucfirst "$self->{val}!" }
- when (2) { return join q{}, map { ucfirst $_ } split
/(\s+)/, "$self->{val}!!" }
- default { return uc $self->{val} . '!' x $_ }
- }
+sub _emphasize {
+ my ($degree, $msg) = @_;
+ given ($degree) {
+ when (0) { $msg }
+ when (1) { ucfirst $msg }
+ when (2) { join q{}, map { ucfirst $_ } split /(\s+)/, $msg }
+ default { uc $msg }
}
- return !$self->{val} if $self->{degree} % 2;
- return !!$self->{val};
}
-use overload (
- q{!} => sub { my ($self) = @_; $self->{degree}++; return $self; },
- q{""} => \&value,
- q{0+} => \&value,
- q{bool} => \&value,
-
- fallback => 1,
-);
-
1; # Magic true value required at end of module
__END__
@@ -111,8 +86,19 @@
=head1 DEPENDENCIES
-None.
+Acme::Crap depends on the following modules:
+
+=over
+
+=item *
+
+Perl6::Export::Attrs;
+
+=item *
+
+Filter::Simple;
+=back
=head1 INCOMPATIBILITIES
===END DIFF===
2013/3/21 damian@conway.org via RT <bug-Acme-Crap@rt.cpan.org>:
Show quoted text> <URL:
https://rt.cpan.org/Ticket/Display.html?id=84030 >
>
> Hi Victor,
>
> I'd be delighted to receive a patch for Acme::Crap!!!!11111!!!!11111
> Feel free to send it along any time.
>
>
>> Your faithful student,
>
> Hmmmm. More like: <Palpatine>My young...apprentice!</Palpatine>
>
>>;-)
>
> Damian
>
