copyrite copyright writer

diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..35b320a
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,14 @@
+use strict;
+use warnings;
+use inc::Module::Install 0.91;
+
+name('copyrite');
+author('Matt S Trout <mst@shadowcat.co.uk>');
+license('perl');
+version('0.001');
+
+requires 'IO::All';
+
+install_script 'copyrite-gen';
+
+WriteAll;

diff --git a/copyrite-gen b/copyrite-gen
new file mode 100644 (file)
index 0000000..592e87f
--- /dev/null
+++ b/copyrite-gen
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+
+use strict; use warnings FATAL => 'all';
+
+use IO::All qw(io);
+use List::Util qw(first min max);
+
+sub vwarn { warn $_[0] if $ENV{COPYRITE_VERBOSE} }
+
+my $fname = shift @ARGV;
+
+unless ($fname and $fname =~ /\.pm$/) {
+  die "You didn't supply me a filename or it didn't end in .pm - please
+invoke me as $0 lib/Foo/Bar.pm or similar";
+}
+
+my %head_section; @head_section{qw(AUTHOR AUTHORS CONTRIBUTORS)} = (1,1,1);
+
+my @lines = io($fname)->getlines;
+
+my @use = grep $head_section{$_}, map { /^=head1 (\w+)/ ? ($1) : () } @lines;
+
+die "Couldn't find =head1 sections for any of ".join(' ', keys %head_section)
+  unless @use;
+
+vwarn "Found =head1 sections for: ".join(' ', @use)." in ${fname}\n";
+
+my $changes = first { -e $_ } qw(Changes ChangeLog);
+
+die "Couldn't find Changes or ChangeLog file :(" unless $changes;
+
+my @changes = io($changes)->getlines;
+
+my @years = map /(200\d|199\d)/g, grep /^\S/, @changes;
+
+vwarn "Found years: ".join(' ', @years)." in ${changes}\n";
+
+vwarn "Patch follows:\n\n\n";
+
+my ($min_year, $max_year) = (min(@years), max(@years));
+
+my $year_set = do {
+  if ($max_year > $min_year) {
+    "${min_year} - ${max_year}"
+  } else {
+    "${max_year}"
+  }
+};
+
+my $section_links = join ' and ', map "L</${_}>", @use;
+
+my $pname = join '::', map { s/\.pm//; $_ } grep /^[A-Z]/, split /\//, $fname;
+
+my $pod = <<"END";
+  =head1 COPYRIGHT
+
+  Copyright (c) ${min_year} - ${max_year}
+  the ${pname} ${section_links}
+  as listed above.
+
+END
+
+$pod =~ s/^  //mg;
+
+print $pod;