src/perl/lib/OpenSRF.pm

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