ASP4x-Captcha-Imager

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

	unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
		unshift @INC, $self->{prefix};
	}

	foreach my $rv ( $self->find_extensions($path) ) {
		my ($file, $pkg) = @{$rv};
		next if $self->{pathnames}{$pkg};

		local $@;
		my $new = eval { require $file; $pkg->can('new') };
		unless ( $new ) {
			warn $@ if $@;
			next;
		}
		$self->{pathnames}{$pkg} = delete $INC{$file};
		push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
	}

	$self->{extensions} ||= [];
}

inc/Module/Install/Base.pm  view on Meta::CPAN

    }

    bless( \%args, $class );
}

#line 61

sub AUTOLOAD {
    my $self = shift;
    local $@;
    my $autoload = eval { $self->_top->autoload } or return;
    goto &$autoload;
}

#line 76

sub _top { $_[0]->{_top} }

#line 89

sub admin {

inc/Module/Install/Can.pm  view on Meta::CPAN

sub can_use {
	my ($self, $mod, $ver) = @_;
	$mod =~ s{::|\\}{/}g;
	$mod .= '.pm' unless $mod =~ /\.pm$/i;

	my $pkg = $mod;
	$pkg =~ s{/}{::}g;
	$pkg =~ s{\.pm$}{}i;

	local $@;
	eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}

# check if we can run some command
sub can_run {
	my ($self, $cmd) = @_;

	my $_cmd = $cmd;
	return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));

	for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {

inc/Module/Install/Fetch.pm  view on Meta::CPAN

	$VERSION = '0.79';
	$ISCORE  = 1;
	@ISA     = qw{Module::Install::Base};
}

sub get_file {
    my ($self, %args) = @_;
    my ($scheme, $host, $path, $file) =
        $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;

    if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
        $args{url} = $args{ftp_url}
            or (warn("LWP support unavailable!\n"), return);
        ($scheme, $host, $path, $file) =
            $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
    }

    $|++;
    print "Fetching '$file' from $host... ";

    unless (eval { require Socket; Socket::inet_aton($host) }) {
        warn "'$host' resolve failed!\n";
        return;
    }

    return unless $scheme eq 'ftp' or $scheme eq 'http';

    require Cwd;
    my $dir = Cwd::getcwd();
    chdir $args{local_dir} or return if exists $args{local_dir};

    if (eval { require LWP::Simple; 1 }) {
        LWP::Simple::mirror($args{url}, $file);
    }
    elsif (eval { require Net::FTP; 1 }) { eval {
        # use Net::FTP to get past firewall
        my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
        $ftp->login("anonymous", 'anonymous@example.com');
        $ftp->cwd($path);
        $ftp->binary;
        $ftp->get($file) or (warn("$!\n"), return);
        $ftp->quit;
    } }
    elsif (my $ftp = $self->can_run('ftp')) { eval {
        # no Net::FTP, fallback to ftp.exe
        require FileHandle;
        my $fh = FileHandle->new;

        local $SIG{CHLD} = 'IGNORE';
        unless ($fh->open("|$ftp -n")) {
            warn "Couldn't open ftp: $!\n";
            chdir $dir; return;
        }

inc/Module/Install/Makefile.pm  view on Meta::CPAN

	$args->{NAME}     = $self->module_name || $self->name;
	$args->{VERSION}  = $self->version;
	$args->{NAME}     =~ s/-/::/g;
	if ( $self->tests ) {
		$args->{test} = { TESTS => $self->tests };
	}
	if ($] >= 5.005) {
		$args->{ABSTRACT} = $self->abstract;
		$args->{AUTHOR}   = $self->author;
	}
	if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
		$args->{NO_META} = 1;
	}
	if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
		$args->{SIGN} = 1;
	}
	unless ( $self->is_admin ) {
		delete $args->{SIGN};
	}

	# merge both kinds of requires into prereq_pm
	my $prereq = ($args->{PREREQ_PM} ||= {});
	%$prereq = ( %$prereq,
		map { @$_ }

inc/Module/Install/Makefile.pm  view on Meta::CPAN

	my $subdirs = ($args->{DIR} ||= []);
	if ($self->bundles) {
		foreach my $bundle (@{ $self->bundles }) {
			my ($file, $dir) = @$bundle;
			push @$subdirs, $dir if -d $dir;
			delete $prereq->{$file};
		}
	}

	if ( my $perl_version = $self->perl_version ) {
		eval "use $perl_version; 1"
			or die "ERROR: perl: Version $] is installed, "
			. "but we need version >= $perl_version";
	}

	$args->{INSTALLDIRS} = $self->installdirs;

	my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;

	my $user_preop = delete $args{dist}->{PREOP};
	if (my $preop = $self->admin->preop($user_preop)) {

lib/ASP4x/Captcha/Imager.pm  view on Meta::CPAN

sub run
{
  my ($s, $context) = @_;
  
  my ($word, $key) = $s->generate_pair( $context );
  
  $Session->{asp4captcha} = { lc($word) => $key };
  $word = join ' ', split //, $word;
  
  my $img = Imager->new(
    xsize => eval { $Config->system->settings->captcha_width }  || 140,
    ysize => eval { $Config->system->settings->captcha_height } || 70
  );

  $img->box(
    filled => 1,
    color  => eval { $Config->system->settings->captcha_bg_color } || 'white'
  );

  my $font = Imager::Font->new( $s->font );

  my @colors = qw(
    A9A9A9  878787  656565  808080
    CACACA  EFEFEF  DEDEDE  CDCDCD
    BABABA  A9A9A9  878787  656565
    434343  212121  EFEFEF  DEDEDE
    CDCDCD  BABABA  CCCCCC  AAAAAA

lib/ASP4x/Captcha/Imager.pm  view on Meta::CPAN

  $Response->SetHeader('content-type' => 'image/png');
  $Response->ContentType( 'image/png' );
  $Response->Write( $str );
}# end run()


sub generate_pair
{
  my ($s, $context) = @_;

  my $len = eval { $Config->system->settings->captcha_length } || 4;
  my $chars = join '', ( 'A'..'H', 'J'..'N', 'P'..'Z', 1..9 );

  my $word = '';
  while( length($word) < $len )
  {
    $word .= substr($chars, int(rand()*length($chars)), 1);
  }# end while()
  
  my $key = md5_hex( lc($word) . ( eval { $Config->system->settings->captcha_key } || '' ) );
  
  return ( $word, $key );
}# end generate_pair()


sub font
{
  my $s = shift;
  
  return ( file => $Config->system->settings->captcha_font );