view release on metacpan or  search on metacpan

lib/App/cpan2arch/WritePkgbuild.pm  view on Meta::CPAN

        if ( defined $x_spdx ) {
            # Install license file whether IDs from SPDX expression exist in licenses package.
            foreach my $id ( split /\s+(?> AND | OR )\s+/x, $x_spdx ) {
                $_install_license = true unless exists $arch_licenses{$id};
            }

            push $_generated_meta{license}->@*, $x_spdx if defined $opts{update};

            return "license=('$x_spdx')";
        }
    }

    # Process metadata's license array.

    my $nl     = '';
    my $indent = '';
    my $SPACE  = q{ };
    my $START  = '(';
    my $END    = ')';
    my $array  = $START;

    # Multiline and indent the array string.
    my sub multiline_array ()
    {
        $nl     = "\n";
        $indent = $SPACE x 4;
        $array  = "${START}$nl";
    }

    multiline_array() if scalar $meta{license}->@* > 1;

    # Pre-process licenses to get their info.
    my @licenses;
    {
        my $NOTE = 'Unknown SPDX ID; manual inspection is advised.';

        foreach my ( $idx, $license ) ( indexed $meta{license}->@* ) {
            my $desc =
                $license eq 'open_source'  ? 'Other Open Source Initiative (OSI) approved license.'
              : $license eq 'restricted'   ? 'Requires special permission from copyright holder.'
              : $license eq 'unrestricted' ? 'Not an OSI approved license, but not restricted.'
              : $license eq 'unknown'      ? 'License not provided in metadata.'
              :                              ();

            if ( defined $desc ) {
                multiline_array() if $idx == 0;

                $_install_license = true;

                push @licenses, {
                    name => q{'unknown'},
                    desc => $desc,
                    note => $NOTE,
                };

                next;
            }

            # Guess license
            my @guesses;
            {
                require Software::LicenseUtils;
                Software::LicenseUtils->VERSION('0.104007');

                @guesses = Software::LicenseUtils->guess_license_from_meta_key($license);
                $self->_pdump( '@guesses', \@guesses, "\n" );
            }

            my $spdx = $guesses[0]->spdx_expression;
            $self->_pdump( '$spdx', \$spdx, "\n" );

            if ( !defined $spdx ) {
                $_install_license = true;

                push @licenses, {
                    name => q{'unknown'},
                    note => $NOTE,
                };

                next;
            }

            if ( exists $arch_licenses{$spdx} ) {
                # Do not install license.
                push @licenses, { name => qq{'$spdx'} };
                next;
            }
            # License text exists in licenses package under a different SPDX ID.
            elsif ( $spdx =~ /\A( AGPL-3\.0 | LGPL-(?> 2\.1 | 3\.0) )\z/x ) {
                multiline_array() if $idx == 0;

                push @licenses, {
                    name => qq{'$spdx'},
                    desc => "Deprecated by $1-only and $1-or-later.",
                    note => 'License text is identical; manual inspection is advised.',
                };

                next;
            }
            else {
                # Install license file whether IDs from SPDX expression exist in licenses package.
                foreach my $id ( split /\s+(?> AND | OR )\s+/x, $spdx ) {
                    $_install_license = true unless exists $arch_licenses{$id};
                }

                push @licenses, { name => qq{'$spdx'} };
            }
        }

        $self->_pdump( '@licenses', \@licenses, "\n" );
    }

    if ( defined $opts{update} ) {
        foreach my $license (@licenses) {
            push $_generated_meta{license}->@*, $license->{name} =~ s{\A' | '\z}{}grx;
        }
    }

    # Post-process licenses and build the license array string.
    {
        my $max_str = 0;

        # Get the maximum length string to align comments.
        $max_str =
          length reduce { length $a > length $b ? $a : $b } map { $_->{name} } @licenses;

        foreach my $info (@licenses) {
            my ( $name, $desc, $note ) = $info->@{ qw< name desc note > };
            my $pad1 = $SPACE x 2;