← Back to branch summary

~ubuntu-branches/debian/squeeze/libnet-ssh2-perl/squeeze

« back to all changes in this revision

Viewing changes to inc/Module/Install/Metadata.pm

  • Committer: Bazaar Package Importer
  • Author(s): Salvatore Bonaccorso
  • Date: 2010-07-13 20:16:02 UTC
  • mfrom: (1.1.8 upstream)
  • Revision ID: james.westby@ubuntu.com-20100713201602-3judlzka0y3cgety
Tags: 0.33-1
* New upstream release
* Bump Standards-Version to 3.9.0 (no changes needed).

Show diffs side-by-side

added added

removed removed

Lines of Context:
inc/Module/Install/Metadata.pm
6
6
 
7
7
use vars qw{$VERSION @ISA $ISCORE};
8
8
BEGIN {
9
 
        $VERSION = '0.94';
 
9
        $VERSION = '1.00';
10
10
        @ISA     = 'Module::Install::Base';
11
11
        $ISCORE  = 1;
12
12
}
19
19
        name
20
20
        module_name
21
21
        abstract
22
 
        author
23
22
        version
24
23
        distribution_type
25
24
        tests
43
42
 
44
43
my @array_keys = qw{
45
44
        keywords
 
45
        author
46
46
};
47
47
 
 
48
*authors = \&author;
 
49
 
48
50
sub Meta              { shift          }
49
51
sub Meta_BooleanKeys  { @boolean_keys  }
50
52
sub Meta_ScalarKeys   { @scalar_keys   }
176
178
        $self->{values}->{perl_version} = $version;
177
179
}
178
180
 
179
 
#Stolen from M::B
180
 
my %license_urls = (
181
 
    perl         => 'http://dev.perl.org/licenses/',
182
 
    apache       => 'http://apache.org/licenses/LICENSE-2.0',
183
 
    artistic     => 'http://opensource.org/licenses/artistic-license.php',
184
 
    artistic_2   => 'http://opensource.org/licenses/artistic-license-2.0.php',
185
 
    lgpl         => 'http://opensource.org/licenses/lgpl-license.php',
186
 
    lgpl2        => 'http://opensource.org/licenses/lgpl-2.1.php',
187
 
    lgpl3        => 'http://opensource.org/licenses/lgpl-3.0.html',
188
 
    bsd          => 'http://opensource.org/licenses/bsd-license.php',
189
 
    gpl          => 'http://opensource.org/licenses/gpl-license.php',
190
 
    gpl2         => 'http://opensource.org/licenses/gpl-2.0.php',
191
 
    gpl3         => 'http://opensource.org/licenses/gpl-3.0.html',
192
 
    mit          => 'http://opensource.org/licenses/mit-license.php',
193
 
    mozilla      => 'http://opensource.org/licenses/mozilla1.1.php',
194
 
    open_source  => undef,
195
 
    unrestricted => undef,
196
 
    restrictive  => undef,
197
 
    unknown      => undef,
198
 
);
199
 
 
200
 
sub license {
201
 
        my $self = shift;
202
 
        return $self->{values}->{license} unless @_;
203
 
        my $license = shift or die(
204
 
                'Did not provide a value to license()'
205
 
        );
206
 
        $self->{values}->{license} = $license;
207
 
 
208
 
        # Automatically fill in license URLs
209
 
        if ( $license_urls{$license} ) {
210
 
                $self->resources( license => $license_urls{$license} );
211
 
        }
212
 
 
213
 
        return 1;
214
 
}
215
 
 
216
181
sub all_from {
217
182
        my ( $self, $file ) = @_;
218
183
 
242
207
        $self->name_from($file)         unless $self->name;
243
208
        $self->version_from($file)      unless $self->version;
244
209
        $self->perl_version_from($file) unless $self->perl_version;
245
 
        $self->author_from($pod)        unless $self->author;
 
210
        $self->author_from($pod)        unless @{$self->author || []};
246
211
        $self->license_from($pod)       unless $self->license;
247
212
        $self->abstract_from($pod)      unless $self->abstract;
248
213
 
352
317
        require ExtUtils::MM_Unix;
353
318
        my ( $self, $file ) = @_;
354
319
        $self->version( ExtUtils::MM_Unix->parse_version($file) );
 
320
 
 
321
        # for version integrity check
 
322
        $self->makemaker_args( VERSION_FROM => $file );
355
323
}
356
324
 
357
325
sub abstract_from {
362
330
                        { DISTNAME => $self->name },
363
331
                        'ExtUtils::MM_Unix'
364
332
                )->parse_abstract($file)
365
 
         );
 
333
        );
366
334
}
367
335
 
368
336
# Add both distribution and module name
428
396
                ([^\n]*)
429
397
        /ixms) {
430
398
                my $author = $1 || $2;
431
 
                $author =~ s{E<lt>}{<}g;
432
 
                $author =~ s{E<gt>}{>}g;
 
399
 
 
400
                # XXX: ugly but should work anyway...
 
401
                if (eval "require Pod::Escapes; 1") {
 
402
                        # Pod::Escapes has a mapping table.
 
403
                        # It's in core of perl >= 5.9.3, and should be installed
 
404
                        # as one of the Pod::Simple's prereqs, which is a prereq
 
405
                        # of Pod::Text 3.x (see also below).
 
406
                        $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
 
407
                        {
 
408
                                defined $2
 
409
                                ? chr($2)
 
410
                                : defined $Pod::Escapes::Name2character_number{$1}
 
411
                                ? chr($Pod::Escapes::Name2character_number{$1})
 
412
                                : do {
 
413
                                        warn "Unknown escape: E<$1>";
 
414
                                        "E<$1>";
 
415
                                };
 
416
                        }gex;
 
417
                }
 
418
                elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
 
419
                        # Pod::Text < 3.0 has yet another mapping table,
 
420
                        # though the table name of 2.x and 1.x are different.
 
421
                        # (1.x is in core of Perl < 5.6, 2.x is in core of
 
422
                        # Perl < 5.9.3)
 
423
                        my $mapping = ($Pod::Text::VERSION < 2)
 
424
                                ? \%Pod::Text::HTML_Escapes
 
425
                                : \%Pod::Text::ESCAPES;
 
426
                        $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
 
427
                        {
 
428
                                defined $2
 
429
                                ? chr($2)
 
430
                                : defined $mapping->{$1}
 
431
                                ? $mapping->{$1}
 
432
                                : do {
 
433
                                        warn "Unknown escape: E<$1>";
 
434
                                        "E<$1>";
 
435
                                };
 
436
                        }gex;
 
437
                }
 
438
                else {
 
439
                        $author =~ s{E<lt>}{<}g;
 
440
                        $author =~ s{E<gt>}{>}g;
 
441
                }
433
442
                $self->author($author);
434
443
        } else {
435
444
                warn "Cannot determine author info from $_[0]\n";
436
445
        }
437
446
}
438
447
 
 
448
#Stolen from M::B
 
449
my %license_urls = (
 
450
    perl         => 'http://dev.perl.org/licenses/',
 
451
    apache       => 'http://apache.org/licenses/LICENSE-2.0',
 
452
    apache_1_1   => 'http://apache.org/licenses/LICENSE-1.1',
 
453
    artistic     => 'http://opensource.org/licenses/artistic-license.php',
 
454
    artistic_2   => 'http://opensource.org/licenses/artistic-license-2.0.php',
 
455
    lgpl         => 'http://opensource.org/licenses/lgpl-license.php',
 
456
    lgpl2        => 'http://opensource.org/licenses/lgpl-2.1.php',
 
457
    lgpl3        => 'http://opensource.org/licenses/lgpl-3.0.html',
 
458
    bsd          => 'http://opensource.org/licenses/bsd-license.php',
 
459
    gpl          => 'http://opensource.org/licenses/gpl-license.php',
 
460
    gpl2         => 'http://opensource.org/licenses/gpl-2.0.php',
 
461
    gpl3         => 'http://opensource.org/licenses/gpl-3.0.html',
 
462
    mit          => 'http://opensource.org/licenses/mit-license.php',
 
463
    mozilla      => 'http://opensource.org/licenses/mozilla1.1.php',
 
464
    open_source  => undef,
 
465
    unrestricted => undef,
 
466
    restrictive  => undef,
 
467
    unknown      => undef,
 
468
);
 
469
 
 
470
sub license {
 
471
        my $self = shift;
 
472
        return $self->{values}->{license} unless @_;
 
473
        my $license = shift or die(
 
474
                'Did not provide a value to license()'
 
475
        );
 
476
        $license = __extract_license($license) || lc $license;
 
477
        $self->{values}->{license} = $license;
 
478
 
 
479
        # Automatically fill in license URLs
 
480
        if ( $license_urls{$license} ) {
 
481
                $self->resources( license => $license_urls{$license} );
 
482
        }
 
483
 
 
484
        return 1;
 
485
}
 
486
 
439
487
sub _extract_license {
440
 
        if (
441
 
                $_[0] =~ m/
442
 
                (
443
 
                        =head \d \s+
444
 
                        (?:licen[cs]e|licensing|copyrights?|legal)\b
445
 
                        .*?
446
 
                )
447
 
                (=head\\d.*|=cut.*|)
448
 
                \z
449
 
        /ixms ) {
450
 
                my $license_text = $1;
451
 
                my @phrases      = (
452
 
                        'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1,
453
 
                        'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
454
 
                        'Artistic and GPL'                   => 'perl',        1,
455
 
                        'GNU general public license'         => 'gpl',         1,
456
 
                        'GNU public license'                 => 'gpl',         1,
457
 
                        'GNU lesser general public license'  => 'lgpl',        1,
458
 
                        'GNU lesser public license'          => 'lgpl',        1,
459
 
                        'GNU library general public license' => 'lgpl',        1,
460
 
                        'GNU library public license'         => 'lgpl',        1,
461
 
                        'BSD license'                        => 'bsd',         1,
462
 
                        'Artistic license'                   => 'artistic',    1,
463
 
                        'GPL'                                => 'gpl',         1,
464
 
                        'LGPL'                               => 'lgpl',        1,
465
 
                        'BSD'                                => 'bsd',         1,
466
 
                        'Artistic'                           => 'artistic',    1,
467
 
                        'MIT'                                => 'mit',         1,
468
 
                        'proprietary'                        => 'proprietary', 0,
469
 
                );
470
 
                while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
471
 
                        $pattern =~ s#\s+#\\s+#gs;
472
 
                        if ( $license_text =~ /\b$pattern\b/i ) {
473
 
                                return $license;
474
 
                        }
 
488
        my $pod = shift;
 
489
        my $matched;
 
490
        return __extract_license(
 
491
                ($matched) = $pod =~ m/
 
492
                        (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
 
493
                        (=head \d.*|=cut.*|)\z
 
494
                /xms
 
495
        ) || __extract_license(
 
496
                ($matched) = $pod =~ m/
 
497
                        (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
 
498
                        (=head \d.*|=cut.*|)\z
 
499
                /xms
 
500
        );
 
501
}
 
502
 
 
503
sub __extract_license {
 
504
        my $license_text = shift or return;
 
505
        my @phrases      = (
 
506
                '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
 
507
                '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
 
508
                'Artistic and GPL'                   => 'perl',         1,
 
509
                'GNU general public license'         => 'gpl',          1,
 
510
                'GNU public license'                 => 'gpl',          1,
 
511
                'GNU lesser general public license'  => 'lgpl',         1,
 
512
                'GNU lesser public license'          => 'lgpl',         1,
 
513
                'GNU library general public license' => 'lgpl',         1,
 
514
                'GNU library public license'         => 'lgpl',         1,
 
515
                'GNU Free Documentation license'     => 'unrestricted', 1,
 
516
                'GNU Affero General Public License'  => 'open_source',  1,
 
517
                '(?:Free)?BSD license'               => 'bsd',          1,
 
518
                'Artistic license'                   => 'artistic',     1,
 
519
                'Apache (?:Software )?license'       => 'apache',       1,
 
520
                'GPL'                                => 'gpl',          1,
 
521
                'LGPL'                               => 'lgpl',         1,
 
522
                'BSD'                                => 'bsd',          1,
 
523
                'Artistic'                           => 'artistic',     1,
 
524
                'MIT'                                => 'mit',          1,
 
525
                'Mozilla Public License'             => 'mozilla',      1,
 
526
                'Q Public License'                   => 'open_source',  1,
 
527
                'OpenSSL License'                    => 'unrestricted', 1,
 
528
                'SSLeay License'                     => 'unrestricted', 1,
 
529
                'zlib License'                       => 'open_source',  1,
 
530
                'proprietary'                        => 'proprietary',  0,
 
531
        );
 
532
        while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
 
533
                $pattern =~ s#\s+#\\s+#gs;
 
534
                if ( $license_text =~ /\b$pattern\b/i ) {
 
535
                        return $license;
475
536
                }
476
 
        } else {
477
 
                return;
478
537
        }
 
538
        return '';
479
539
}
480
540
 
481
541
sub license_from {
556
616
        return $v;
557
617
}
558
618
 
559
 
 
560
 
 
 
619
sub add_metadata {
 
620
    my $self = shift;
 
621
    my %hash = @_;
 
622
    for my $key (keys %hash) {
 
623
        warn "add_metadata: $key is not prefixed with 'x_'.\n" .
 
624
             "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
 
625
        $self->{values}->{$key} = $hash{$key};
 
626
    }
 
627
}
561
628
 
562
629
 
563
630
######################################################################