How can I deprecate behavior while retaining API? - perl

I have an API that I would like to change the behavior of. I originally made method is_success mean a "green light", but a "red light" is not exceptional, it still means the light is working properly. I would now like is_success to only be false in the event of a suggestion, and have added is_green and is_red (note: there are also statuses "yellow" and "purple") to my API to complement specific checks ( currently yellow and purple throw exceptions, but may get status checks later ).
Is there any good way that I can give warnings from the code that the behavior is changing? or has changed? while allowing those warnings to be turned off if the user is aware? (note: have already put a deprecation notice in the change log )

You could use Perl's lexical warnings categories. There is a deprecated category or you could register the package/module as a warnings category.
{
package My::Foo;
use warnings;
sub method {
(#_ <= 2) or warnings::warnif('deprecated', 'invoking ->method with ... ')
}
}
{
package My::Bar;
use warnings;
use warnings::register;
sub method {
(#_ <= 2) or warnings::warnif('invoking ->method with ... ')
}
}
{
use warnings;
My::Foo->method(1);
My::Foo->method(1, 2);
My::Bar->method(1, 2);
}
{
no warnings 'deprecated';
My::Foo->method(1, 2);
no warnings 'My::Bar';
My::Bar->method(1, 2);
}
See warnings and perllexwarn

Yes, you can use the warn command. It will display warnings but they can also be trapped by specifying an empty sub for $SIG{'WARN'}, which will stop the messages from deing displayed.
# warnings are thrown out with this BEGIN block in your code.
BEGIN {
$SIG{'__WARN__'} = sub { }
}
# prints the warning to STDOUT, if $SIG{'__WARN__'} is set to the default
warn "uh oh, this is deprecated!";
See the perdocs for more info and additional examples, http://perldoc.perl.org/functions/warn.html and http://perldoc.perl.org/perllexwarn.html.

I've always found the method used by MIME::Head useful and amusing.
This method has been deprecated. See "decode_headers" in MIME::Parser for the full reasons. If you absolutely must use it and don't like the warning, then provide a FORCE:
"I_NEED_TO_FIX_THIS"
Just shut up and do it. Not recommended.
Provided only for those who need to keep old scripts functioning.
"I_KNOW_WHAT_I_AM_DOING"
Just shut up and do it. Not recommended.
Provided for those who REALLY know what they are doing.
The idea is that the deprecation warning can be suppressed only by providing a magic argument that documents why the warning is being suppressed.

Related

Call subroutine automatically whenever cursor position changes in a Text widget

I am using the Tk::Text module.
I want that whenever the user changes the position of the cursor inside the Tk::Text module, it should act as a trigger to call a subroutine which I have written.
How do I go about implementing this?
EDIT:
As answered by Donal Fellows, I somehow need to find if the insert mark is changed when a call is made to the markSet routine. I have searched the net extensively to find a solution to this problem, but to no avail. Now I need you guys to help me with it. Thanks!
There isn't a predefined callback for when the location of the insert mark changes (that's the terminology you're looking for) but it is always set via the markSet method. Maybe you can put something in to intercept calls to that method, see if they're being applied to insert, and do your callback? (That's certainly how I'd do it in Tcl/Tk; I don't know how easy it is to intercept methods on the Perl side of things but surely it must be possible?)
This is what https://stackoverflow.com/a/22356444/2335842 is talking about, see http://p3rl.org/perlobj and http://p3rl.org/Tk::Widget and http://p3rl.org/require for details
#!/usr/bin/perl --
use strict; use warnings;
use Tk;
Main( #ARGV );
exit( 0 );
BEGIN {
package Tk::TText;
$INC{q{Tk/TText.pm}}=__FILE__;
use parent qw[ Tk::Text ];
Tk::Widget->Construct( q{TText} );
sub markSet {
warn qq{#_};
my( $self, #args ) = #_;
$self->SUPER::markSet( #args );
}
}
sub Main {
my $mw = tkinit();
$mw->TText->pack;
use Tk::WidgetDump; $mw->WidgetDump; ## helps you Tk your Tk
$mw->MainLoop;
}
__END__
Tk::TText=HASH(0x10f7a74) insert #347,218 at - line 13.
Tk::TText=HASH(0x10f7a74) anchor insert at - line 13.

Perl - Pattern for verbosity levels?

I have a basic function for printing messages of verbosity levels in a perl package:
# 0 = no output, 1 = debug output
our $verbosity = 0;
sub msg {
(my $verbLevel, my $format, my #addArgs) = #_;
if ($verbLevel <= $verbosity) {
printf($format, #addArgs);
}
}
This is IMO an elegant solution inside the package, because to print a debug message I can simply do:
msg(1, "Some debug message");
However, in practice this package is being 'used' in a long chain of packages, each of which also uses a verbosity feature. Let's say the chain of usage is like this: entry.pl > package0.pm > package1.pm > package2.pm. Each file must set the verbosity flag of the next in order for each to work right.
I now think this is an inelegant solution because of duplicate code and the requirement for each "parent file" to set each of it's children's verbosity level. What I would like to happen is for each *.pm file to inherit the verbosity level and function from entry.pl.
Is there a design pattern I can follow to share a verbosity functionality across packages? Is there a module out there that can already do this?
Perhaps look at Log::Log4Perl - either as a model to work from for your own implementation or as a potential replacement.

How to properly use the try catch in perl that error.pm provides?

I have found that there is the module Error that provides try and catch functionality like in java. But I am confused at how you can print the exception that returns.
I would like to understand how to do the following
try {
// do something that will fail!
} catch (Error e) {
// Print out the exception that occurred
System.out.println(e.getMessage());
}
How do I get the print of the error with the stack trace?
You're probably better off using Try::Tiny which will help you avoid a number of pitfalls with older perls.
use Try::Tiny;
try {
die "foo";
} catch {
warn "caught error: $_";
};
Last I checked, Error was deprecated. But here's how you would do it without that module:
eval {
die "Oops!";
1;
} or do {
my $e = $#;
print("Something went wrong: $e\n");
};
Basically, use eval instead of try, die instead of throw, and look for the exception in $#. The true value at the end of the eval block is part of an idiom to prevent $# from unintentionally changing before it is used again in Perl versions older than 5.14, see P::C::P::ErrorHandling::RequireCheckingReturnValueOfEval for details. For example, this code suffers from this flaw.
# BAD, DO NOT USE WITH PERLS OLDER THAN 5.14
eval {
die "Oops!";
};
if (my $e = $#) {
print("Something went wrong: $e\n");
}
# BAD, DO NOT USE WITH PERLS OLDER THAN 5.14
But note that many Perl operations do not raise exceptions when they fail; they simply return an error code. This behavior can be altered via autodie for builtins and standard modules. If you're using autodie, then the standard way of doing try/catch is this (straight out of the autodie perldoc):
use feature qw(switch);
eval {
use autodie;
open(my $fh, '<', $some_file);
my #records = <$fh>;
# Do things with #records...
close($fh);
};
given ($#) {
when (undef) { say "No error"; }
when ('open') { say "Error from open"; }
when (':io') { say "Non-open, IO error."; }
when (':all') { say "All other autodie errors." }
default { say "Not an autodie error at all." }
}
For getting a stacktrace, look at Carp.
If you want something a bit more powerful than Try::Tiny, you might want to try looking at the TryCatch module in CPAN.
Native try/catch/finally.
Perl now has native support for try/catch/finally. You can use it like this. As of Perl v5.36, It's currently experimental.
use experimental "try";
try { die 42 }
catch ($err) {
print "got $err"
}
Unfortunately TryCatch has been broken with the new version 0.006020 of Devel::Declare and there seems to be no intention of fixing it. The perl core developers team also complained about the funky stuff TryCatch was relying on to make it work.
Instead there is a new implementation called Nice::Try, which is a perfect replacement.
There is no need to have semi colon on the last brace like Try::Tiny.
You can also do exception variable assignment like
try
{
# something
}
catch( $e )
{
# catch this in $e
}
It also works using class exception like
try
{
# something
}
catch( Exception $e )
{
# catch this in $e
}
And it also supports finally. Its features set make it quite unique.
Full disclosure: I have developed this module when TryCatch got broken.
IMHO Syntax::Keyword::Try is a better option than Try::Tiny for most cases.
Try::Tiny is an order of magnitude slower than either eval or Syntax::Keyword::Try. It depends on your application if this is a problem or not. For many applications its not important.
Also if you are a visitor from another language, Try::Tiny has syntax quirks which make it not quite the try/catch you are used to.
As has been said, the old Error module is deprecated, but it has continued to work for me long after. It's been a while since I last checked if its still working. I tried some of the "better" replacements and found them all lacking, so I still use Error.
Here's a sample from some code that's pretty straight forward and prints the error that was caught. This is from an app I wrote that uses Storable to store and retrieve serialized perl objects to an MLDBM backend file.
use Error(':try');
...
try {
$obj = retrieve( $objfile );
} catch Error::Simple with {
my $E = shift;
warn "Caught error $E";
};
This returns a message something like:
Caught error Not a HASH reference at ./json2text.pl line 12.
If you want the full stack trace, you can either run the code under the debugger, or you can read about the stacktrace method on the perldoc for the Error class itself. I never found it necessary to have apps not running under the debugger to print full stack traces, so I don't have any examples of that in my collection to paste a sample from.
I hope this helps. Sometimes you just have to wait for a dinosaur to show up.

Catching errors with both mod_cgi & mod_perl

Thanks to everyone in advance.
I've been doing some research on error handling and I don't feel like I'm getting a solid understanding of what I should do.
Preamble: My code is living in Apache and executed in the browser, my goals don't include command line execution.
I'd like to have the behavior of CGI::Carp (fatalsToBrowser) with the ability to capture the output and be able to throw it in my own templated page, email it etc... I did notice that fatalsToBrowser doesn't work with mod_perl. Does anyone know why? How is Apache/mod_perl getting in the way?
First Goal: I'd like to put something together that works if the code is being executed with mod_perl or mod_cgi.
Second Goal: I'd like to have a high-level method(s) that catches all the errors similar to .NET's Application_Error (in global.asax) and PHP's set_exception_handler() and set_error_handler() methods. These allow you to take control when an error is raised, without wrapping code in messy/gross try-catch statements.
Things I've read/reviewed:
1.) OO Exception Handling in Perl, but wasn't what I was looking for. Most of the stuff I want to catch is die()ing. The next link also says that this article is out of date and deprecated.
2.) Perl: $SIG{__DIE__}, eval { } and stack trace, but I didn't get much from this related to my goals.
3.) Practical Mode Perl (O'Reilly), Chapter 21 "Error Handling and Debugging". Thankfully all my perl code uses strict and warnings are enabled, and most important things mentioned in Chapter 6 "Coding with mod_perl in Mind" are already done.
4.) I've dug through the tables of contents in "Learning Perl", "Perl Cookbook", "Programming Perl" and "Higher Order Perl" and didn't see anything that stuck out at me. If you think I missed something there please let me know. :)
I don't remember where (maybe in "Practical mod_perl", but I've read that you should not mess with $SIG{__DIE__}.
Have you read the mod_perl website's bit on Alternative Exception Handling Techniques? It discusses about how you can catch uncaught exceptions though the use of overriding the global die() function instead of using $SIG{__DIE__}. A much cleaner method but not perfect.
What type of errors are you trying to catch? Are custom error pages not sufficient for your purposes?
My CGI scripts are short (OK, this is really bare bones — and untested):
#!/usr/bin/perl
use strict;
use warnings;
use My::App;
use My::ErrorReporter qw( error_to_html );
run();
sub run {
my $app = eval {
My::App->new(
'some_param',
'another_param',
)
};
unless ( $app ) {
print error_to_html( $# );
return;
}
eval {
$app->handle_request;
} and return;
print error_to_html( $# );
return;
}
__END__
Now, fatalsToBrowser is not for your users. That is a development aid for you. The error messages users see should not convey information about the program. So, for example, in a routine that opens and reads a configuration file, you should do something like:
sub read_my_config {
my $self = shift;
open my $config_h, '<', $self->config_file;
unless ( $config_h ) {
# This goes to the Apache error log where you can read it
warn sprintf(
"Cannot open '%s': %s",
$self->config_file, $!
);
# This is for web site visitors to see
die "Cannot open configuration file";
}
# rest of the code
}

How can I access the Apache server configuration in a BEGIN block in mod_perl?

I've been trying to switch from using PerlSetEnv to using custom configuration directives. I have my configuration module with a copy of set_val from the docs:
sub set_val
{
local our ($key, $self, $parms, $arg) = #_;
$self->{$key} = $arg;
unless ($parms->path)
{
local our $srv_cfg = Apache2::Module::get_config($self, $parms->server);
$srv_cfg->{$key} = $arg;
}
}
...which is called by every custom directive sub. Then I have in my .conf:
PerlLoadModule MyModule::ServerConfig
MyCustomDirective 'hello'
This works fine in that httpd -t okays the file's syntax. The problem is that I can't seem to get at the value from the config file from within a BEGIN block, which I need to do.
I've tried tinkering with all sorts of things:
BEGIN
{
use Apache2::CmdParms ();
# use Apache2::Directive ();
use Apache2::Module ();
# use Apache2::ServerUtil ();
# use Apache2::RequestUtil ();
use Data::Dump;
warn ddx(Apache2::Module::get_config('MyModule::ServerConfig', Apache2::CmdParms->server));
# warn ddx(Apache2::Directive->as_hash);
# warn Apache2::ServerUtil->dir_config('MyCustomDirective);
# warn Apache2::CmdParms->server->server_hostname();
}
...but to no avail. Most of my efforts (trying to access CmdParms->server for instance) result in Parent: child process exited with status 3221225477 -- Restarting and an automatic restart of Apache as it says. If I pass ServerUtil->server to get_config(), the server stays alive but the warning only prints out '1'.
I read somewhere that this is because you can't get at anything request-related within a BEGIN block, because requests vary. It kind of makes sense, except that with PerlOptions +GlobalRequest I have been able to see $ENV within a BEGIN block, so why wouldn't I be able to see my own directives, just as dependent as they are on how the request happens? Especially confusing is that if I try to pass Apache2::RequestUtil->request->per\_dir\_config() to get_config(), it says Global $r object is not available. If that's true in a BEGIN block, how is it I can get at $ENV?
Try add what you want to import function to other module and use this module in code where you usually put BEGIN block. It should work same. May be it helps.
Partly, Dump isn't being used correctly. This works better:
use Data::Dump qw(pp);
warn pp(Apache2::Module::get_config('MyModule::ServerConfig', Apache2::ServerUtil->server));
However, it doesn't show any directives that appear within <Directory> blocks.
In my particular case, though, I don't need that functionality, on second thought; that just happens to be where I had stuck them.