view release on metacpan or  search on metacpan

lib/NCustom.pm  view on Meta::CPAN

=cut

#====================================================================
sub required_packages {
  my ($requirements, @rest) = @_;
  my $status = 1;
  my $rc = 1;

  my @lines = split(/\n/,$requirements);
  foreach my $line (@lines){
    $line =~ s/^\s+//;          #trim leading whitespace
    next if $line =~ /^#/;      #TODO# comments need much work

    $req = { match => "", version => "0.0.0", pkg => "", result => ""};
    ($$req{'match'}, $$req{'version'}, $$req{'pkg'}, my @rest) 
      = parse_line('\s*;\s*',1, $line);
    my $code = join(';',@rest);

    $rc = check_pkg($req);
    unless($rc){$status = 0; next}

    if($$req{'result'} ne "OK"){
      #we invoke handler from caller's perspective
      package main ; 
      no strict; no warnings;
      eval $code ;
      if($@){
	carp("required_packages: code \n$code \nraised the error $@");
       	$NCustom::status = 0;
      }
      use strict; use warnings;
      #
      #back to normal
      package NCustom ;
      $rc = check_pkg($req);
      unless(($$req{'result'} eq "OK") && ($rc)){ $status = 0; }
    }
  }
  return $status;
}

#====================================================================
# apt_fix

=begin testing

test_reset();
SKIP: {
  skip "apt too intrusive", 6 unless (defined $ENV{'TEST_APT'} || defined $ENV{'TEST_ALL'});
#############
system('rpm -e perl-NCustomDummy > /dev/null 2>&1');
my ($version, $rc);
$version = `rpm -q perl-NCustomDummy --qf  \%{VERSION}`;
like($version, qr/package perl-NCustomDummy is not installed/)
  || diag("TEST:<test setup> must remove perl-NCustomDummy package");
#
#
can_ok("NCustom", qw(apt_fix)) 
  || diag("TEST:<apt_fix> is a public function of NCustom");
#
$rc = required_packages(<<'  EOF');
  EXACTLY;   9.9.9;   perl-NCustomDummy;   apt_fix()
  EOF
ok(! $rc)
  || diag("TEST:<required_packages> must return 0 if requirements arent met");
$version = `rpm -q perl-NCustomDummy --qf  \%{VERSION}`;
like($version, qr/1.23/)
  || diag("TEST:<apt_fix> must will install its version rather than nothing");
#
$rc = required_packages(<<'  EOF');
  NOTWANT;   9.9.9;   perl-NCustomDummy;   apt_fix()
  EOF
is($rc, 1)
  || diag("TEST:<required_packages> must return 1 if requirements are met");
$version = `rpm -q perl-NCustomDummy --qf  \%{VERSION}`;
like($version, qr/package perl-NCustomDummy is not installed/)
  || diag("TEST:<apt_fix> will remove unwanted packages");
############
}
output();

=end testing

=cut

#====================================================================
sub apt_fix {
  if($$req{'result'} =~ /UNWELCOME/){
    system("apt-get -q -y remove $$req{'pkg'}");
  }else{
    system("apt-get -q -y install $$req{'pkg'}");
  }
  return 1; #hmm
}

#====================================================================
# vcmp

=begin testing

#FALSE
ok(! &NCustom::vcmp(1,"gt",2) )
  || diag("TEST:<vcmp> compares version strings");
ok(! &NCustom::vcmp(1,"eq",2) )
  || diag("TEST:<vcmp> compares version strings");
ok(! &NCustom::vcmp(3,"gt",3) )
  || diag("TEST:<vcmp> compares version strings");
ok(! &NCustom::vcmp(3,"lt",3) )
  || diag("TEST:<vcmp> compares version strings");
ok(! &NCustom::vcmp(3,"ne",3) )
  || diag("TEST:<vcmp> compares version strings");
#
#TRUE";
ok(&NCustom::vcmp(1,"lt",2) )
  || diag("TEST:<vcmp> compares version strings");
ok(&NCustom::vcmp(1,"ne",2) )
  || diag("TEST:<vcmp> compares version strings");
ok(&NCustom::vcmp(3,"eq",3) )
  || diag("TEST:<vcmp> compares version strings");
ok(&NCustom::vcmp("1.2.3","lt",2) )
  || diag("TEST:<vcmp> compares version strings");
ok(&NCustom::vcmp("1.2.3","gt","1.1.99") )
  || diag("TEST:<vcmp> compares version strings");
ok(&NCustom::vcmp("1.2.3","eq","1.2.3") )
  || diag("TEST:<vcmp> compares version strings");
ok(&NCustom::vcmp(1,"ne",0) )
  || diag("TEST:<vcmp> compares version strings");
ok(&NCustom::vcmp("1.2.3","lt",2) )
  || diag("TEST:<vcmp> compares version strings");
ok(&NCustom::vcmp("1.2.3","gt","1.1.99") )