.svn/pristine/60/6005276799cde29242f7fafd85d544e1e74ba30e.svn-base

   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$
   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$ =~ /\$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
 139 =head2 can
 140
 141      $obj->can('METHOD');
 142      Class::Modular->can('METHOD');
 143
 144 Replaces UNIVERSAL's can method so that handled methods are reported
 145 correctly. Calls UNIVERSAL::can in the places where we don't know
 146 anything it doesn't.
 147
 148 Returns a coderef to the method if the method is supported, undef
 149 otherwise.
 150
 151 =cut
 152
 153 sub can{
 154      my ($self,$method,$vars) = @_;
 155
 156      my $universal_can = UNIVERSAL::can($self,$method);
 157
 158      if ($universal_can){
 159           return $universal_can;
 160      }
 161      elsif (ref $self and exists $self->{ref_fields}->{lc($method)}) {
 162           # If there is no other method for dealing with this method,
 163           # and we would normally autoload it, create an anonymous sub
 164           # to deal with it appropriately.
 165           return sub{my $self = shift; return $self->ref_field($method,@_);};
 166      }
 167      else {
 168           return undef;
 169      }
 170 }
 171
 172
 173 =head2 _init
 174
 175      $self->_init
 176
 177 =cut
 178
 179 sub _init($){
 180      my $self = shift;
 181
 182      # ref_fields is used by AUTOLOAD to know when it's ok to set a
 183      # particular field
 184      my @ref_fields = $self->ref_fields;
 185      @{$self->{ref_fields}}{@ref_fields} = (1) x scalar @ref_fields;
 186 }
 187
 188
 189
 190
 191
 192 # From http://www.ecst.csuchico.edu/~jacobsd/bib/formats/
 193
 194 #     * BibTeX
 195 #     * INSPEC
 196 #     * MARC [MARC::Record]
 197 #     * Melvyl [Uses MARC]
 198 #     * RIS
 199 #     * MedLine
 200 #     * ISI Focus On
 201 #     * EMBL
 202 #     * BIDS
 203 #     * ProCite
 204 #     * EndNote
 205 #     * Computing Archives
 206 #     * Uniform Resource Citation
 207 #     * RFC 1807 (replaces RFC 1357)
 208 #     * Other formats
 209
 210
 211
 212
 213
 214
 215 1;
 216
 217
 218 __END__
 219
 220
 221
 222
 223
 224