OpenSRF/src/perlmods/OpenSRF.pm

   1 package OpenSRF;
   2 use strict;
   3 use Error;
   4 require UNIVERSAL::require;
   5 use vars qw/$VERSION $AUTOLOAD/;
   6 $VERSION = do { my @r=(q$Revision$=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
   7
   8 =head1 OpenSRF
   9
  10 =cut
  11
  12 =head2 Overview
  13
  14  Top level class for OpenSRF perl modules.
  15
  16 =cut
  17
  18 # Exception base classes
  19 #use Exception::Class
  20 #       ( OpenSRFException => { fields => [ 'errno' ] });
  21 #push @Exception::Class::ISA, 'Error';
  22
  23 =head3 AUTOLOAD()
  24
  25  Traps methods calls for methods that have not been defined so they
  26  don't propogate up the class hierarchy.
  27
  28 =cut
  29 sub AUTOLOAD {
  30         my $self = shift;
  31         my $type = ref($self) || $self;
  32         my $name = $AUTOLOAD;
  33         my $otype = ref $self;
  34
  35         my ($package, $filename, $line) = caller;
  36         my ($package1, $filename1, $line1) = caller(1);
  37         my ($package2, $filename2, $line2) = caller(2);
  38         my ($package3, $filename3, $line3) = caller(3);
  39         my ($package4, $filename4, $line4) = caller(4);
  40         my ($package5, $filename5, $line5) = caller(5);
  41         $name =~ s/.*://;   # strip fully-qualified portion
  42         warn <<"        WARN";
  43 ****
  44 ** ${name}() isn't there.  Please create me somewhere (like in $type)!
  45 ** Error at $package ($filename), line $line
  46 ** Call Stack (5 deep):
  47 **      $package1 ($filename1), line $line1
  48 **      $package2 ($filename2), line $line2
  49 **      $package3 ($filename3), line $line3
  50 **      $package4 ($filename4), line $line4
  51 **      $package5 ($filename5), line $line5
  52 ** Object type was $otype
  53 ****
  54         WARN
  55 }
  56
  57
  58
  59 =head3 alert_abstract()
  60
  61  This method is called by abstract methods to ensure that
  62  the process dies when an undefined abstract method is called
  63
  64 =cut
  65 sub alert_abstract() {
  66         my $c = shift;
  67         my $class = ref( $c ) || $c;
  68         my ($file, $line, $method) = (caller(1))[1..3];
  69         die " * Call to abstract method $method at $file, line $line";
  70 }
  71
  72 sub class { return scalar(caller); }
  73
  74 1;