File Coverage

blib/lib/LCC/Documents.pm

Criterion	Covered	Total	%
statement	3	19	15.7
branch			n/a
condition	0	5	0.0
subroutine	1	11	9.0
pod	3	4	75.0
total	7	39	17.9

package LCC::Documents;

# Make sure we do everything by the book
# Set modules to inherit from
# Set version information

use strict;
@LCC::Documents::ISA = qw(LCC);
$LCC::Documents::VERSION = '0.02';

# Return true value for use

1;

#------------------------------------------------------------------------

# The following methods are class methods

#------------------------------------------------------------------------

# The following methods change the object

#------------------------------------------------------------------------

#  IN: 1 instantiated object
#      2 reference to subroutine

sub browse_url { shift->_variable( 'browse_url',@_ ) } #browse_url

#------------------------------------------------------------------------

#  IN: 1 instantiated object
#      2 reference to subroutine

sub conceptual_url { shift->_variable( 'conceptual_url',@_ ) } #conceptual_url

#------------------------------------------------------------------------

#  IN: 1 instantiated object
#      2 reference to subroutine

sub fetch_url { shift->_variable( 'fetch_url',@_ ) } #fetch_url

#------------------------------------------------------------------------

#  IN: 1 instantiated object
#      2 servername to be used (default: `hostname`)
#      3 extension to be used (default: 'html')

sub server {

# Obtain the object
# Set default browse_url subroutine
# Set default conceptual_url subroutine
# Set default fetch_url subroutine

  my $self = shift;
  $self->browse_url( $self->_browse_url );
  $self->conceptual_url( $self->_conceptual_url );
  $self->fetch_url( $self->_fetch_url( @_ ) );
} #server

#------------------------------------------------------------------------

# The following subroutines are for internal use only

#------------------------------------------------------------------------

#  IN: 1 instantiated object
# OUT: 1 code reference for default browse URL handler

sub _browse_url { sub {undef} } #_browse_url

#------------------------------------------------------------------------

#  IN: 1 instantiated object
# OUT: 1 code reference for default conceptual URL handler

sub _conceptual_url { sub {$_[0]} } #_conceptual_url

#------------------------------------------------------------------------

#  IN: 1 instantiated object
#      2 servername to be used (default: `hostname`)
#      3 extension to be used (default: 'html')
# OUT: 1 code reference for default fetch URL handler

sub _fetch_url {

# Obtain the object
# Obtain the hostname, make sure it's clean
# Obtain the extension
# Return the code reference

  my $self = shift;
  chomp( my $server = shift || `hostname` );
  my $extension = shift || 'html';
  return sub {"http://$server/$_[0].$extension"};
} #_fetch_url

#------------------------------------------------------------------------

# The following subroutines deal with standard Perl features

#------------------------------------------------------------------------

__END__