view release on metacpan or  search on metacpan

lib/Dist/PolicyFiles.pm  view on Meta::CPAN

  my %args = (dir => '.', prefix => q{}, @_);
  state $allowed = {map {$_ => undef} qw(dir
                                         email
                                         full_name
                                         login
                                         module
                                         prefix
                                         uncapitalize)};
  $args{uncapitalize} = !!$args{uncapitalize};
  foreach my $arg (keys(%args)) {
    croak("$arg: unsupported argument") if !exists($allowed->{$arg});
    croak("$arg: value is not a scalar") if ref($args{$arg});
  }
  delete @args{ grep { !defined $args{$_} } keys %args };
  do {croak("$_: missing mandatory argument") if !exists($args{$_})} for (qw(login module));
  my $self = bless(\%args, $class);
  if (!(exists($self->{email}) && exists($self->{full_name}))) {
    my $udata = get_user_data_from_ssh_cfg($self->{login});
    $self->{email} //= $udata->{email2} // $udata->{email}
      // die("Could not determine email address");      # Should never happen.
    $self->{full_name} //= $udata->{full_name}
      // die("Could not determine user's full name");   # Should never happen.
  }
  $self->{_module_0} = (split(/,/, $self->{module}))[0];
  $self->{_module_0_dashed} = $self->{_module_0} =~ s/::/-/gr;
  return $self;
}


sub dir          {$_[0]->{dir}}
sub email        {$_[0]->{email}}
sub full_name    {$_[0]->{full_name}}
sub login        {$_[0]->{login}}
sub module       {$_[0]->{module}}
sub prefix       {$_[0]->{prefix}}
sub uncapitalize {$_[0]->{uncapitalize}}

sub cpan_rt_url {
  return "https://rt.cpan.org/NoAuth/ReportBug.html?Queue=" . $_[0]->{_module_0_dashed};
}

sub repo_name {
  my $self = shift;
  my $mod_dashed = $self->{_module_0_dashed};
  return $self->{prefix} . ($self->{uncapitalize} ? lc($mod_dashed) : $mod_dashed);
}

sub github_url {
  my $self = shift;
  return "https://github.com/$self->{login}/" . $self->repo_name;
}



sub create_contrib_md {
  my $self = shift;
  my $contrib_md_tmpl = shift;
  croak('Unexpected argument(s)') if @_;
  croak('Missing --module: no module specified') unless exists($self->{module});
  my $contrib_md_tmpl_str = defined($contrib_md_tmpl) ?
    do { local ( *ARGV, $/ ); @ARGV = ($contrib_md_tmpl); <> } : INTERNAL_CONTRIB_MD;
  my $tmpl_obj = Text::Template->new(SOURCE => $contrib_md_tmpl_str, TYPE => 'STRING')
    or croak("Couldn't construct template: $Text::Template::ERROR");
  my $tmpl_vars = {cpan_rt  => $self->cpan_rt_url,
                   github_i => $self->github_url . "/issues",
                  };
  @{$tmpl_vars}{qw(email full_name module)} = @{$self}{qw(email full_name module)};
  my $contrib = $tmpl_obj->fill_in(HASH => $tmpl_vars)
    // croak("Couldn't fill in template: $Text::Template::ERROR");
    open(my $fh, '>', catfile($self->{dir}, 'CONTRIBUTING.md'));
    print $fh ($contrib, "\n");
    close($fh);
}



sub create_security_md {
  my $self = shift;
  my %args = (maintainer => sprintf("%s <%s>", @{$self}{qw(full_name email)}),
              program    => $self->{module},
              @_);
  if (!exists($args{url})) {
    (my $m = $self->{module}) =~ s/::/-/g;
    $m = lc($m) if $self->{uncapitalize};
    $args{url} = "https://github.com/$self->{login}/$self->{prefix}${m}/blob/main/SECURITY.md";
  }
  delete @args{ grep { !defined $args{$_} || $args{$_} eq q{}} keys %args };
  open(my $fh, '>', catfile($self->{dir}, 'SECURITY.md'));
  print $fh (Software::Security::Policy::Individual->new(\%args)->fulltext);
  close($fh);
}


1; # End of Dist::PolicyFiles


__END__

=pod

=head1 NAME

Dist::PolicyFiles - Generate CONTRIBUTING.md and SECURITY.md

=head1 VERSION

Version 0.09

=head1 SYNOPSIS

    use Dist::PolicyFiles;

    my $obj = Dist::PolicyFiles->new(login => $login_name, module => $module);
    $obj->create_contrib_md();
    $obj->create_security_md();

=head1 DESCRIPTION

This module is used to generate the policy files F<CONTRIBUTING.md> and
F<SECURITY.md>. It comes with the L<dist-policyfiles> command line tool.