Data-Passphrase
2 results

 view release on metacpan or  search on metacpan

lib/Data/Passphrase/Apache.pm  view on Meta::CPAN 

}
END

        return 0;
    }

    # trivial form handler
    sub dispatch_form {
        my ($arg_ref) = @_;

        # unpack arguments
        my $debug = $arg_ref->{debug};
        my $passphrase = $arg_ref->{apv_ref}{passphrase};
        my $username   = $arg_ref->{apv_ref}{username  };

        # if a passphrase is supplied, validate it
        my ($code, $message, $score);
        if (defined $passphrase) {
            $debug and warn 'validating supplied passphrase';

            # special case for localhost: call subroutine directly
            my $location = $arg_ref->{config}->get($CONFIG_LOCATION);
            if (!defined $location || $location eq 'localhost') {
                my $response = validate_passphrase {
                    %{$arg_ref->{apv_ref}},
                    debug => $arg_ref->{debug},
                };

                $code    = $response->{code   };
                $message = $response->{message};
                $score   = $response->{score  };
            }

            # if location is remote, do an HTTP request
            else {
                $debug and warn "making request to $location";
                my $user_agent = LWP::UserAgent->new();
                my $response   = $user_agent->post(
                    $location,
                    passphrase => $passphrase,
                    username   => $username  ,
                );
                $code    = $response->code   ();
                $message = $response->message();
                $score   = $response->score  ();
            }

            $debug and warn "response: $code $message, score: $score\%";
        }

        $debug and warn 'printing form';

        # print header
        my $r = $arg_ref->{r};
        $r->content_type("text/html");
        if (!$IS_MOD_PERL_2) {
            $r->send_http_header();
        }
        print <<"END";
<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head><title>Validate Passphrase</title></head>
<body>
END

        # print validation message if validation occurred
        if (defined $message) {
            print '<p><strong>Passphrase ', encode_entities($message),
                "score: $score\%</strong></p>";
        }

        # print footer
        print <<"END";
<form method="post">
<input name="passphrase" size="127" type="password" />
<input type="submit" value="Check Strength" />
</form>
</body>
</html>
END

        return 0;
    }

    sub dispatch_soap {
        my ($arg_ref) = @_;

        # only allow passphrase & username attributes to be accessed from soap
        my $apreq = $arg_ref->{apreq};
        my $table = $apreq->param();
        $table->clear();
        if (exists $arg_ref->{passphrase}) {
            $table->set(passphrase => $arg_ref->{passphrase});
        }
        if (exists $arg_ref->{username}) {
            $table->set(username => $arg_ref->{username});
        }

        require SOAP::Transport::HTTP;
        return SOAP::Transport::HTTP::Apache
            ->dispatch_to(__PACKAGE__ . '::validate_passphrase')
            ->handle(@_);
    }

    sub dispatch_wsdl {
        my ($arg_ref) = @_;

        # unpack arguments
        my $config = $arg_ref->{config};

        # determine WSDL namespace
        my $wsdl_namespace = $config->get($CONFIG_WSDL_NS);
        if (!defined $wsdl_namespace) {
            (my $path = __PACKAGE__) =~ s{::}{/}g;
            my $r = $arg_ref->{r};
            my $hostname = $r->hostname();
            (my $uri = $r->uri()) =~ s{/$}{};
            $wsdl_namespace = "http://$hostname$uri/$path";
        }



( run in 0.825 second using v1.01-cache-2.11-cpan-39bf76dae61 )