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= '';
  $#_ -=1;

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 .= $_;
      }
      close LIC;
# now send the message

Notice/t/notice.t  view on Meta::CPAN

foreach my $chk (5,2) {
# check that abutting timeout is NOT found
  &no_find($chk) unless $chk == 5;	# skip first back check
# check that overflow value is found
  $ptr->{expires} = $chk;
  $prev = &next_sec(time);
  Crypt::License::Notice->check($ptr);
  $_ = `/bin/cat $notice`;
  print "$chk, notice text does not match expected\nnot " unless $_ eq $expected_txt;
  &OK_test;
  $ctime = (stat("$ptr->{TMPDIR}/$user.bln"))[10];
  print "ctime $ctime is not now $prev\nnot " unless $ctime == $prev;
  &OK_test;
  unlink $notice;
}
# check 0 -- expired is not found ever
&no_find(0);
&no_find(0);

unlink "$ptr->{TMPDIR}/$user.bln" if ( -e "$ptr->{TMPDIR}/$user.bln");	# clean up

Notice/t/notice.t  view on Meta::CPAN

}

sub no_find {
  my $chk = $_[0];
  $ptr->{expires} = $chk + 1;
  do { $tmp = &next_sec(time) } while ( $tmp < $prev + $ptr->{expires});
# wait for next epoch
  Crypt::License::Notice->check($ptr);
  print "$chk , unexpected notice found for check $ptr->{expires}\nnot " if (-e $notice);
  &OK_test;
  $ctime = (stat("$ptr->{TMPDIR}/$user.bln"))[10];
  print "ctime $ctime should be $prev\nnot " unless $ctime == $prev;
  &OK_test;
}

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;

makeCrypt.pl  view on Meta::CPAN

@_ = split('::',$mod);
my $tgt = (pop @_);
my $xpath = join('/',@_);

$src = "$tgt.PM" unless @ARGV > 2;	# if Loader

undef @ARGV;		# for mod_parser

die "no source file" unless $src && open(S,$src);
read(S,$_,(stat(S))[7]);
close S;
open(T,">$insdir/$xpath/$tgt.pm") or die "could not open target";
print T $_;
close T;

do './mod_parser.pl';

$sdir = "$insdir/auto";
if ($sdir && -e $sdir) {
  autosplit("$insdir/$xpath/$tgt.pm","$sdir",0,1,0);

makeCrypt.pl  view on Meta::CPAN

  @_ = grep(/\.al$/,readdir(S));
  closedir S;
  foreach(@_) {
    &crypt_mod("$sdir/$_","$sdir/$_",$method,$id,$nocrypt);
  }
  open(S,">>$sdir/autosplit.ix");
  close S;				# touched
}
&crypt_mod($src,"$tgt.pm",$method,$id,$nocrypt);
open(S,"$tgt.pm");
read(S,$_,(stat(S))[7]);
close S;
open(T,">$insdir/$xpath/$tgt.pm");
print T $_;
close T;