view release on metacpan or  search on metacpan

lib/Changes.pm  view on Meta::CPAN

                    line => ( $i + 1 ),
                    (
                        ( defined( $re->{nl} ) && defined( $re->{space} ) )
                            ? ( nl => ( $re->{space} // '' ) . ( $re->{nl} // '' ) )
                            : ( nl => undef )
                    ),
                    raw => $l,
                    debug => $debug
                ));
            }
            else
            {
                warn( "I found an empty line outside a release and no release object to associate it to.\n" ) if( $self->_warnings_is_enabled );
                # $releases->push( $self->new_line );
                $nls->push( $self->new_line( raw => $l, debug => $debug ) );
            }
        }
        # Preamble
        elsif( $elements->is_empty )
        {
            $preamble->append( $l );
        }
        # Epilogue
        # We found a line with no leading space with new blank lines before it and no epilogue yet, or maybe no blank lines, but with epilogue already set.
        elsif( $l =~ /^(\S+.*?)(?<nl>[\015\012]+)?$/ms && 
               (
                   ( !$nls->is_empty && !defined( $epilogue ) ) ||
                   ( defined( $epilogue ) && !defined( $release ) && !defined( $group ) && !defined( $change ) )
               ) &&
               # If elements are empty this would rather be part of the preamble
               !$elements->is_empty )
        {
            my $re = { %+ };
            if( !$nls->is_empty )
            {
                $elements->push( $nls->list );
                $nls->reset;
                undef( $release );
                undef( $change );
                undef( $group );
                $epilogue = $self->new_scalar( $l );
                $self->epilogue( $epilogue );
            }
            else
            {
                $epilogue->append( $l );
            }
        }
        else
        {
            chomp( $l );
            warn( "Found an unrecognisable line: '$l'\n" ) if( $self->_warnings_is_enabled );
        }
    }
    $self->elements( $elements );
    return( $self );
}

sub preamble { return( shift->_set_get_scalar_as_object({
    field => 'preamble',
    callbacks => 
    {
        set => sub
        {
            my( $self, $text ) = @_;
            if( defined( $text ) && $text->defined )
            {
                unless( $text =~ /[\015\012]$/ms )
                {
                    $text->append( $self->nl // "\n" );
                }
                unless( $text =~ /[\015\012]{2,}$/ms )
                {
                    $text->append( $self->nl // "\n" );
                }
            }
            return( $text );
       },
    }
}, @_ ) ); }

sub preset
{
    my $self = shift( @_ );
    my $set  = shift( @_ ) || return( $self->error( "No set name was provided." ) );
    my $sets =
    {
        standard =>
        {
            # for Changes::Release
            datetime_formatter => sub
            {
                my $dt = shift( @_ ) || DateTime::Lite->now;
                require DateTime::Format::Lite;
                my $fmt = DateTime::Format::Lite->new(
                    pattern => '%FT%T%z',
                    locale => 'en_GB',
                );
                $dt->set_formatter( $fmt );
                my $tz = $self->time_zone;
                $dt->set_time_zone( $tz ) if( $tz );
                return( $dt );
            },
            # No need to provide it if it is just a space though, because it will default to it anyway
            spacer => ' ',
            # for Changes::Change
            spacer1 => "\t",
            spacer2 => ' ',
            marker => '-',
            max_width => 72,
            # wrapper => $code_reference,
            # for Changes::Group
            group_spacer => "\t",
            group_type => 'bracket', # [Some group]
        }
    };
    return( $self->error( "Set requested ($set) is not supported." ) ) if( !exists( $sets->{ $set } ) );
    my $def = $sets->{ $set };
    $self->defaults( $def );
    return( $self );
}