Crypt-License

 view release on metacpan or  search on metacpan

License.pm  view on Meta::CPAN

  foreach my $i(0..$end) {
    $_[$i] = '' unless $_[$i];
    &$print_err("$caller[$i]\t= $_[$i]\n") if $DEBUG;
  }
};

my ($user,$grp,$pwd);

$user_info = sub {
  ($pwd) = @_;
  $user = (getpwuid( (stat($pwd))[4] ))[0];
  $grp = (getgrgid( (stat($pwd))[5] ))[0];
  my $i;
  if ( $pwd !~ m|^/| ) {
    $i = `/bin/pwd`;
    $i =~ s/\s+//g;
    $pwd = $i .'/'. $pwd;
  }
  $pwd =~ s#/\./#/#g;
  @_ = split('/',$pwd);
  $pwd= '';

Notice/Notice.pm  view on Meta::CPAN

	if $_[$_] =~ /[^\d]/;
    $_[$_] *= $multx{$multx};
  }
  my $expiring;
  my @intervals = sort {$b <=> $a;} @_;
  foreach(@intervals) {
    last if $_ < $p->{expires};
    $expiring = $_;
  }
  if ( $expiring ) {
    my $user = (getpwuid( (stat($p->{path}))[4] ))[0];
    my $nf = "$tmp_dir/$user.bln";		# notice file
    my $ctime = ( -e $nf ) ? (stat($nf))[10] : 0;
    my $now = time;
    if ( $ctime + $expiring < $now ) {
      open(LIC,$p->{path}) or return ();	# sorry, missing license
      my $slurp = '';
      while(<LIC>) {
	next unless $slurp || $_ =~ /:\s*:/;
	$slurp .= $_;
      }

Util/Util.pm  view on Meta::CPAN

  $p->{path} = $main::ptr2_License->{path};
}
sub path2License {
  my($n) = @_;
  $n = 'README.LICENSE' unless $n;
  my ($m,$f) = caller;
  my $p;
  unless (defined ($p = ${"${m}::ptr2_License"})) {
    $p = &_createPointer2License($m);
  }
  $p->{path} = (getpwuid((stat($f))[4]))[7] .'/'.$n;
}
sub chain2next {
  my($p2L) = @_;
  $p2L->{next} = caller(1);
}
sub chain2prevLicense {
  my $m = caller;
  my $p;
  unless (defined ($p = ${"${m}::ptr2_License"})) {
    $p = &_createPointer2License($m);

Util/t/util.t  view on Meta::CPAN

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

$test = 2;

# NOT really needed =>use vars qw($ptr2_License);

my $me = (getpwuid((stat(&{sub {(caller)[1]};}))[4]))[7];
my $expected = $me .'/'.'README.LICENSE';

my $rv = path2License();

print "ptr2_License text does not match
got: $ptr2_License->{path}
exp: $expected\nnot "
	unless $ptr2_License->{path} eq $expected;
print "ok $test\n";
++$test;