use strict;

#!/usr/bin/perl -w

use strict;
use Data::Dumper;

# wherever you start, you can't go any further left.
my @spectrum = qw ( cc pd sa samplingplus sampling nd fc );

# once you add a restrictor, you cannot remove it.
my @restrictors = qw ( nc by );

my %valid = map {$_, 1} (@spectrum, @restrictors);

#######################################################

my @licenses;

unless(scalar(@ARGV)>1)
{
my $help =<<'HELP';

Copyright 2005 Greg London

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

This script takes two or more Creative Commons licenses
and will tell you if they are compatible or not.
If the licenses are compatible, this script will print
out the license that results from combining them.

For example, to test out CC-NC-SA combined with CC-PD,

%> cc.pl cc-nc-sa cc-by
%> The licenses combine to 'cc-sa-nc-by'

Error: expected at least two licenses on command line.

http://www.greglondon.com

HELP
;
print $help;
exit;
}

# go through @ARGV and modify it to fit valid input
my %translation_table =
(
cc=>'cc',
pd=>'pd',
sa=>'sa',
samplingplus=>'samplingplus',
sampling=>'sampling',
nd=>'nd',
fc=>'fc',

creativecommons=>'cc',
publicdomain=>'pd',
sharealike=>'sa',
noderivatives=>'nd',
noderivs=>'nd',
founders=>'fc',
founderscopyright=>'fc',

nc=>'nc',
by=>'by',

noncommercial=>'nc',
attribution=>'by',
);

foreach my $lici (@ARGV)
{
my @elements;
my @arguments = sort(split(/\-/, $lici));
foreach my $arg (@arguments)
{
$arg = lc($arg); # warn "arg is $arg";
my $tla = $translation_table{$arg};
unless(exists($valid{$tla}))
{ die "dont know $arg ($tla)"; }
push(@elements, $tla);
}
push(@licenses,
{
elements => \@elements,
string => $lici,
} );
}

# print Dumper \@licenses;

#######################################################
# create a spectrum lookup table
my %spectrum_lookup;
for (my $i=0; $i<scalar(@spectrum); $i++)
{
my $key = $spectrum[$i];
$spectrum_lookup{$key} = $i;
}

#######################################################
# go through each license and locate it on spectrum

foreach my $licinfo (@licenses)
{
$licinfo->{location}=0;
my $location;
my @restrictions;
$licinfo->{restrictors}=\@restrictions;
foreach my $ele (@{$licinfo->{elements}})
{
next if ($ele eq 'cc');
if(exists($spectrum_lookup{$ele}))
{
if(defined($location))
{
my $lic = $licinfo->{string};
die "Error: $ele in $lic";
}
$location = $spectrum_lookup{$ele};
$licinfo->{location}=$location;
# warn "ele '$ele' at location '$location'";
}
else
{
push(@restrictions, $ele);
}
}
}

#######################################################
# go through each license and see if it is sharealike

foreach my $licinfo1 (@licenses)
{
$licinfo1->{sharealike}=0;
foreach my $ele (@{$licinfo1->{elements}})
{
$licinfo1->{sharealike}=1 if($ele eq 'sa');
}
}

#######################################################
# go through all the licenses. if there is a share alike
# license, make sure all the other licenses are to the left
# of the sharealike license. If there is another sharealike,
# make sure it has the same restrictors.
# if either of these rules are broken, then licenses
# cannot be combined.

for(my $i=0; $i<scalar(@licenses); $i++)
{
my $lic_i = $licenses[$i];
my $sa_i = $lic_i->{sharealike};
my $str_i = $lic_i->{string};
if($sa_i)
{
for(my $j=$i+1; $j<scalar(@licenses); $j++)
{
next if ($j == $i);

my $lic_j = $licenses[$j];
my $sa_j = $lic_j->{sharealike};
my $str_j = $lic_j->{string};
if($sa_j)
{
# if two sharealike licenses,
# then restrictors must be the same
my @res_i = sort(@{$lic_i->{restrictors}});
my @res_j = sort(@{$lic_j->{restrictors}});

warn "comparing $str_i and $str_j";
unless(scalar(@res_i) == scalar(@res_j))
{
die "Error: conflicting ShareAlike licenses, $str_i and $str_j";
}
for(my $k=0; $k<scalar(@res_i); $k++)
{
my $i_restrictor = $res_i[$k];
my $j_restrictor = $res_j[$k];
unless($i_restrictor eq $j_restrictor)
{
die "Error: conflicting ShareAlike licenses, $str_i and $str_j";
}
}
}
else
{
# j is not sharealike, make sure it is to the left of i
my $spectrum_i = $lic_i->{location};
my $spectrum_j = $lic_j->{location};
unless($spectrum_j < $spectrum_i)
{
die "Error: ShareAlike license '$str_i' cannot combine with more restrictive license '$str_j'";
}
}

}
}
}

#######################################################
# go through all the licenses and find most restrictive position on spectrum
# this will be the spectrum location of final license

my $location = 0;
foreach my $licinfo (@licenses)
{
my $thisloc = $licinfo->{location};

if($thisloc > $location)
{
$location = $thisloc;
}
}

my @final_license = ( 'cc', $spectrum[$location] );

#######################################################
# go through all the licenses and get all the restrictors
# all restrictors in original license must carry over to final license.

my %final_restrictors;

foreach my $licinfo (@licenses)
{
my @these_restrictors = @{$licinfo->{restrictors}};
foreach my $this_restrictor (@these_restrictors)
{
$final_restrictors{$this_restrictor}=1;
}
}

push(@final_license, keys(%final_restrictors));
#######################################################

#print Dumper \@licenses;

#print Dumper \@final_license;

# now print out the final license

my $final_lic_str = join('-', @final_license);

print "The licenses combine to '$final_lic_str'\n";