view release on metacpan or  search on metacpan

lib/DhMakePerl/Command/Packaging.pm  view on Meta::CPAN

}

sub extract_examples {
    my ( $self ) = @_;

    my $dir = $self->main_dir;

    $dir .= '/' unless $dir =~ m{/$};
    find(
        sub {
            return if $_ eq '.';  # skip the directory itself
            my $exampleguess = substr( $File::Find::name, length($dir) );
            push( @{ $self->examples },
                ( -d $exampleguess ? $exampleguess . '/*' : $exampleguess ) )
                if ( /^(examples?|eg|samples?)$/i
                and ( !$self->cfg->exclude or $File::Find::name !~ $self->cfg->exclude )
                );
        },
        $dir
    );
}

sub read_rules {
    my $self = shift;

    return if $self->rules;

    my $file = $self->debian_file('rules');

    $self->rules( Debian::Rules->new($file) );
}

sub create_rules {
    my ( $self ) = @_;

    my $file = $self->debian_file('rules');

    $self->rules( Debian::Rules->new($file) );

    if ( $self->rules->is_dhtiny ) {
        print "$file already uses dh tiny rules\n"
            if $self->cfg->verbose;
        return;
    }

    $self->backup_file($file);

    my $rulesname = 'rules.dh.tiny';

    for my $source (
        catfile( $self->cfg->home_dir, $rulesname ),
        catfile( $self->cfg->data_dir, $rulesname )
    ) {
        if ( -e $source ) {
            print "Using rules: $source\n" if $self->cfg->verbose;
            $self->rules->read($source);
            last;
        };
    }
    $self->rules->write;
    chmod( 0755, $file ) or die "chmod($file): $!";
}

sub create_compat {
    my ( $self, $file ) = @_;

    my $fh = $self->_file_w($file);
    $fh->print( $self->cfg->dh, "\n" );
    $fh->close;
}

sub update_file_list( $ % ) {
    my ( $self, %p ) = @_;

    my $pkgname = $self->pkgname;

    while ( my ( $file, $new_content ) = each %p ) {
        next unless @$new_content;
        # pkgname.foo file
        my $pkg_file = $self->debian_file("$pkgname.$file");
        my %uniq_content;
        my @existing_content;

        # if a package.foo exists read its values first
        if ( -r $pkg_file ) {
            my $fh                = $self->_file_r($pkg_file);
            @existing_content = $fh->getlines;
            chomp(@existing_content);

            # make list of files for package.foo unique
            $uniq_content{$_} = 1 for @existing_content;
        }

        $uniq_content{$_} = 1 for @$new_content;

        # write package.foo file with unique entries
        open F, '>', $pkg_file or die $!;
        for ( @existing_content, @$new_content ) {

            # we have the unique hash
            # we delete from it each printed line
            # so if a line is not in the hash, this means we have already
            # printed it
            next unless exists $uniq_content{$_};

            delete $uniq_content{$_};
            print F "$_\n";
        }
        close F;
    }
}

sub create_copyright {
    my ( $self, $filename ) = @_;

    my ( $fh, %fields, @res, @incomplete, $year );
    $fh = $self->_file_w($filename);

    # In case author string spawns more than one line, indent them all.
    my $cprt_author = $self->author || '(information incomplete)';
    $cprt_author =~ s/\n/\n    /gs;