view release on metacpan or  search on metacpan

lib/OPM/Maker/Command/sopm.pm  view on Meta::CPAN

            }
        }
    }

    push @xml_parts, sprintf "    <Vendor>%s</Vendor>", $json->{vendor}->{name} || '';
    push @xml_parts, sprintf "    <URL>%s</URL>", $json->{vendor}->{url} || '';

    if ( $json->{description} ) {
        for my $lang ( sort keys %{ $json->{description} } ) {
            push @xml_parts, sprintf '    <Description Lang="%s">%s</Description>', $lang, $json->{description}->{$lang};
        }
    }

    if ( $json->{license} ) {
        push @xml_parts, sprintf '    <License>%s</License>', $json->{license};
    }

    # create filelist
    {
        my @files = File::Find::Rule->file->in( '.' );

        # remove "hidden" files from list; and do not list .sopm
        @files = grep{ 
            ( substr( $_, 0, 1 ) ne '.' ) &&
            $_ !~ m{[\\/]\.} &&
            $_ ne $json->{name} . '.sopm'
        }sort @files;

        if ( $json->{exclude_files} and 'ARRAY' eq ref $json->{exclude_files} ) {
            # ignore ignore file ;-)
            my $ignore_name = '.opmbuild_filetest_ignore';
            push @{ $json->{exclude_files} }, $ignore_name if !grep{ $_ eq $ignore_name } @{ $json->{exclude_files} };

            for my $index ( reverse 0 .. $#files ) {
                my $file     = $files[$index];
                my $excluded = first {
                    eval{ $file =~ /$_\z/ };
                }@{ $json->{exclude_files} };

                splice @files, $index, 1 if $excluded;
            }

            # create ignore file
            my $fh = IO::File->new( $ignore_name, 'w' ) or die $!;
            my $ignore_files = join "\n", @{ $json->{exclude_files} };
            $fh->print( $ignore_files );
            $fh->close;
        }

        $utils->filecheck( \@files );

        push @xml_parts, 
            sprintf "    <Filelist>\n%s\n    </Filelist>",
                join "\n", map{ my $permission = $_ =~ /^bin/ ? 755 : 644; qq~        <File Permission="$permission" Location="$_" />~ }@files;
    }

    if ( $json->{changes_file} && -f $config->dir . "/" . $json->{changes_file} ) {
        my $changes_file = Path::Class::File->new( $config->dir, $json->{changes_file} );
        my $lines        = $changes_file->slurp( iomode => '<:encoding(UTF-8)' );

        my @entries = grep{ ( $_ // '' ) ne '' }split m{
            (?:\s+)?
            (                         # headline with version and date
                ^
                \d+\.\d+ (?:\.\d+)?   # version
                \s+ - \s+
                \d{4}-\d{2}-\d{2} \s  # date
                \d{2}:\d{2}:\d{2}     # time
            )
            \s+
        }xms, $lines;

        while ( @entries ) {
            my ($header, $desc) = ( shift(@entries), shift(@entries) );

            my ($version, $date) = split /\s+-\s+/, $header // '';

            $desc =~ s{\s+\z}{};

            push @xml_parts, sprintf qq~    <ChangeLog Version="%s" Date="%s"><![CDATA[ %s ]]></ChangeLog>~, $version, $date, $desc;
        }
    }

    # changelog
    {
        CHANGE:
        for my $change ( @{ $json->{changes} || [] } ) {
            my $version = '';
            my $date    = '';
            my $info    = '';

            if ( !ref $change ) {
                $info = $change;
            }
            elsif ( 'HASH' eq ref $change ) {
                $info    = $change->{message};
                $version = sprintf( ' Version="%s"', $change->{version} ) if $change->{version};
                $date    = sprintf( ' Date="%s"', $change->{date} )       if $change->{date};
            }

            next CHANGE if !length $info;

            push @xml_parts, sprintf "    <ChangeLog%s%s>%s</ChangeLog>", $version, $date, $info;
        }
    }

    my %actions = (
        Install   => 'post',
        Uninstall => 'pre',
        Upgrade   => 'post',
    );

    my %action_code = (
        TableCreate      => \&_TableCreate,
        Insert           => \&_Insert,
        TableDrop        => \&_TableDrop,
        ColumnAdd        => \&_ColumnAdd,
        ColumnDrop       => \&_ColumnDrop,
        ColumnChange     => \&_ColumnChange,
        ForeignKeyCreate => \&_ForeignKeyCreate,
        ForeignKeyDrop   => \&_ForeignKeyDrop,