File Coverage

blib/lib/Software/License/Custom.pm

Criterion	Covered	Total	%
statement	50	54	92.5
branch	11	18	61.1
condition	1	2	50.0
subroutine	16	17	94.1
pod	12	12	100.0
total	90	103	87.3

use strict;
use warnings;
package Software::License::Custom;
# ABSTRACT: custom license handler
$Software::License::Custom::VERSION = '0.104004';
use parent 'Software::License';

use Carp;
use Text::Template;

#pod =head1 DESCRIPTION
#pod
#pod This module extends L to give the possibility of specifying
#pod all aspects related to a software license in a custom file.  This allows for
#pod setting custom dates, notices, etc. while still preserving compatibility with
#pod all places where L is used, e.g. L.
#pod
#pod In this way, you should be able to customise some aspects of the licensing
#pod messages that would otherwise be difficult to tinker, e.g. adding a note
#pod in the notice, setting multiple years for the copyright notice or set multiple
#pod authors and/or copyright holders.
#pod
#pod The license details should be put inside a file that contains different
#pod sections. Each section has the following format:
#pod
#pod =begin :list
#pod
#pod = header line
#pod
#pod This is a line that begins and ends with two underscores C<__>. The string
#pod between the begin and the end of the line is first depured of any non-word
#pod character, then used as the name of the section;
#pod
#pod = body
#pod
#pod a L (possibly a plain text file) where items to be
#pod expanded are enclosed between double braces
#pod
#pod =end :list
#pod
#pod Each section is terminated by the header of the following section or by
#pod the end of the file. Example:
#pod
#pod    __[ NAME ]__
#pod    The Foo-Bar License
#pod    __URL__
#pod    http://www.example.com/foo-bar.txt
#pod    __[ META_NAME ]__
#pod    foo_bar_meta
#pod    __{ META2_NAME }__
#pod    foo_bar_meta2
#pod    __{ SPDX_EXPRESSION }__
#pod    foo_bar_spdx_expression
#pod    __[ NOTICE ]__
#pod    Copyright (C) 2000-2002 by P.R. Evious
#pod    Copyright (C) {{$self->year}} by {{$self->holder}}.
#pod
#pod    This is free software, licensed under {{$self->name}}.
#pod
#pod    __[ LICENSE ]__
#pod                The Foo-Bar License
#pod
#pod    Well... this is only some sample text.  Verily... only sample text!!!
#pod
#pod    Yes, spanning more lines and more paragraphs.
#pod
#pod The different formats for specifying the section name in the example
#pod above are only examples, you're invited to use a consistent approach.
#pod
#pod =method new
#pod
#pod    my $slc = Software::License::Custom->new({filename => 'LEGAL'});
#pod
#pod Create a new object. Arguments are passed through an anonymous hash, the
#pod following keys are allowed:
#pod
#pod   filename - the file where the custom software license details are stored
#pod
#pod =cut

sub new {
   my ($class, $arg) = @_;

   my $filename = delete $arg->{filename};

   my $self = $class->SUPER::new($arg);

   $self->load_sections_from($filename) if defined $filename;

   return $self;
}

#pod =method load_sections_from
#pod
#pod    $slc->load_sections_from('MY-LEGAL-ASPECTS');
#pod
#pod Loads the different sections of the license from the provided filename.
#pod
#pod Returns the input object.
#pod
#pod =cut

sub load_sections_from {
   my ($self, $filename) = @_;

   # Sections are kept inside a hash
   $self->{'Software::License::Custom'}{section_for} = \my %section_for;

   my $current_section = '';
   open my $fh, '<', $filename or croak "open('$filename'): $!";

   while (<$fh>) {
      if (my ($section) = m{\A __ (.*) __ \n\z}mxs) {
         ($current_section = $section) =~ s/\W+//gmxs;
      }
      else {
         $section_for{$current_section} .= $_;
      }
   }
   close $fh;

   # strip last newline from all items
   s{\n\z}{}mxs for values %section_for;

   return $self;
}

#pod =method section_data
#pod
#pod    my $notice_template_reference = $slc->section_data('NOTICE');
#pod
#pod Returns a reference to a textual template that can be fed to
#pod L (it could be simple text), according to what is
#pod currently loaded in the object.
#pod
#pod =cut

sub section_data {
   my ($self, $name) = @_;
   my $section_for = $self->{'Software::License::Custom'}{section_for} ||= {};
   return unless exists $section_for->{$name};
   return unless defined $section_for->{$name};
   return \$section_for->{$name};
}

#pod =head1 MORE METHODS
#pod
#pod The following methods, found in all software license classes, look up and
#pod render the template with the capitalized form of their name.  In other words,
#pod the C method looks in the C template.
#pod
#pod For now, the C and C methods return C if called
#pod on the class.  This may become fatal in the future.
#pod
#pod =for :list
#pod * name
#pod * url
#pod * meta_name
#pod * meta2_name
#pod * license
#pod * notice
#pod * fulltext
#pod * version
#pod
#pod =cut

sub name       { shift->_fill_in('NAME') }
sub url        { shift->_fill_in('URL') }

sub meta_name  {
   my $self = shift;
   return 'custom' unless ref $self;
   return $self->_fill_in('META_NAME')
}

sub meta2_name {
  my $self = shift;
  return 'custom' unless ref $self;
  $self->_fill_in('META2_NAME')
}

sub spdx_expression  {
   my $self = shift;
   return undef unless ref $self;
   return $self->_fill_in('SPDX_EXPRESSION')
}

sub license    { shift->_fill_in('LICENSE') }
sub notice     { shift->_fill_in('NOTICE') }

sub fulltext {
   my ($self) = @_;
   return join "\n", $self->notice, $self->license;
}

sub version {
   my ($self) = @_;
   return unless $self->section_data('VERSION');
   return $self->_fill_in('VERSION')
}

1;

__END__