Perl procedural return two stack call levels

Question

My question is similar to: Is it possible for a Perl subroutine to force its caller to return? but I need procedural method.

I want to program some message procedure with return, example essential code:

sub PrintMessage {
    #this function can print to the screen and both to logfile
    print "Script message: $_[0]\n";
}

sub ReturnMessage {
    PrintMessage($_[0]);
    return $_[2];  #  <-- we thinking about *this* return
}

sub WorkingProc {
    PrintMessage("Job is started now");
    #some code
    PrintMessage("processed 5 items");

    # this should return from WorkingProc with given exitcode
    ReturnMessage("too many items!",5) if $items>100;

    #another code
    ReturnMessage("time exceded!",6) if $timespent>3600;
    PrintMessage("All processed succesfully");
    return 0;
}

my $ExitCode=WorkingProc();
#finish something
exit $ExitCode

Idea is, how to use return inside ReturnMessage function to exit with specified code from WorkingProc function? Notice, ReturnMessage function is called from many places.

Answer 1

This isn't possible. However, you can explicitly return:

sub WorkingProc {
    PrintMessage("Job is started now");
    ...
    PrintMessage("processed 5 items");

    # this returns from WorkingProc with given exitcode
    return ReturnMessage("to much items!", 5) if $items > 100;

    ...
    return ReturnMessage("time exceded!", 6) if $timespent > 3600;
    PrintMessage("All processed succesfully");
    return 0;
}

A sub can have any number of return statements, so this isn't an issue.

Such a solution is preferable to hacking through the call stack, because the control flow is more obvious to the reader. What you were dreaming of was a kind of GOTO, which most people not writing C or BASIC etc. have given up 45 years ago.

Your code relies on exit codes to determine errors in subroutines. *Sigh*. Perl has an exception system which is fairly backwards, but still more advanced than that.

Throw a fatal error with die "Reason", or use Carp and croak "Reason". Catch errors with the Try::Tiny or TryCatch modules.

sub WorkingProc {
    PrintMessage("Job is started now");
    ...
    PrintMessage("processed 5 items");

    # this should return from WorkingProc with given exitcode
    die "Too much items!" if $items > 100;

    ...
    die "Time exceeded" if $timespent > 3600;
    PrintMessage("All processed succesfully");
    return 0;
}

WorkingProc();

If an error is thrown, this will exit with a non-zero status.