DemofaFC.pm
From DLXS Documentation
$DLXSROOT/cgi/f/findaid/DemofaFC.pm version 1.3
package DemofaFC;
BEGIN
{
# enable strict under development
if ( $ENV{'DLPS_DEV'} )
{
require "strict.pm";
strict::import();
}
}
use FindaidClass;;
use vars qw( @ISA );
@ISA = qw( FindaidClass );
use CGI;
use DlpsUtils qw( :DEFAULT );
# ----------------------------------------------------------------------
# NAME : _initialize
# PURPOSE : create structure for TextClass object
# CALLED BY : new
# CALLS :
# INPUT : see new
# RETURNS :
# NOTES :
# ----------------------------------------------------------------------
sub _initialize
{
my $self = shift;
my ( $collid, $cio, $optionalArgsHashRef ) = @_;
$self->SUPER::_initialize( @_ );
# Here we have changed the names of many of the TOC heads
#Note that bioghist now has only one label here
#We have also added two new TOC heads for <relatedmaterial> and <separatedmaterial> and corresponding
# fabricated regions sepmaterial, sepmaterial-t, relmaterial, relmaterial-t in demofa.extra.srch
$self->SetSelfKeyInfo( 'tocheads' =>
{
# 'bioghist-t' => {
# 'collection' => qq{Biography},
# 'recordgrp' => qq{History},
# },
# This provides a default heading if there is no <head> element in the <bioghist>
# it replaces the Bentley-specific code above.
# Note that we also must change sub GetBioghistTocHead below so it doesn't use or expect the values above.
'bioghist-t' => qq{Biographical/Historical Note },
# 'controlaccess-t' => qq{Subject Terms},
'controlaccess-t' => qq{Subjects},
'frontmatter-t' => qq{Title Page},
'arrangement-t' => qq{Arrangement},
'scopecontent-t' => qq{Collection Scope and Content Note},
# 'summaryinfo-t' => qq{Summary Information},
'summaryinfo-t' => qq{Abstract},
'contentslist-t' => qq{Contents List},
# 'admininfo-t' => qq{Access and Use},
'admininfo-t' => qq{Administrative Information},
# 'add-t' => qq{Additional Descriptive Data},
'sepmaterial-t' => qq{Separated Material},
'relmaterial-t' => qq{Related Material},
}
);
}
#----------------------------------------------------------------------
#
# Replacement to use <head> within Biohist for label
# ----------------------------------------------------------------------
# NAME : GetBioghistTocHead
# NOTES : The original code in the base class uses a query based on the encoding
# practice of the Bentley Historical Library at the University of
# Michigan. Though the distinction between
# "collections" (papers of indiviudals) and "records" or "record group"
# (records of organizations) is an archival distinction, the use of the
# archdesc attribute to determine the label is probably a BHL idiosyncracy.
# Our practice goes back to early discussions that whenever possible the
# system / stylesheet should supply standard headings.
# Most libraries probably hard code a <head>, in which case it would be
# necessary to overide this method in as is done in the example below.
# ----------------------------------------------------------------------
sub GetBioghistTocHead
{
my $self = shift;
my ( $cgi ) = @_;
my $headText = '';
$headText = $self->GetSelfKeyInfo( 'bioghistheader' );
if ( $headText )
{
return $headText;
}
my $tocheadsHashRef = $self->GetSelfKeyInfo( 'tocheads' );
# get properly idno properly formatted for query
my $idno = ( $cgi->param( 'idno' ) || $cgi->param( 'didno' ) );
$idno = $self->GetQueryFactory()->pat50TruncationHandler( $idno );
# get region in which to look for idno
my $idnoRgn;
my $tm = $self->GetTermMapper( );
ASSERT( $idnoRgn = $tm->map( 'IDNO', 'synthetic', 'native' ),
qq{ID not defined in map: } . $tm->GetMapfileName() );
my $xpat = $self->FindXPatContainingIdno( $idno );
#Modifications to the base class version start here.
# Instead of the query that looked for the "level" attribute of the <archdesc>
# we use a query to get the first <head> within <bioghist>
# If it is not found we use the default label in the tocheads above.
# subset1.1 to get the first head in case there are more than one?
my $query = qq{pr.region."head" subset.1.1 (region "head" within (region "bioghist" within (region main incl ( $idnoRgn incl $idno )) ));};
my ( $error, $head ) = $xpat->GetSimpleResultsFromQuery( $query );
&DlpsUtils::StripAllRSetCruft( \$head );
if ($head)
{
$headText="$head";
}
else
{
#use default
$headText = $$tocheadsHashRef{ 'bioghist-t' };
}
$self->{ 'bioghistheader' } = $headText;
return $headText;
}
# ######################################################################
# return truth
1;
# ######################################################################
__END__;
