source: contrib/cpan2port/cpan2port

Last change on this file was 148568, checked in by mojca@…, 2 years ago

cpan2port: remove 5.16-5.20, add 5.24

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 11.0 KB
Line 
1#! /usr/bin/env perl
2# $Id: cpan2port 148568 2016-05-11 18:08:18Z mojca@macports.org $
3
4# cpan2port
5# Created by Marc Chantreux
6# Copyright BibLibre 2009
7#
8# http://lists.macosforge.org/pipermail/macports-dev/2009-March/008052.html
9#
10# Permission to redistribute, modify, etc. is granted under terms of the
11# WTFPL, which can be found in the COPYING file accompanying this program, or
12# on the Web at: http://sam.zoy.org/wtfpl/COPYING
13
14# Todo:
15# - redesign
16#   - more output ? BSD, debian, rpm, macports ?
17#   - manage build/libs requirement
18#   - manage the versions of perl
19
20# package PackagingSystem;
21#
22# package Macport;
23# use base
24# our %versions = qw(
25#     5.8 5.008006
26#     5.10 unknown
27# );
28#
29#
30#
31# # perl -le 'print $]'
32# sub perl_version {
33#     $ver{shift};
34# }
35#
36# package Debian;
37#
38# sub perl_version {
39#     my %ver = qw(
40#       lenny 5.10
41#       hardy 5.008008
42#     );
43# }
44
45package MSG;
46
47sub warn { print STDERR join(' ',@_),"\n";  }
48sub say { print join(' ',@_),"\n";  }
49
50package DEBUG;
51
52sub DEBUG { 1 }
53
54sub warn { DEBUG and print STDERR join(' ',@_),"\n";  }
55sub say { DEBUG and print join(' ',@_),"\n";  }
56
57package STFU;
58sub myprint {}
59sub mywarn { warn @_ }
60sub mysleep { sleep @_ }
61
62package Huggy;
63use strict;
64use warnings;
65use CPAN;
66use Module::Depends;
67use Module::Depends::Intrusive;
68use List::MoreUtils qw(any uniq);
69use Module::CoreList;
70
71sub is_corelist {
72    my $module = shift;
73    my $lc = lc $module;
74    $lc eq 'perl' and return 1;
75    any { exists $$_{$module} } values %Module::CoreList::version;
76}
77
78sub depends_on {
79    my $dep = (shift or return ())->{depends} or return ();
80    my %conf = @_;
81    my %r;
82    my $method = $conf{during} ? $conf{during} :  'requires';
83    while ( my ($k,$v) = each %{ $dep->$method or return ()} ) {
84        DEBUG::warn("candidate $k");
85        is_corelist($k) or $r{$k} = $v;
86    }
87    DEBUG::warn("end compute dependencies");
88    \%r;
89}
90
91sub package_name {
92    my ( $name ) = shift;
93    $name = lc "p5-$name";
94    $name =~ y/+/x/;
95    return $name;
96}
97
98sub dependency_name {
99    my ( $name ) = shift;
100    $name = lc "p\${perl5.major}-$name";
101    $name =~ y/+/x/;
102    return $name;
103}
104
105sub debian {
106    my ( $name ) = shift;
107    $name = lc "lib$name-perl";
108    $name =~ y/+/x/;
109    return $name;
110}
111
112sub find_dist {
113    for (@_) {
114        my $glob = "$_*";
115        print STDERR "trying to find dist in $glob\n";
116        if (my ( $dist ) = grep { -d } glob($glob) ) {
117                return $dist
118        }
119    }
120    undef;
121}
122
123sub module_depends {
124    my ($info) = @_ or return ();
125    DEBUG::warn("$$info{name} will show deps");
126    my $dist = find_dist( $info->{dist_dir}, $info->{module}->get )
127        or die "can't find dist";
128    $$info{has_makefile_pl} = (-e "$dist/Makefile.PL");
129    $$info{has_build_pl} = (-e "$dist/Build.PL");
130    $$info{depends} = (
131        -e "$dist/META.yml"
132            ? 'Module::Depends'
133            : 'Module::Depends::Intrusive'
134    ) ->new ->dist_dir($dist); 
135    $$info{depends}->find_modules ;
136    if ( my $errors = $$info{depends}->{errors} ) {
137        MSG::warn "can't parse $$info{name}: $errors";
138    }
139    $info;
140}
141
142sub from_port { (about(shift) or return () )->{dependency} }
143
144sub about {
145    my ( $module_name, $config ) = @_;
146    die 'no module' unless $module_name;
147    $config ||= {};
148
149    my $module = CPAN::Shell->expand('Module',$module_name) or die "can't expand $module_name";
150    my %info = ( name => $module_name );
151    my @info_fields = qw(file cpan_path prefix version suffix);
152    my $get_info = qr<
153        ( # file
154            (.*)/          # cpan_path
155            ([^/]+)-          # prefix
156            ((?:\d+\.?)+|v(?:\d+\.?)+)     # version
157            \.
158            (tar\.gz|tgz)   # suffix
159        )
160        \s*$              # eol
161    >x;
162
163    $info{cpan_file} = $module->cpan_file; 
164
165    $info{cpan_file} =~ /perl5-porters\@perl\.org/ and return ();
166    DEBUG::warn "$module_name is not perl porter";
167
168    $info{tarball} = "$$CPAN::Config{keep_source_where}/authors/id/$info{cpan_file}";
169    @info{@info_fields} = $info{cpan_file} =~ /$get_info/;
170    for (@info_fields) {
171        defined $info{$_} or MSG::warn "$info{name}::$info{cpan_file}: $_ not matched";
172    }
173    if ( my $desc = $module->description ) {
174        $info{description}  = $desc;
175    } else {
176        $desc = "$module_name (no description available)";
177        $info{description}  = $desc;
178        MSG::warn $desc;
179    }
180    $info{port} = package_name($info{prefix});
181    $info{dependency} = dependency_name($info{prefix});
182    $info{debian} = package_name($info{prefix});
183    $info{dist_dir} = "$$CPAN::Config{build_dir}/$info{prefix}-$info{version}";
184    $info{module} = $module;
185    \%info;
186}
187
188sub checksums {
189    my ($info) = shift;
190    my $tarball = $$info{tarball} or die;
191    my %check;
192    for my $k (qw( rmd160 sha256)) {
193        my ($sum) = qx( openssl $k $tarball);
194        my ($v)   = $sum =~ / (.*)/;
195        $check{$k} = $v;
196    }
197    $$info{checksums} = \%check;
198    if ( DEBUG::DEBUG ) {
199        use YAML;
200        print STDERR Dump $$info{checksums};
201    }
202    $info;
203}
204
205sub all_on {
206    my $depends = module_depends( about(@_ ));
207    checksums( $depends );
208}
209
210package main;
211use strict;
212use warnings;
213use YAML;
214use Getopt::Std;
215use File::Path;
216use Carp;
217use Cwd;
218use Pod::Usage;
219
220my %opt;
221
222# my %info;
223# $info{maintainers} = $ENV{maintainers} || 'nomaintainer';
224
225sub portfile {
226    my ($info) = @_ or return ();
227    $$info{maintainers} ||= 'nomaintainer';
228    my $checksums = '';
229    my $depends = '';
230    my $depends_build = '';
231    my $depends_lib = '';
232    my $use_module_build = '';
233   
234    if ( exists $$info{depends} ) {
235         if ( my $check =  $$info{checksums} ) {
236             my @hashes;
237             foreach my $key (sort(keys %{ $check })) { push @hashes, "$key ".$$check{$key}; }
238             $checksums = 'checksums           '.join(" \\\n".(' 'x20),@hashes);
239         }
240
241         if ( my $dep_ref = Huggy::depends_on($info, during=>"build_requires") ) {
242             my @depends_build = Huggy::uniq map {
243                 MSG::warn "$$info{name} build_requires $_";
244                 'port:'.Huggy::from_port $_
245             } sort(keys %{ $dep_ref });
246             if (@depends_build) {
247                 unshift(@depends_build, '    depends_build-append');
248                 $depends_build = join(" \\\n".(' 'x20), sort(@depends_build))."\n";
249             }
250         }
251         if ( my $dep_ref = Huggy::depends_on($info) ) {
252             my @depends_lib = Huggy::uniq map {
253                 MSG::warn "$$info{name} requires $_";
254                 'port:'.Huggy::from_port $_
255             } sort(keys %{ $dep_ref });
256             if (@depends_lib) {
257                 unshift(@depends_lib, '    depends_lib-append');
258                 $depends_lib = join(" \\\n".(' 'x20), sort(@depends_lib))."\n";
259             }
260         }
261         if ($depends_build.$depends_lib ne '') {
262             $depends = "\nif {\${perl5.major} != \"\"} {\n" . $depends_build . $depends_lib . "}\n";
263         }
264    }
265
266    # If no Makefile.PL is present, maybe we need use_module_build?
267    if (!($$info{has_makefile_pl})) {
268        if ($$info{has_build_pl}) {
269            $use_module_build = "perl5.use_module_build";
270        } else {
271            MSG::warn "Didn't find either Makefile.PL or Build.PL";
272        }
273    }
274
275    # Generate text for the portfile.
276    # Note that two versions of perl5.setup are generated. The second is for
277    # use when the distfile isn't in the customary location (unfortunately
278    # happening more and more often on CPAN). In the future, it would be nice
279    # to have a command line option to choose between the two, or better yet
280    # have it chosen automatically with a couple of quick Web checks. -L2G
281
282    my $portfile = <<STOP;
283# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:ft=tcl:et:sw=4:ts=4:sts=4
284# \$Id\$
285
286PortSystem          1.0
287PortGroup           perl5 1.0
288
289perl5.branches      5.22 5.24
290perl5.setup         $$info{prefix} $$info{version}
291#perl5.setup         $$info{prefix} $$info{version} ../by-authors/id/$$info{cpan_path}
292
293platforms           darwin
294maintainers         $$info{maintainers}
295#license             {Artistic-1 GPL}
296license             unknown
297
298# Uncomment this line if you know there will be no arch-specific code:
299#supported_archs     noarch
300
301description         $$info{description}
302
303long_description    \${description}
304
305STOP
306
307    if ( $$info{suffix} ne 'tar.gz' ) {
308        $portfile .= qq{extract.suffix  .$$info{suffix}\n};
309    }
310
311    $portfile .= <<STOP;
312$checksums
313$depends
314$use_module_build
315STOP
316
317    return $portfile;
318}
319
320sub fmt {
321    my ( $format,$info ) = @_;
322    if ($format eq 'YAML' ) {
323        use YAML; print Dump $info;
324        return;
325    }
326    $format =~ s/#\{(\w+)\}/$$info{$1}/g;
327    $format;
328}
329
330sub next_arg {
331    shift @ARGV;
332}
333
334sub next_line {
335    my $line = <>;
336    $line or return undef;
337    chomp $line;
338    $line;
339}
340
341getopts('vtf:',\%opt) or die;
342
343exists $opt{v} or $CPAN::Frontend = 'STFU';
344
345my $next_package = @ARGV ? \&next_arg : \&next_line;
346
347sub foreach_pkg (&) {
348    my ($code) = @_;
349    local $_;
350    # return undef unless $code and $_;
351    while ( $_ = &$next_package ) {
352        eval { &$code };
353        if ($@) { croak "((($@)))" };
354    }
355}
356
357keys %opt or pod2usage {qw( -exitval 1 -verbose 2 )};
358
359my $wd = getcwd;
360
361if ( exists $opt{f} ) {
362    foreach_pkg {
363        my $info = Huggy::about $_;
364        print(fmt($opt{f},$info)); 
365    }
366} elsif ( exists $opt{t} ) {
367    foreach_pkg {
368        if (my $info = Huggy::all_on $_) {
369            chdir $wd;
370            my $dir = "perl/$$info{port}";
371            -d $dir or mkpath $dir;
372            my $portfile = "$dir/Portfile";
373            print STDERR "creating $portfile\n";
374            open PORTFILE,'>',$portfile or die "$! while creating $portfile";
375            print PORTFILE portfile($info);
376        } else { die 'Huggy did not have clue' }
377    }
378}
379
380__END__
381
382=head1 cpan2port 0.0
383
384a tool to generate MacPorts portfiles
385
386=head2 Usage
387
388cpan2port uses at least one flag and a list of module names. Module names can
389also be read from stdin.
390
391        cpan2port -t Net::LDAP Test::Harness
392
393works.
394
395        cpan2port -t < packages_list
396
397works too.
398
399Flags tell to cpan2port what to do
400
401=over
402
403=item -v
404
405By default, cpan2port doesn't print useless CPAN messages. Use -v if you want to show them.
406
407=item -t
408
409Generate portfiles from a list of modules.
410
411Go to your local MacPorts repository and type
412
413        cpan2port -t Net::LDAP Test::Harness
414        find .
415
416and you'll see
417
418        ./perl
419        ./perl/p5-perl-ldap
420        ./perl/p5-perl-ldap/Portfile
421        ./perl/p5-test-harness
422        ./perl/p5-test-harness/Portfile
423
424cpan
425
426        cpan2port -t Net::LDAP Test::Harness
427        find .
428and the perl/p5-
429
430=item -f
431
432Format output for all package names. For example
433
434        cpan2port -f '#{port}' Net::LDAP
435
436will print
437
438        p5-perl-ldap
439
440
441special format string YAML shows a yaml dump about packages
442
443        cpan2port -f YAML Net::LDAP
444
445so it's easy to see what information is available.
446
447=back
448
449=head2 Known bugs and to-do list
450
451=over
452
453=item *
454
455Have to launch twice to generate packages? -v flag messes things up?
456
457=item *
458
459Add perl version support to have a better dependencies grabbing
460
461=back
Note: See TracBrowser for help on using the repository browser.