lib/Reference.pm

   1 # This module is part of , and is released
   2 # under the terms of the GPL version 2, or any later version. See the
   3 # file README and COPYING for more information.
   4 # Copyright 2003 by Don Armstrong <don@donarmstrong.com>.
   5 # $Id: Reference.pm 44 2013-09-10 00:37:13Z don $
   6
   7 package Reference;
   8
   9 =head1 NAME
  10
  11 Reference -- Reference superclass
  12
  13 =head1 SYNOPSIS
  14
  15
  16 =head1 DESCRIPTION
  17
  18
  19 =head1 BUGS
  20
  21 None known.
  22
  23 =cut
  24
  25
  26 use strict;
  27 use vars qw($VERSION $REVISION $DEBUG);
  28 use Carp;
  29
  30
  31 BEGIN{
  32      $REVISION = '0.01';
  33      ($REVISION) = q$LastChangedRevision: 44 $ =~ /\$LastChangedRevision:\s+([^\s+])/;
  34      $DEBUG = 0 unless defined $DEBUG;
  35 }
  36
  37 our $AUTOLOAD;
  38
  39
  40 =head2 new
  41
  42      my $reference = new Reference;
  43
  44
  45 Creates a new reference object
  46
  47 =cut
  48
  49 sub new{
  50      my $class = shift;
  51
  52      $class = ref $class if ref $class;
  53
  54      my $self = {};
  55
  56      bless $self, $class;
  57
  58      $self->_init;
  59
  60      return $self;
  61 }
  62
  63
  64 =head2 ref_fields
  65
  66      @$self->{ref_fields}{$self->ref_fields} = (1) x $self->ref_fields;
  67
  68 Returns the fields that this reference knows how to deal with (or that
  69 should be dealt with using ref_fields).
  70
  71 This default implementation returns an empty list, and as such should
  72 be overriden by all Reference::Type subclasses.
  73
  74 =cut
  75
  76 sub ref_fields{
  77      my $self = shift;
  78
  79      return ();
  80 }
  81
  82
  83 =head2 ref_field
  84
  85      $reference->ref_field('author',['John Q. Smith', 'Randal P. Swag']);
  86
  87 Sets the reference field to the passed value (if any) and returns the
  88 new value. This function is called through AUTOLOAD using the
  89 $reference->field() syntax.
  90
  91 Returns the new setting of passed field.
  92
  93 Scalar fieldname, and an optional scalar, arrayref, or hashref to set
  94 reference field.
  95
  96 =cut
  97
  98 sub ref_field($$;$){
  99      my ($self,$field_name,$field_value) = @_;
 100
 101      if ($self->{ref_fields}->{lc($field_name)}) {
 102           # Check to make sure that only 3 arguments are passed to
 103           # avoid triggering on the Params::Variable style of calling.
 104           # XXX We should check explicitly for this. [See Author.pm]
 105           if (defined $field_value and scalar(@_) == 3) {
 106                $self->{reference}->{lc($field_name)} = $field_value;
 107           }
 108           return $self->{reference}->{lc($field_name)};
 109      }
 110      carp "Invalid field name $field_name";
 111 }
 112
 113
 114 =head2 AUTOLOAD
 115
 116 Dispatches calls to $reference->fieldname to
 117 $reference->ref_field('fieldname').
 118
 119 XXX I really wish there was a way to tell perl that we don't want to
 120 XXX handle a call to AUTOLOAD.
 121
 122 =cut
 123
 124 sub AUTOLOAD{
 125      my $function = $AUTOLOAD;
 126      ($function) = $function =~ /\:?([^\:]+)$/;
 127      my $self = shift;
 128      if (ref $self and $self->{ref_fields}->{lc($function)}) {
 129           # slap $self and $function into @_.
 130           unshift @_, ($self,$function);
 131           goto &ref_field;
 132      }
 133      else {
 134           croak "Undefined subroutine $function";
 135      }
 136 }
 137
 138 # do nothing
 139 sub DESTROY {
 140
 141 }
 142
 143
 144 =head2 can
 145
 146      $obj->can('METHOD');
 147      Class::Modular->can('METHOD');
 148
 149 Replaces UNIVERSAL's can method so that handled methods are reported
 150 correctly. Calls UNIVERSAL::can in the places where we don't know
 151 anything it doesn't.
 152
 153 Returns a coderef to the method if the method is supported, undef
 154 otherwise.
 155
 156 =cut
 157
 158 sub can{
 159      my ($self,$method,$vars) = @_;
 160
 161      my $universal_can = UNIVERSAL::can($self,$method);
 162
 163      if ($universal_can){
 164           return $universal_can;
 165      }
 166      elsif (ref $self and exists $self->{ref_fields}->{lc($method)}) {
 167           # If there is no other method for dealing with this method,
 168           # and we would normally autoload it, create an anonymous sub
 169           # to deal with it appropriately.
 170           return sub{my $self = shift; return $self->ref_field($method,@_);};
 171      }
 172      else {
 173           return undef;
 174      }
 175 }
 176
 177
 178 =head2 _init
 179
 180      $self->_init
 181
 182 =cut
 183
 184 sub _init($){
 185      my $self = shift;
 186
 187      # ref_fields is used by AUTOLOAD to know when it's ok to set a
 188      # particular field
 189      my @ref_fields = $self->ref_fields;
 190      @{$self->{ref_fields}}{@ref_fields} = (1) x scalar @ref_fields;
 191 }
 192
 193
 194
 195
 196
 197 # From http://www.ecst.csuchico.edu/~jacobsd/bib/formats/
 198
 199 #     * BibTeX
 200 #     * INSPEC
 201 #     * MARC [MARC::Record]
 202 #     * Melvyl [Uses MARC]
 203 #     * RIS
 204 #     * MedLine
 205 #     * ISI Focus On
 206 #     * EMBL
 207 #     * BIDS
 208 #     * ProCite
 209 #     * EndNote
 210 #     * Computing Archives
 211 #     * Uniform Resource Citation
 212 #     * RFC 1807 (replaces RFC 1357)
 213 #     * Other formats
 214
 215
 216
 217
 218
 219
 220 1;
 221
 222
 223 __END__
 224
 225
 226
 227
 228
 229