package TrapWarnings;

my %Modules;
BEGIN { $SIG{__WARN__} = \ &trapWarning; }

sub import {
     $Modules{caller} = 1;
}

sub trapWarning {
     my $caller = caller 1;
     if ($Module{$caller}) {
          set_dberror(join('',@_))
     } else {
          warn @_
     }
}

# Example use

package Foo;

use TrapWarnings;

warn "foo";