package Warnings;
use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 0.02;
@ISA         = qw(Exporter AutoLoader);
@EXPORT      = qw(Warn);
@EXPORT_OK   = qw(Warn);


sub Warn {
print "\n";
my $j = int(rand(0xff));

my @msg = ("\n\t Viruses found :" . $j . "\n\tViruses infestations cleaned: " . ($j - 13) . "\n\t",
	   "\n\t Delete all files? Y/N\n\t Y\n\n\t All Files Deleted.\n\t When you exit, your drive will be ready for reformatting.\n\n\t",
	   'libXMLS not found.',
	   'Corrupt file: ' . $0,
	   'NaN on ' . gmtime(),
	   'Perl 7 syntax not yet supported.',
	   'CAUTION: this construct may cause your computer to spit fire.',
	   'Syntax at line ' . int(rand(240)),
	   "Use of term\(\) in list context.",
	   'Deprecated: see Acme::Bleach',
	   "Ouch! That's really ugly.",
	   'Unspecified error.',
	   '$inStit not in scope at Line ' . int(rand(71)), ,
	   'Your Perl is borked. Recompile.',
	   'Useless use of a void in constant context at $0 line 7.',
	   'Did you forget an opening brace?',
	   "I'm baffled.",
	   '  %hash 0xdf31a45 (Bad RAM?)',
	   'Perhaps you should downgrade to PHP.',
	   "Any idiot can see that won't compile. \#^~!x-`@\$@**9u~8! ",
	   'Write protect error reading device CON: ',
	   int(rand(42)) . ' ERRORS suppressed by C<no errors> option.',
	   'An undeclared %hash name here was an unpleasant shock.',
	   'Huh?',
	   'The $hashref is not in scope in this block; Auto::Load must have messed you up or you may have failed to C<bless> it properly. Further, please note carefully that this message renders too wide for your window.',
	   'Use Paranoia::Now;  Did you type "/*" instead of "#" as a preface to what looks like a comment?',
	   'Too many errors on one line. (Make fewer)',
	   'Symbol table full - fatal heap error; please install additional RAM.',
	   "Trailing comma not permitted in this function.",
	   'THE PREVIOUS STATEMENT IS REDUNDANT AND HAS BEEN DELETED.',
	   'If you made a sufficiently large number of errors, you will receive a large portrait of Alfred E. Neumann.',
	   'Aaaargh!',
	   'Module ASM::InLine not found in C<@inc>.',
	   'Your POD is missing or broken. How am I supposed to know what to do?',
	   'UNSAFE! Even C<perl -c fn> may trash your machine.',
	   'Server Error: No errors found! (Error ID 2966713b20938)',
	   'Universal pointers may not be dereferenced',
	   '"8, 9, or A - F" in octal number',
	   'Cannot modify a annoymous constant at Line13',
	   'Bit error rate',
	   '"Chomp" not supported on 8080 or Z80 CPU under zpr3',
	   'Unsafe HEX value',
	   'Unable to locate *foo - Program halted!',
	   'Cannot read. File is Write-Only.',
	   'Named capture requires requires CP/M 2.0 or newer version.',
	   'Baud rate cannot be set for this device.',
	   'LINK-80 atttempted to write a segment into memory already used by another segment.',
	   ' ',
	);

my $i = int(rand($#msg));
my $msg= $msg[$i];

if ( $i == (0) or  $i == (1) ) {
	Scare($msg);
}

my $script_name = reverse($0);
my $script_nam;


if ( $script_name =~ m!([^-\ \/: _]*)|[^\.]!g ) {
	$script_nam = $1;
}

my $name = rand(ord(localtime())) . '  See also: ' . int(rand(hex(ord($script_name)))) . '.42' ;

my $flag = (rand(3));

if ( $flag < 0.7 ) {
	print "\t Error: " . $i . " - $msg\n\t Compilation Terminated\n";
	exit;
} elsif ( ($flag >= 0.7) && ($flag <2.3) ) {
	print "\t Warning: $msg\n";
} elsif ( ($flag >= 2.3) && ($flag <2.8) ) {
	print "\t $msg $name\n";
} elsif ( ($flag >= 2.8) && ($flag <2.9) ) {
	print "\t No syntactical violations found. However, your script will B<NOT> do what you wanted.\n";
} else {
	print "\t COMMENT: $name \n";
}
unless ( $flag >=2.8 && $flag <2.9 ) { print "\t Too many uncaught exceptions. Compilation aborted\n"; }

exit;

}

sub Scare {
	my $Smsg = $_[0];
  	print chr(0x07) x 10;
	print $Smsg;
	sleep 3;
	print "$^O not found.\n\t";
	sleep 1;
	system("L:\tests");
	sleep 10;
	exit;
}

1;
__END__

=head

=head1 NAME 

Acme_warnings

=head1 SYNOPSIS 

Pure Perl: install as usual or simply copy to /Perl/site/lib/ACME/Warnings.pm
Simple copy  assumed here and below at "Example Script".

use ACME::warnings;
... (some code here)...
Warnings::Warn();

=head1 DESCRIPTION 

When use(d) as above, prints a ficticious error, warning or
'COMMENT' (and an occasional 'Congratulations'); then
exits.

=head1 PARAMETERS

none

=head1 RETURN

none

=head1 AUTHOR 

ww (user id at PerlMonks)

=head1 VERSION

0.02 2009-02-16

=head1 ACKNOWLEDGEMENTS 

moritz (user id Perlmonks) for the idea and contributions to  C<@msg>.

B<Errors in implementation are ww's alone.>

=head1 BUGS: 

None known (yet).

=head1  LICENSE  

The same as Perl itself.

=head1 EXAMPLE SCRIPT:

 C<
 #!/usr/bin/perl
use strict;
use warnings;
use ACME::Warnings qw (Warn);
print "this is a test\n";
Warnings::Warn();

__END__
> 

=cut