packages/perl-modules/lib/BuildHelper.pm

   1 package BuildHelper;
   2
   3 use warnings;
   4 use strict;
   5 use Config;
   6 use Data::Dumper;
   7 use Module::CoreList;
   8 use lib '/omd/versions/default/lib/perl5/lib/perl5';
   9 use lib '/var/tmp/p5_dist/dest/lib/perl5';
  10 use Storable qw/lock_store lock_retrieve/;
  11 use Cwd;
  12
  13 ####################################
  14 # Settings
  15 $Data::Dumper::Sortkeys = 1;
  16 my $verbose = 0;
  17 my $additional_deps = {
  18   'IO' => { 'ExtUtils::ParseXS' => '3.21' },
  19 };
  20
  21 ####################################
  22 # is this a core module?
  23 sub is_core_module {
  24     my($module) = @_;
  25     #my @v = split/\./, $Config{'version'};
  26     #my $v = $v[0] + $v[1]/1000;
  27     # use fixed version: 5.008, otherwise we would to sort modules on the oldes possible host
  28     my $v = "5.008";
  29     if(exists $Module::CoreList::version{$v}{$module}) {
  30         return $Module::CoreList::version{$v}{$module} || 0;
  31     }
  32     return;
  33 }
  34
  35 ####################################
  36 # execute a command
  37 sub cmd {
  38     my($cmd,$force) = @_;
  39     print "[INFO] cmd: $cmd\n" if $verbose;
  40     my $out = "";
  41     open(my $ph, '-|', $cmd." 2>&1") or die("cannot execute cmd: $cmd");
  42     while(my $line = <$ph>) {
  43         $out .= $line;
  44     }
  45     close($ph);
  46     if($? != 0 and !defined $force) { my $rc = $?>>8; die("cmd failed (rc:$rc): $cmd\n$out") };
  47     return $out;
  48 }
  49
  50 ####################################
  51 # get all dependencies for a tarball
  52 # needs a filename like: Storable-2.21.tar.gz
  53 sub get_deps {
  54     my($file, $download, $quiet) = @_;
  55     $quiet = 0 unless defined $quiet;
  56
  57     our %deps_cache;
  58     our %deps_files;
  59     our %already_checked;
  60     return if defined $already_checked{$file};
  61     $already_checked{$file} = 1;
  62
  63     print " -> checking dependecies for: $file\n" unless $quiet;
  64     print "." if $quiet == 1;
  65     my $meta = get_meta_for_tarball($file);
  66
  67     my $deps = BuildHelper::get_deps_from_meta($meta);
  68     add_additional_deps($file, $deps);
  69     $deps_cache{$file} = $deps;
  70     for my $dep (keys %{$deps}) {
  71         my $depv = $deps->{$dep};
  72         my $cv   = is_core_module($dep);
  73         if(defined $cv and $depv == 0) {
  74             print "   -> $dep ($depv) skipped zero core dependency\n" unless $quiet;
  75             next;
  76         }
  77         print "   -> $dep ($depv)\n" unless $quiet;
  78         if($download) {
  79             BuildHelper::download_module($dep, $depv);
  80         }
  81     }
  82     return \%deps_cache;
  83 }
  84
  85 ####################################
  86 # download all dependencies for a tarball
  87 # needs a filename like: Storable-2.21.tar.gz
  88 sub download_deps {
  89     my $file = shift;
  90     return BuildHelper::get_deps($file, 1);
  91 }
  92
  93 ####################################
  94 # download a module
  95 # needs a module name like: IO::All
  96 sub download_module {
  97     my $mod    = shift;
  98     my $ver    = shift || 0;
  99     my $no_dep = shift || 0;
 100     my $quiet  = shift || 0;
 101
 102     print "[INFO] download_module($mod, $ver)\n" if $verbose;
 103
 104     our %already_downloaded;
 105     our %deps_checked;
 106     our @downloaded;
 107     return \@downloaded if defined $already_downloaded{$mod.$ver};
 108     $already_downloaded{$mod.$ver} = 1;
 109
 110     # we dont need core modules or perl dependency
 111     if($mod eq 'perl') { return \@downloaded; }
 112
 113     my $urlpath = BuildHelper::get_url_for_module($mod);
 114     return \@downloaded if defined $already_downloaded{$urlpath};
 115     if($urlpath =~ m/\/perl\-[\d\.]+\.tar\.gz/) {
 116         $already_downloaded{$urlpath} = 1;
 117         print "     -> links to perl\n";
 118         return \@downloaded;
 119     }
 120     my $tarball=$urlpath; $tarball =~ s/^.*\///g;
 121
 122     if( ! -f $tarball and !defined $already_downloaded{$urlpath}) {
 123         BuildHelper::cmd('wget --retry-connrefused -q "http://search.cpan.org'.$urlpath.'"');
 124         $already_downloaded{$urlpath} = 1;
 125         BuildHelper::download_deps($tarball) unless $no_dep == 1;
 126         push @downloaded, $tarball;
 127         print "downloaded $tarball\n" unless $quiet;
 128     } else {
 129         if(!defined $deps_checked{$tarball}) {
 130             print "$tarball already downloaded\n";
 131             #print "rechecking dependency\n";
 132             #BuildHelper::download_deps($tarball);
 133             $deps_checked{$tarball} = 1;
 134         } else {
 135             print "$tarball already downloaded\n";
 136         }
 137     }
 138     return \@downloaded;
 139 }
 140
 141 ####################################
 142 sub download_src {
 143     my $module = shift;
 144     BuildHelper::cmd('wget --retry-connrefused -q "http://thruk.org/libs/src/'.$module.'"');
 145     return;
 146 }
 147
 148 ####################################
 149 # download a module
 150 # needs a filename like: Storable-2.21.tar.gz
 151 # returns module name and version
 152 sub file_to_module {
 153     my $file = shift;
 154     my($module,$version) = ($file, 0);
 155
 156     if($file =~ m/\-([0-9\.]*)(\.[\w\d]+)*(\.tar\.gz|\.tgz|\.zip)/) {
 157         $version = $1;
 158     }
 159
 160     $module =~ s/\-[0-9\.\w]*(\.tar\.gz|\.tgz|\.zip)//g;
 161     $module =~  s/\-/::/g;
 162     $module = translate_module_name($module);
 163
 164     return($module,$version);
 165 }
 166
 167 ####################################
 168 # return real module name
 169 # TODO: get real name from http://search.cpan.org/search?mode=dist&query=<module>
 170 sub translate_module_name {
 171     my $name = shift;
 172     my $tr = {
 173         'Filter'                => 'Filter::exec',
 174         'IO::Compress'          => 'IO::Compress::Base',
 175         'IO::stringy'           => 'IO::Scalar',
 176         'Scalar::List::Utils'   => 'List::Util::XS',
 177         'libwww::perl'          => 'LWP',
 178         'Template::Toolkit'     => 'Template',
 179         'TermReadKey'           => 'Term::ReadKey',
 180         'Gearman'               => 'Gearman::Client',
 181         'PathTools'             => 'File::Spec',
 182         'libnet'                => 'Net::Cmd',
 183         'podlators'             => 'Pod::Man',
 184         'Text::Tabs+Wrap'       => 'Text::Tabs',
 185     };
 186     $name =~ s/^inc::Module::Install.*?/Module::Install/g;
 187     return $tr->{$name} if defined $tr->{$name};
 188     return $name;
 189 }
 190
 191 ####################################
 192 # return filename from list
 193 sub module_to_file {
 194     my($mod, $files, $version) = @_;
 195     if($version > 0 and defined $files->{$mod}) {
 196         my($m,$v) = file_to_module($files->{$mod});
 197         return $files->{$mod} if version_compare($v, $version);
 198     }
 199     return $files->{$mod} if defined $files->{$mod};
 200     return;
 201 }
 202
 203 ####################################
 204 # get dependencies
 205 sub get_all_deps {
 206     my($quiet) = @_;
 207     our %deps_cache;
 208     our %deps_files;
 209     alarm(60);
 210     my $data;
 211     if(-f '.deps.cache') {
 212         # this may fail due to mismatching hosts systems
 213         eval {
 214             $data = lock_retrieve('.deps.cache') or die("cannot read .deps.cache: $!");
 215         };
 216         warn($@) if $@;
 217
 218         # remove all tarballs from cache which no longer exist
 219         for my $tf (keys %{$data->{'deps'}}) {
 220             if(!-e $tf) {
 221                 delete $data->{'deps'}->{$tf};
 222                 for my $key (keys %{$data->{'files'}}) {
 223                     delete $data->{'files'}->{$key} if $data->{'files'}->{$key} eq $tf;
 224                 }
 225             }
 226         }
 227     }
 228     alarm(0);
 229     my $cwd = cwd();
 230     chdir("src") or die("cannot change to src dir");
 231     my @tarballs = glob("*.tgz *.tar.gz *.zip");
 232
 233     %deps_cache = %{$data->{'deps'}}  if defined $data->{'deps'};
 234     %deps_files = %{$data->{'files'}} if defined $data->{'files'};
 235     for my $tarball (@tarballs) {
 236         BuildHelper::get_deps($tarball, undef, $quiet) unless defined $deps_cache{$tarball};
 237     }
 238
 239     chdir($cwd) or die("cannot change dir back");
 240     alarm(60);
 241     lock_store({'files' => \%deps_files, 'deps' => \%deps_cache}, '.deps.cache');
 242     alarm(0);
 243     return(\%deps_cache, \%deps_files);
 244 }
 245
 246 ####################################
 247 sub sort_by_dependency {
 248     my $modules = shift;
 249
 250     my @sorted;
 251
 252     # ExtUtils-MakeMaker has to go first
 253     for my $m (sort keys %{$modules}) {
 254         if($m =~ m/^ExtUtils\-MakeMaker\-\d+/) {
 255             push @sorted, $m;
 256             delete $modules->{$m};
 257         }
 258     }
 259
 260     my $num = scalar keys %{$modules};
 261     while($num > 0) {
 262         for my $m (sort keys %{$modules}) {
 263             for my $s (sort keys %{$modules->{$m}}) {
 264                 if(grep {/$s/} @sorted) {
 265                     delete $modules->{$m}->{$s};
 266                 }
 267             }
 268             if(scalar keys %{$modules->{$m}} == 0) {
 269                 push @sorted, $m;
 270                 delete $modules->{$m};
 271             }
 272         }
 273         my $new = scalar keys %{$modules};
 274         if($new == $num) {
 275             print Dumper $modules;
 276             die("circular dependency");
 277         }
 278         $num = $new;
 279     }
 280
 281     return @sorted;
 282 }
 283
 284 ####################################
 285 # compare two version strings
 286 # return 1 if $v1 >= $v2
 287 sub version_compare {
 288     my($v1,$v2) = @_;
 289     return 0 if !defined $v1 or $v1 eq 'undef';
 290     return 1 if !defined $v2 or $v2 eq 'undef';
 291     $v1 =~ s/^(\d+\.\d+).*$/$1/;
 292     $v2 =~ s/^(\d+\.\d+).*$/$1/;
 293     return 1 if $v1 >= $v2;
 294     return 0;
 295 }
 296
 297 ####################################
 298 # sort dependencies
 299 sub sort_deps {
 300     my $deps  = shift;
 301     my $files = shift;
 302
 303     # 1st clean up and resolve modules to files
 304     our $modules = {};
 305     for my $file (keys %{$deps}) {
 306         $modules->{$file} = {};
 307         for my $dep (keys %{$deps->{$file}}) {
 308             next if $dep eq 'perl';
 309             next if $dep eq 'strict';
 310             next if $dep eq 'warnings';
 311             next if $dep eq 'lib';
 312             next if $dep eq 'v';
 313             next if $dep eq 'IPC::Open'; # core module but not recognized
 314             my $cv = is_core_module($dep);
 315             my $dv = $deps->{$file}->{$dep};
 316             # next when dependency is a core module and we require version 0
 317             next if $dv == 0 and defined $cv;
 318             if(defined $cv) {
 319                 next if version_compare($cv, $dv);
 320             }
 321             my $fdep = module_to_file($dep, $files, $deps->{$file}->{$dep});
 322             if(defined $fdep) {
 323                 next if $fdep eq $file;
 324                 $modules->{$file}->{$fdep} = 1
 325             } else {
 326                 if($dep !~ m/^Test::/
 327                    and !defined is_core_module($dep)) {
 328                     warn("cannot resolve dependency '$dep' to file, referenced by: $file\n");
 329                 }
 330             }
 331         }
 332     }
 333
 334     my @sorted = sort_by_dependency($modules);
 335
 336     return \@sorted;
 337 }
 338
 339 ####################################
 340 # get url for module
 341 sub get_url_for_module {
 342     my $mod = shift;
 343     our %url_cache;
 344     $mod = translate_module_name($mod);
 345     return $url_cache{$mod} if exists $url_cache{$mod};
 346     for my $url ('http://search.cpan.org/perldoc?'.$mod, 'http://search.cpan.org/dist/'.$mod) {
 347         my $out = BuildHelper::cmd("wget --retry-connrefused -O - '".$url."'", 1);
 348         if($out =~ m/href="(\/CPAN\/authors\/id\/.*?\/.*?(\.tar\.gz|\.tgz|\.zip))">/) {
 349             $url_cache{$mod} = $1;
 350             return($1);
 351         }
 352     }
 353     print "cannot find $mod on cpan\n";
 354     exit;
 355 }
 356
 357 ####################################
 358 sub install_module {
 359     my $file    = shift;
 360     my $TARGET  = shift;
 361     my $PERL    = shift || '/usr/bin/perl';
 362     my $verbose = shift || 0;
 363     my $x       = shift || 1;
 364     my $max     = shift || 1;
 365     die("error: $file does not exist in ".`pwd`) unless -e $file;
 366     die("error: module name missing") unless defined $file;
 367
 368     my $LOG = "install.log";
 369     printf("*** (%3s/%s) ", $x, $max);
 370     printf("%-55s", $file);
 371
 372     my($modname, $modvers) = file_to_module($file);
 373
 374     if( $modname eq "DBD::Oracle") {
 375         if(defined $ENV{'ORACLE_HOME'} and -f $ENV{'ORACLE_HOME'}."/lib/libclntsh.so") {
 376             $ENV{'LD_LIBRARY_PATH'} = $ENV{'ORACLE_HOME'}."/lib";
 377             $ENV{'PATH'}            = $ENV{'PATH'}.":".$ENV{'ORACLE_HOME'}."/bin";
 378         } else {
 379             print "skipped\n";
 380             return 1;
 381         }
 382     }
 383
 384     my $core   = BuildHelper::is_core_module($modname);
 385     if(BuildHelper::version_compare($core, $modvers)) {
 386         print "skipped core module $core >= $modvers\n";
 387         return 1;
 388     }
 389
 390     my $installed = 0;
 391     `grep $file $TARGET/modlist.txt 2>&1`;
 392     $installed = 1 if $? == 0;
 393     if( $installed and $modname ne 'Catalyst::Runtime' ) {
 394         print "already installed\n";
 395         return 1;
 396     }
 397
 398     my $start = time();
 399     my $dir   = BuildHelper::unpack($file);
 400     my $cwd   = cwd();
 401     chdir($dir);
 402     `rm -f $LOG`;
 403     print "installing... ";
 404
 405     my $makefile_opts = '';
 406     if($modname eq 'XML::LibXML') {
 407         $makefile_opts = 'FORCE=1';
 408     }
 409
 410     eval {
 411         local $SIG{ALRM} = sub { die "timeout on: $file\n" };
 412         alarm(120); # single module should not take longer than 1 minute
 413         if( -f "Build.PL" ) {
 414             `$PERL Build.PL >> $LOG 2>&1 && ./Build >> $LOG 2>&1 && ./Build install >> $LOG 2>&1`;
 415             if($? != 0 ) { die("error: rc $?\n".`cat $LOG`."\n"); }
 416         } elsif( -f "Makefile.PL" ) {
 417             `sed -i -e 's/auto_install;//g' Makefile.PL`;
 418             my $rc;
 419             # retry because sometimes Makefile.PL will be rebuild due to broken time
 420             for my $retry (1..3) {
 421                 `echo "\n\n\n" | $PERL Makefile.PL $makefile_opts >> $LOG 2>&1 && make -j 5 >> $LOG 2>&1 && make install >> $LOG 2>&1`;
 422                 $rc = $?;
 423                 last if $rc == 0;
 424             }
 425             if($rc != 0 ) { die("error: rc $rc\n".`cat $LOG`."\n"); }
 426         } else {
 427             die("error: no Build.PL or Makefile.PL found in $file!\n");
 428         }
 429         `grep '^==> Auto-install the' $LOG >/dev/null 2>&1 | grep -v optional`;
 430         if($? == 0 ) { die("dependency error: rc $?\n".`cat $LOG`."\n"); }
 431         alarm(0);
 432     };
 433     if($@) {
 434         die("error: $@\n");
 435     } else {
 436         `echo $file >> $TARGET/modlist.txt`;
 437     }
 438
 439     my $end = time();
 440     my $duration = $end - $start;
 441     print "ok (".$duration."s)\n";
 442     my $grepv = "grep -v 'Test::' | grep -v 'Linux::Inotify2' | grep -v 'IO::KQueue' | grep -v 'prerequisite Carp' | grep -v ExtUtils::Install";
 443     system("grep 'Warning: prerequisite' $LOG         | $grepv"); # or die('dependency error');
 444     system("grep 'is not installed' $LOG | grep ' ! ' | $grepv"); # or die('dependency error');
 445     system("grep 'is installed, but we need version' $LOG | grep ' ! ' | $grepv"); # or die('dependency error');
 446     system("grep 'is not a known MakeMaker parameter' $LOG | grep INSTALL_BASE | $grepv") or die('build error');
 447     chdir($cwd);
 448     if($duration > 30) {
 449         chomp(my $pwd = `pwd`);
 450         print "installation took to long, see $pwd/$dir/$LOG for details\n";
 451     } else {
 452         `rm -rf $dir`;
 453     }
 454
 455     # makes Module::Build 1000 times faster
 456     if($modname eq 'JSON::XS') {
 457         $ENV{'PERL_JSON_BACKEND'} = 'JSON::XS';
 458     }
 459     if($modname eq 'YAML::LibYAML') {
 460         $ENV{'PERL_YAML_BACKEND'} = 'YAML::XS';
 461     }
 462
 463     return 1;
 464 }
 465
 466 ####################################
 467 # return meta content from unpacked package
 468 sub get_meta_for_dir {
 469     my($dir) = @_;
 470
 471     # create Makefile
 472     my $cwd = cwd();
 473     chdir($dir);
 474     alarm(120);
 475     eval {
 476         BuildHelper::cmd("yes n | perl Makefile.PL", 1) if -e 'Makefile.PL';
 477         BuildHelper::cmd("yes n | perl Build.PL", 1)    if -e 'Build.PL';
 478     };
 479     warn($@) if $@;
 480     alarm(0);
 481     chdir($cwd);
 482
 483     my $meta = {};
 484     if(-s "$dir/MYMETA.json") {
 485         eval {
 486             require JSON;
 487             $meta = JSON::from_json(`cat $dir/MYMETA.json | tr '\n' ' '`);
 488         };
 489         print Dumper $@ if $@;
 490     }
 491     elsif(-s "$dir/MYMETA.yml") {
 492         eval {
 493             $meta = YAML::LoadFile("$dir/META.yml");
 494         };
 495         print Dumper $@ if $@;
 496     }
 497     elsif(-s "$dir/META.json") {
 498         eval {
 499             require JSON;
 500             $meta = JSON::from_json(`cat $dir/META.json | tr '\n' ' '`);
 501         };
 502         print Dumper $@ if $@;
 503     }
 504     elsif(-s "$dir/META.yml") {
 505         eval {
 506             require YAML;
 507             $meta = YAML::LoadFile("$dir/META.yml");
 508         };
 509         print Dumper $@ if $@;
 510     }
 511     $meta->{requires} = {} unless defined $meta->{requires};
 512     if(-s "$dir/Makefile.PL") {
 513         my $content = `cat $dir/Makefile.PL`;
 514         if($content =~ m/WriteMakefile\s*\(/) {
 515             if($content =~ m/'PREREQ_PM'\s*=>\s*\{(.*?)}/) {
 516                 my $mod_str = $1;
 517                 $mod_str    =~ s/\n/ /g;
 518                 my %modules = $mod_str =~ m/\'(.*?)'\s*=>\s*\'(.*?)\'/;
 519                 %{$meta->{requires}} = (%{$meta->{requires}}, %modules);
 520             }
 521         }
 522         if($content =~ m/^\s*requires\s+/m) {
 523             my %modules = $content =~ m/^\s*requires\s+(.*?)\s*=>\s*(.*?);/gm;
 524             %{$meta->{requires}} = (%{$meta->{requires}}, %modules);
 525         }
 526         if($content =~ m/^\s*use\s+[a-zA-Z:]+\s*/m) {
 527             my %modules = $content =~ m/^\s*use\s+([a-zA-Z:]+)\s*([\d\.]+)/gm;
 528             delete $modules{'inc::Module::Install'};
 529             delete $modules{'inc::Module::Install::DSL'};
 530             %{$meta->{requires}} = (%{$meta->{requires}}, %modules);
 531         }
 532     }
 533
 534     # add deps from the Makefile
 535     if(-s "$dir/Makefile") {
 536         my $prereq = `grep PREREQ_PM $dir/Makefile`;
 537         chomp($prereq);
 538         $prereq =~ s/^#\s+PREREQ_PM\s*=>\s*({.*}).*$/\$req = $1;/g;
 539         $prereq =~ s/([\w:]+)=/'$1'=/g;
 540         my $req;
 541         eval($prereq);
 542         if(defined $req) {
 543             for my $mod (keys %{$req}) {
 544                 $meta->{requires}->{$mod} = $req->{$mod};
 545             }
 546         }
 547     }
 548
 549     $meta->{requires}           = {} unless defined $meta->{requires};
 550     $meta->{build_requires}     = {} unless defined $meta->{build_requires};
 551     $meta->{configure_requires} = {} unless defined $meta->{configure_requires};
 552     $meta->{prereqs}->{'build'}->{'requires'}     = {} unless defined $meta->{prereqs}->{'build'}->{'requires'};
 553     $meta->{prereqs}->{'configure'}->{'requires'} = {} unless defined $meta->{prereqs}->{'configure'}->{'requires'};
 554     $meta->{prereqs}->{'runtime'}->{'requires'}   = {} unless defined $meta->{prereqs}->{'runtime'}->{'requires'};
 555
 556     $meta->{requires}->{'Module::Build'} = 1 if -s $dir.'/Build.PL';
 557
 558     if(!defined $meta->{name}) {
 559         $meta->{name} = $dir;
 560         $meta->{name} =~ s/^(.*)\-.*?$/$1/;
 561         $meta->{name} =~ s/\-/::/g;
 562     }
 563
 564     return $meta;
 565 }
 566
 567 ####################################
 568 # return dependencies from meta data
 569 sub get_deps_from_meta {
 570     my($meta, $all) = @_;
 571     my %deps = (%{$meta->{requires}},
 572                 %{$meta->{build_requires}},
 573                 %{$meta->{configure_requires}},
 574                 %{$meta->{prereqs}->{'build'}->{'requires'}},
 575                 %{$meta->{prereqs}->{'configure'}->{'requires'}},
 576                 %{$meta->{prereqs}->{'runtime'}->{'requires'}},
 577                );
 578     my $stripped_deps = {};
 579     for my $dep (keys %deps) {
 580         my $val = $deps{$dep};
 581         $dep =~ s/('|")//gmx;
 582         $val =~ s/('|")//gmx;
 583         next if $dep eq 'perl';
 584         next if $dep eq 'warnings';
 585         next if $dep eq 'strict';
 586         next if $dep eq 'lib';
 587         next if $dep eq 'v';
 588         if(!$all) {
 589             next if $dep eq 'IPC::Open'; # core module but not recognized
 590             next if $dep =~ m/^Test::/;
 591             next if $dep eq 'Test';
 592         }
 593         $stripped_deps->{$dep} = $val;
 594     }
 595     return $stripped_deps;
 596 }
 597
 598 ####################################
 599 # add additional dependencies
 600 sub add_additional_deps {
 601     my($file, $deps) = @_;
 602     my($modname, $modvers) = file_to_module($file);
 603     if($additional_deps->{$modname}) {
 604         for my $key (keys %{$additional_deps->{$modname}}) {
 605             $deps->{$key} = $additional_deps->{$modname}->{$key};
 606         }
 607     }
 608     return $deps;
 609 }
 610
 611 ####################################
 612 # return dependencies from meta data
 613 sub unpack {
 614     my $file = shift;
 615     if($file =~ m/\.zip$/gmx) {
 616         BuildHelper::cmd("unzip $file");
 617     } else {
 618         BuildHelper::cmd("tar zxf $file");
 619     }
 620     my $dir = $file;
 621     $dir =~  s/(\.tar\.gz|\.tgz|\.zip)//g;
 622     $dir =~  s/.*\///g;
 623     $dir =~  s/\-src//g;
 624     return $dir;
 625 }
 626
 627 ####################################
 628 # find orphaned packages
 629 sub get_orphaned {
 630     my($deps, $files, $verbose) = @_;
 631     my $orphaned = {};
 632     for my $file (keys %{$deps}) {
 633         # verify this module is used somewhere
 634         my $found = 0;
 635         for my $file2 (keys %{$deps}) {
 636             next if $file eq $file2;
 637             for my $dep2 (keys %{$deps->{$file2}}) {
 638                 next if $dep2 eq 'perl';
 639                 next if $dep2 eq 'strict';
 640                 next if $dep2 eq 'warnings';
 641                 next if $dep2 eq 'lib';
 642                 next if $dep2 eq 'v';
 643                 my $fdep2 = BuildHelper::module_to_file($dep2, $files, $deps->{$file2}->{$dep2});
 644                 next unless $fdep2;
 645                 $found = 1 if $fdep2 eq $file;
 646                 if($found && $verbose) { print "$file is used by $file2\n"; }
 647                 last if $found;
 648             }
 649             last if $found;
 650         }
 651         $orphaned->{$file} = 1 unless $found;
 652     }
 653     return $orphaned;
 654 }
 655
 656 ####################################
 657 sub get_meta {
 658     my($in) = @_;
 659     my $meta = {};
 660     if($in =~ m/Makefile\.PL$/mx) {
 661         my $dir = $in;
 662         $dir    =~ s/Makefile\.PL$//gmx;
 663         $meta   = BuildHelper::get_meta_for_dir($dir);
 664     }
 665     elsif($in =~ m/(\.tar.gz|\.tgz|\.zip)$/mx) {
 666         $meta = get_meta_for_tarball($in);
 667     }
 668     else {
 669         die("unsupported file: ".$in);
 670     }
 671     return $meta;
 672 }
 673
 674 ####################################
 675 sub get_meta_for_tarball {
 676     my($file) = @_;
 677
 678     our %deps_files;
 679
 680     my $dir  = BuildHelper::unpack($file);
 681     my $meta = BuildHelper::get_meta_for_dir($dir);
 682
 683     for my $f (split/\n/,`find -name \*.pm; find -name \*.PL`) {
 684         next if $f =~ m|/inc/|mxo; # skip inc modules included by Module::Install packaged modules
 685         open(my $fh, '<', $f);
 686         while(my $line = <$fh>) {
 687             if($line =~ m/^package\s+(.*?)(\s|;|#)/) {
 688                 $deps_files{$1} = $file;
 689             }
 690         }
 691         close($fh);
 692     }
 693
 694     BuildHelper::cmd("rm -fr $dir");
 695     return($meta);
 696 }
 697
 698 1;