Jifty-Plugin-OpenID-1.02/0000755000175000017500000000000011325032045015300 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/README0000644000175000017500000001031111325025533016160 0ustar agostiniagostiniNAME Jifty::Plugin::OpenID - Provides OpenID authentication for your jifty app DESCRIPTION Provides OpenID authentication for your app USAGE Config please provide "OpenIDSecret" in your etc/config.yml , the "OpenIDUA" is optional , OpenID Plugin will use LWPx::ParanoidAgent by default. --- application: OpenIDSecret: 1234 OpenIDUA: LWP::UserAgent or you can set "OpenIDUserAgent" environment var in command-line: OpenIDUserAgent=LWP::UserAgent bin/jifty server if you are using LWPx::ParanoidAgent as your openid agent. you will need to provide "JIFTY_OPENID_WHITELIST_HOST" for your own OpenID server. export JIFTY_OPENID_WHITELIST_HOST=123.123.123.123 User Model Create your user model , and let it uses Jifty::Plugin::OpenID::Mixin::Model::User to mixin "openid" column. and a "name" method. use TestApp::Record schema { column email => type is 'varchar'; }; use Jifty::Plugin::OpenID::Mixin::Model::User; sub name { my $self = shift; return $self->email; } Note: you might need to declare a "name" method. because the OpenID CreateOpenIDUser action and SkeletonApp needs current_user->username to show welcome message and success message , which calls "brief_description" method. See Jifty::Record for "brief_description" method. View OpenID plugin provides AuthenticateOpenID Action. so that you can render an AuthenticateOpenID in your template: form { my $openid = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); render_action( $openid ); }; this action renders a form which provides openid url field. and you will need to provide a submit button in your form. form { my $openid = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); # .... render_action( $openid ); outs_raw( Jifty->web->return( to => '/openid_verify_done', label => _("Login with OpenID"), submit => $openid )); }; the "to" field is for verified user to redirect to. so that you will need to implement a template called "/openid_verify_done": template '/openid_verify_done' => page { h1 { "Done" }; }; Attribute Exchange You can retrieve information from remote profile on authentication server with OpenID Attribute Exchange service extension. Set in your config.yml - OpenID: ax_param: openid.ns.ax=http://openid.net/srv/ax/1.0&openid.ax.mode=fetch_request&openid.ax.type.email=http://axschema.org/contact/email&openid.ax.type.firstname=http://axschema.org/namePerson/first&openid.ax.type.lastname=http://axschema.org/namePerson/last&openid.ax.required=firstname,lastname,email ax_values: value.email,value.firstname,value.lastname ax_mapping: "{ 'email': 'value.email', 'name': 'value.firstname value.lastname' }" this parameters are usuable for all OpenID endpoints supporting Attribute Exchange extension. They can be overriden in your application. Watch and/or override "openid/wayf" template from Jifty::Plugin::OpenID::View. Or you can use in your view "show('openid/wayf','/url_return_to');". ax_param is the url send to authentication server. It defines namespace, mode, attributes types and requested attributes. hints : MyOpenID use schema.openid.net schemas instead of axschema.org, Google provides lastname and firstname, Yahoo only fullname ax_values keys of attributes values read from authentication server response. ax_mapping mapping of recieve values with your application fields in json format. AUTHORS Alex Vandiver, Cornelius , Yves Agostini LICENSE Copyright 2005-2010 Best Practical Solutions, LLC. This program is free software and may be modified and distributed under the same terms as Perl itself. Jifty-Plugin-OpenID-1.02/META.yml0000644000175000017500000000122711325032033016550 0ustar agostiniagostini--- abstract: 'Provides OpenID authentication for your jifty app' author: - 'Alex Vandiver, Cornelius , Yves Agostini' build_requires: ExtUtils::MakeMaker: 6.42 configure_requires: ExtUtils::MakeMaker: 6.42 distribution_type: module generated_by: 'Module::Install version 0.91' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Jifty-Plugin-OpenID no_index: directory: - inc - share - t requires: Cache::FileCache: 0 Jifty: 0 LWPx::ParanoidAgent: 0 Net::OpenID::Consumer: 1.03 resources: license: http://dev.perl.org/licenses/ version: 1.02 Jifty-Plugin-OpenID-1.02/Makefile.PL0000644000175000017500000000061411325031445017256 0ustar agostiniagostiniuse inc::Module::Install; name('Jifty-Plugin-OpenID'); all_from('lib/Jifty/Plugin/OpenID.pm'); requires('Jifty'); requires('Net::OpenID::Consumer' => '1.03' ); requires('Cache::FileCache'); # suspend this test on 1.00 will be back in 1.01 #requires('Test::OpenID::Server' ); requires('LWPx::ParanoidAgent'); install_share; auto_install(); #tests('t/*.t t/*/t/*.t'); tests('t/*.t'); WriteAll; Jifty-Plugin-OpenID-1.02/t/0000755000175000017500000000000011325032045015543 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/t/00-load.t0000644000175000017500000000015411325025073017067 0ustar agostiniagostini#!/usr/bin/env perl use warnings; use strict; use Test::More tests => 1; use_ok('Jifty::Plugin::OpenID'); Jifty-Plugin-OpenID-1.02/t/TestApp/0000755000175000017500000000000011325032045017123 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/t/TestApp/etc/0000755000175000017500000000000011325032045017676 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/t/TestApp/etc/config.yml0000644000175000017500000000236411325025073021676 0ustar agostiniagostini--- application: OpenIDSecret: 1234 OpenIDUA: LWP::UserAgent framework: AdminMode: 1 ApplicationClass: TestApp ApplicationName: TestApp ApplicationUUID: B2B2509E-3EC4-11DE-A47C-73233554FF8D ConfigFileVersion: 4 Database: AutoUpgrade: 1 CheckSchema: 1 Database: testapp Driver: SQLite Host: localhost Password: "" RecordBaseClass: Jifty::DBI::Record::Cachable User: "" Version: 0.0.1 DevelMode: 1 L10N: PoDir: share/po LogLevel: INFO Mailer: Sendmail MailerArgs: [] Plugins: - AdminUI: {} - CompressedCSSandJS: {} - ErrorTemplates: {} - Halo: {} - LetMe: {} - OnlineDocs: {} - REST: {} - SkeletonApp: {} - OpenID: {} PubSub: Backend: Memcached Enable: ~ SkipAccessControl: 0 TemplateClass: TestApp::View View: Handlers: - Jifty::View::Static::Handler - Jifty::View::Declare::Handler - Jifty::View::Mason::Handler Web: BaseURL: http://localhost DataDir: var/mason Globals: [] MasonConfig: autoflush: 0 default_escape_flags: h error_format: text error_mode: fatal Port: 8888 ServeStaticFiles: 1 StaticRoot: share/web/static TemplateRoot: share/web/templates Jifty-Plugin-OpenID-1.02/t/TestApp/t/0000755000175000017500000000000011325032045017366 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/t/TestApp/t/01-ax-test.t0000644000175000017500000000072611325025073021366 0ustar agostiniagostini#!/usr/bin/env perl use Jifty::Test tests => 5; use strict; use warnings; use Jifty::Test::WWW::Mechanize; my $server = Jifty::Test->make_server; isa_ok( $server, 'Jifty::Server' ); my $URL = $server->started_ok; my $mech = Jifty::Test::WWW::Mechanize->new; $mech->get_ok( $URL . '/' , "get mainpage" ); $mech->content_contains('www.google.com/accounts/o8/id'); $mech->get_ok( $URL . '/static/oidimg/FriendConnect.gif' , "get share element" ); #print $mech->content; Jifty-Plugin-OpenID-1.02/t/TestApp/t/00-model-User.t0000644000175000017500000000233611325025073022013 0ustar agostiniagostini#!/usr/bin/env perl use warnings; use strict; =head1 DESCRIPTION A basic test harness for the User model. =cut use Jifty::Test tests => 11; # Make sure we can load the model use_ok('TestApp::Model::User'); # Grab a system user my $system_user = TestApp::CurrentUser->superuser; ok($system_user, "Found a system user"); # Try testing a create my $o = TestApp::Model::User->new(current_user => $system_user); my ($id) = $o->create(); ok($id, "User create returned success"); ok($o->id, "New User has valid id set"); is($o->id, $id, "Create returned the right id"); # And another $o->create(); ok($o->id, "User create returned another value"); isnt($o->id, $id, "And it is different from the previous one"); # Searches in general my $collection = TestApp::Model::UserCollection->new(current_user => $system_user); $collection->unlimit; is($collection->count, 2, "Finds two records"); # Searches in specific $collection->limit(column => 'id', value => $o->id); is($collection->count, 1, "Finds one record with specific id"); # Delete one of them $o->delete; $collection->redo_search; is($collection->count, 0, "Deleted row is gone"); # And the other one is still there $collection->unlimit; is($collection->count, 1, "Still one left"); Jifty-Plugin-OpenID-1.02/t/TestApp/t/00-openid-test.t0000644000175000017500000000276211325025073022235 0ustar agostiniagostini#!/usr/bin/env perl use Jifty::Test tests => 12; use strict; use warnings; use Jifty::Test::WWW::Mechanize; use Test::OpenID::Server; my $test_openid_server = Test::OpenID::Server->new; my $test_openid_url = $test_openid_server->started_ok("server started ok"); diag $test_openid_url; my $openid = "$test_openid_url/c9s"; my $server = Jifty::Test->make_server; isa_ok( $server, 'Jifty::Server' ); my $URL = $server->started_ok; my $mech = Jifty::Test::WWW::Mechanize->new; $mech->get_ok( $URL . '/' , "get mainpage" ); $mech->content_contains( 'Login with OpenID' ); $mech->content_contains( 'OpenID URL' ); $mech->content_contains( 'For example:' ); $mech->submit_form( form_name => 'openid-form', fields => { 'J:A:F-openid-authenticateopenid' => $openid, }, # button => 'Login with OpenID' ); $mech->content_contains( 'Set your username' ); # match this name="J:A:F-name-auto-86d3fcd1a158d85fd2e6165fc00113c7-1" my $content = $mech->content(); my ($field_name) = ($content =~ m[name="(J:A:F-email-auto-\w+-\d)"]gsm); diag $field_name; $mech->submit_form( form_name => 'openid-user-create', fields => { # $field_name => 'c9s' $field_name => 'c9s@c9s' }, # button => 'Continue' ); $mech->content_contains( 'Welcome' ); my $u = TestApp::Model::User->new; $u->load_by_cols( email => 'c9s@c9s' ); ok( $u->id , 'found user' ); is( $u->email , 'c9s@c9s' , 'found openid register user' ); is( $u->openid , $openid , 'match openid' ); Jifty-Plugin-OpenID-1.02/t/TestApp/bin/0000755000175000017500000000000011325032045017673 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/t/TestApp/bin/jifty0000755000175000017500000000052711325025073020755 0ustar agostiniagostini#!/usr/bin/env perl use warnings; use strict; use UNIVERSAL::require; BEGIN { Jifty::Util->require or die $UNIVERSAL::require::ERROR; my $root = Jifty::Util->app_root(quiet => 1); unshift @INC, "$root/lib" if ($root); } use Jifty; use Jifty::Script; local $SIG{INT} = sub { warn "Stopped\n"; exit; }; Jifty::Script->dispatch(); Jifty-Plugin-OpenID-1.02/t/TestApp/lib/0000755000175000017500000000000011325032045017671 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/t/TestApp/lib/TestApp/0000755000175000017500000000000011325032045021251 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/t/TestApp/lib/TestApp/Model/0000755000175000017500000000000011325032045022311 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/t/TestApp/lib/TestApp/Model/User.pm0000644000175000017500000000041411325025073023567 0ustar agostiniagostiniuse strict; use warnings; package TestApp::Model::User; use Jifty::DBI::Schema; use TestApp::Record schema { column email => type is 'varchar'; }; use Jifty::Plugin::OpenID::Mixin::Model::User; sub name { my $self = shift; return $self->email; } 1; Jifty-Plugin-OpenID-1.02/t/TestApp/lib/TestApp/View.pm0000644000175000017500000000147311325025073022531 0ustar agostiniagostinipackage TestApp::View; use strict; use warnings; use Jifty::View::Declare -base; use Jifty::View::Declare::Helpers; template '/' => page { with ( name => 'openid-form' ), form { my $openid = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); div { { class is 'openid'}; div { { id is 'openid-login' }; render_action( $openid ); outs_raw( Jifty->web->return( to => '/openid_verify_done', label => _("Login with OpenID"), submit => $openid )); }; }; }; show 'openid/wayf', '/'; }; template '/openid_verify_done' => page { h1 { "Done" }; }; 1; Jifty-Plugin-OpenID-1.02/share/0000755000175000017500000000000011325032045016402 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/share/po/0000755000175000017500000000000011325032045017020 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/share/po/openid.pot0000644000175000017500000000605311325025073021031 0ustar agostiniagostini# SOME DESCRIPTIVE TITLE. # Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER # This file is distributed under the same license as the PACKAGE package. # FIRST AUTHOR , YEAR. # #, fuzzy msgid "" msgstr "" "Project-Id-Version: PACKAGE VERSION\n" "POT-Creation-Date: YEAR-MO-DA HO:MI+ZONE\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" #: ../../lib/Jifty/Plugin/OpenID/View.pm:74 msgid "Continue" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:35 msgid "Go for it!" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:59 msgid "If the username provided conflicts with an existing username or contains invalid characters, you will have to give us a new one." msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:72 msgid "A link to confirm this email will be sent to receive later notifications." msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:27 msgid "If you have a Livejournal or other OpenID account, you don't even need to sign up. Just log in." msgstr "" #. (@{[$csr->err]}) #: ../../lib/Jifty/Plugin/OpenID/Action/AuthenticateOpenID.pm:68 msgid "Invalid OpenID URL. Please check to make sure it is correct. (%1)" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/Dispatcher.pm:45 msgid "It looks like someone is already using that OpenID." msgstr "" #: ../../lib/Jifty/Plugin/OpenID.pm:86 msgid "Login with OpenID" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:17 msgid "Login with your OpenID" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/Action/AuthenticateOpenID.pm:27 msgid "OpenID URL" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/Action/AuthenticateOpenID.pm:29 msgid "For example: you.livejournal.com" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/Action/VerifyOpenID.pm:48 msgid "OpenID verification failed. It looks like you cancelled the OpenID verification request." msgstr "" #: ../../lib/Jifty/Plugin/OpenID/Action/VerifyOpenID.pm:57 msgid "OpenID verification failed: " msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:48 msgid "Set your username" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:96 msgid "Sign in with your Google Account" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:128 msgid "Sign in with your MyOpenID Account" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:112 msgid "Sign in with your Yahoo account" msgstr "" #. ($openid) #: ../../lib/Jifty/Plugin/OpenID/Dispatcher.pm:50 msgid "The OpenID '%1' has been linked to your account." msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:53 msgid "We need you to set a username or quickly check the one associated with your OpenID. Your username is what other people will see when you ask questions or make suggestions" msgstr "" #: ../../lib/Jifty/Plugin/OpenID/Dispatcher.pm:66 msgid "Welcome back, " msgstr "" #: ../../lib/Jifty/Plugin/OpenID/Action/CreateOpenIDUser.pm:94 msgid "Welcome, " msgstr "" #: ../../lib/Jifty/Plugin/OpenID/View.pm:42 msgid "You already logged in." msgstr "" Jifty-Plugin-OpenID-1.02/share/po/fr.po0000644000175000017500000001011711325025073017772 0ustar agostiniagostini# SOME DESCRIPTIVE TITLE. # Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER # This file is distributed under the same license as the PACKAGE package. # FIRST AUTHOR , YEAR. # #, fuzzy msgid "" msgstr "" "Project-Id-Version: PACKAGE VERSION\n" "POT-Creation-Date: YEAR-MO-DA HO:MI+ZONE\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF8\n" "Content-Transfer-Encoding: 8bit\n" #: ../../lib/Jifty/Plugin/OpenID/View.pm:74 msgid "Continue" msgstr "Continuer" #: ../../lib/Jifty/Plugin/OpenID/View.pm:35 msgid "Go for it!" msgstr "Essayer ces valeurs !" #: ../../lib/Jifty/Plugin/OpenID/View.pm:59 msgid "If the username provided conflicts with an existing username or contains invalid characters, you will have to give us a new one." msgstr "Si le nom d'utilisateur est déjà utilisé ou contient des caractères non autorisés, vous devez en définir un autre." #: ../../lib/Jifty/Plugin/OpenID/View.pm:27 msgid "If you have a Livejournal or other OpenID account, you don't even need to sign up. Just log in." msgstr "Si vous avez un compte OpenID, vous n'avez pas besoin de créer un compte. Vous pouvez directement vous connecter." #. (@{[$csr->err]}) #: ../../lib/Jifty/Plugin/OpenID/Action/AuthenticateOpenID.pm:68 msgid "Invalid OpenID URL. Please check to make sure it is correct. (%1)" msgstr "URL OpenID incorrecte. Merci de la vérifier. (%1)" #: ../../lib/Jifty/Plugin/OpenID/Dispatcher.pm:45 msgid "It looks like someone is already using that OpenID." msgstr "Cet identifiant OpenID est déjà utilisé par un utilisateur." #: ../../lib/Jifty/Plugin/OpenID.pm:86 msgid "Login with OpenID" msgstr "Identification OpenID" #: ../../lib/Jifty/Plugin/OpenID/View.pm:17 msgid "Login with your OpenID" msgstr "Se connecter avec votre OpenID" #: ../../lib/Jifty/Plugin/OpenID/Action/AuthenticateOpenID.pm:27 msgid "OpenID URL" msgstr "URL OpenID" #: ../../lib/Jifty/Plugin/OpenID/Action/AuthenticateOpenID.pm:29 msgid "For example: you.livejournal.com" msgstr "Par exemple: you.livejournal.com" #: ../../lib/Jifty/Plugin/OpenID/Action/VerifyOpenID.pm:48 msgid "OpenID verification failed. It looks like you cancelled the OpenID verification request." msgstr "La vérification OpenID a échouée. Vous avez peut-être annulé la demande de vérification." #: ../../lib/Jifty/Plugin/OpenID/View.pm:72 msgid "A link to confirm this email will be sent to receive later notifications." msgstr "Un message pour confirmer cet email vous sera envoyé." #: ../../lib/Jifty/Plugin/OpenID/Action/VerifyOpenID.pm:57 msgid "OpenID verification failed: " msgstr "Vérification OpenId échouée: " #: ../../lib/Jifty/Plugin/OpenID/View.pm:48 msgid "Set your username" msgstr "Définissez votre nom d'utilisateurs" #: ../../lib/Jifty/Plugin/OpenID/View.pm:96 msgid "Sign in with your Google Account" msgstr "Se connecter avec un compte Google" #: ../../lib/Jifty/Plugin/OpenID/View.pm:128 msgid "Sign in with your MyOpenID Account" msgstr "Se connecter avec un compte MyOpenID" #: ../../lib/Jifty/Plugin/OpenID/View.pm:112 msgid "Sign in with your Yahoo account" msgstr "Se connecter avec un compte Yahoo" #. ($openid) #: ../../lib/Jifty/Plugin/OpenID/Dispatcher.pm:50 msgid "The OpenID '%1' has been linked to your account." msgstr "L'identifiant OpenID '%1' a été attaché à votre compte." #: ../../lib/Jifty/Plugin/OpenID/View.pm:53 msgid "We need you to set a username or quickly check the one associated with your OpenID. Your username is what other people will see when you ask questions or make suggestions" msgstr "Vous devez définir ou vérifier le nom d'utilisateur associé à votre IOpenID. C'est ce nom d'utilisateur qui apparaîtra lorsque vous publierez des informations." #: ../../lib/Jifty/Plugin/OpenID/Dispatcher.pm:66 msgid "Welcome back, " msgstr "Re-bonjour, " #: ../../lib/Jifty/Plugin/OpenID/Action/CreateOpenIDUser.pm:94 msgid "Welcome, " msgstr "Bienvenue, " #: ../../lib/Jifty/Plugin/OpenID/View.pm:42 msgid "You already logged in." msgstr "Vous êtes déjà connecté." Jifty-Plugin-OpenID-1.02/share/web/0000755000175000017500000000000011325032045017157 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/share/web/static/0000755000175000017500000000000011325032045020446 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/share/web/static/css/0000755000175000017500000000000011325032045021236 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/share/web/static/css/openidplugin.css0000644000175000017500000000027611325025073024455 0ustar agostiniagostini .argument-openid label { background: #FFFFFF url('/static/oidimg/openid-icon-small.gif') no-repeat scroll 0pt 50%; padding-left: 18px; } .openidwayf img { vertical-align:middle; } Jifty-Plugin-OpenID-1.02/share/web/static/oidimg/0000755000175000017500000000000011325032045021716 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/share/web/static/oidimg/myopenid.png0000644000175000017500000000102511325025073024251 0ustar agostiniagostiniPNG  IHDRh6 pHYs  IDAT(eM(qnnN2R֚yiJ41."R^a^JL.+X.4e^6=>/"9_9vݹvMH#'޹jLZm ks?|w26_/?>3}X~?$ o 1 nMpQ$ 8bWאo~no?0Drff`=AAYxxK{7J$\rAOGr-V1{RsWUI=d8"6ޡX8-AqNE}0QQ 1 5*=zrV2Ϻ+EgKaH%0VՕ!qti7}[VIENDB`Jifty-Plugin-OpenID-1.02/share/web/static/oidimg/yfavicon.gif0000644000175000017500000000013111325025073024221 0ustar agostiniagostiniGIF89a!,*}cp 0|㈀$7'*Nʅ(;Jifty-Plugin-OpenID-1.02/share/web/static/oidimg/FriendConnect.gif0000644000175000017500000000113011325025073025124 0ustar agostiniagostiniGIF87as%$/)*4)4166;7?@BB?E?GENGLPRORTRVVVYZPTNV^^_`]aZadeigmmlrtuvwvw|{uz؊抏͔ʝࡠ¢çĮůƴ輽,ssZ?@D68fsF>/Eij 設定檔內提供 C 欄位設定驗證碼。另外你也可以提供 C 來使用不同的代理器 (UserAgent) 類別 (非必要)。OpenID Plugin 則會預設使用 L . --- application: OpenIDSecret: 1234 OpenIDUA: LWP::UserAgent 你也可以從命令列指定你所要使用的代理器 (UserAgent) 類別 ，用 C: OpenIDUserAgent=LWP::UserAgent bin/jifty server 如果你想用 L 來作為你的 OpenID 代理器。 那麼如果你需要提供你自己的 OpenID 伺服器作為驗證，請將你的伺服器位址加入至 C 這個環境變數內: export JIFTY_OPENID_WHITELIST_HOST=123.123.123.123 =head2 User Model 第一步，你需要建立自己的 User 資料模型 ( Model ) 來存放使用者資料。 然後你需要將 UserID 插件提供的使用者模型結合你的 User 資料模型，讓你的 模型可以同時擁有 OpenID 插件所定義的欄位。 請在你的模型檔案內加入 use Jifty::Plugin::OpenID::Mixin::Model::User 此外 OpenID 插件會呼叫 UserModel 的 brief_description 函式來取得可閱讀的唯一值 在使用 CurrentUser 物件時，會需要讓 brief_description 函式來取得有意義的使用者名稱 所以你需要在 User 模型內實做 C 函式。 大致上看來會像這樣: use TestApp::Record schema { column email => type is 'varchar'; }; use Jifty::Plugin::OpenID::Mixin::Model::User; sub name { my $self = shift; return $self->email; } 請參見 L 所定義的 C 函式來了解更詳細的資訊。 =head2 View OpenID 插件提供了 AuthenticateOpenID 的動作 (Action) 。所以你可以在你的樣板中 來繪製 AuthenticationOpenID 提供的表單: form { my $openid = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); render_action( $openid ); }; 這個動作 (Action) 會繪製一個提供 OpenID 網址的欄位。 然後，你接著也需要在表單內提供一個送出的按鈕: form { my $openid = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); # .... render_action( $openid ); outs_raw( Jifty->web->return( to => '/openid_verify_done', label => _("Login with OpenID"), submit => $openid )); }; 在 C 欄位，是用來讓已經確認身份的使用者確認之後導向的頁面。 所以你需要實做一個 C 的樣板: template '/openid_verify_done' => page { h1 { "Done" }; }; 打開你的 Jifty ，測試一下吧! =head1 AUTHOR 林佑安 C<> L =cut sub init { my $self = shift; my %opt = @_; my $ua_class = $self->get_ua_class; eval "require $ua_class"; } sub get_ua_class { return Jifty->config->app('OpenIDUA') || $ENV{OpenIDUserAgent} || 'LWPx::ParanoidAgent' ; } sub new_ua { my $class = shift; my $ua; my $ua_class = $class->get_ua_class; if( $ua_class eq 'LWPx::ParanoidAgent' ) { $ua = LWPx::ParanoidAgent->new( whitelisted_hosts => [ $ENV{JIFTY_OPENID_WHITELIST_HOST} ] ); } else { $ua = $ua_class->new; } return $ua; } sub get_csr { my $class = shift; return Net::OpenID::Consumer->new( ua => $class->new_ua , cache => Cache::FileCache->new, args => scalar Jifty->handler->cgi->Vars, consumer_secret => Jifty->config->app('OpenIDSecret'), @_, ); } 1; Jifty-Plugin-OpenID-1.02/lib/0000755000175000017500000000000011325032045016046 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/lib/Jifty/0000755000175000017500000000000011325032045017133 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/0000755000175000017500000000000011325032045020371 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID.pm0000644000175000017500000001254111325025073022053 0ustar agostiniagostiniuse strict; use warnings; package Jifty::Plugin::OpenID; use base qw/Jifty::Plugin/; our $VERSION = '1.02'; =head1 NAME Jifty::Plugin::OpenID - Provides OpenID authentication for your jifty app =head1 DESCRIPTION Provides OpenID authentication for your app =head1 USAGE =head2 Config please provide C in your F , the C is B , OpenID Plugin will use L by default. --- application: OpenIDSecret: 1234 OpenIDUA: LWP::UserAgent or you can set C environment var in command-line: OpenIDUserAgent=LWP::UserAgent bin/jifty server if you are using L as your openid agent. you will need to provide C for your own OpenID server. export JIFTY_OPENID_WHITELIST_HOST=123.123.123.123 =head2 User Model Create your user model , and let it uses L to mixin "openid" column. and a C method. use TestApp::Record schema { column email => type is 'varchar'; }; use Jifty::Plugin::OpenID::Mixin::Model::User; sub name { my $self = shift; return $self->email; } Note: you might need to declare a C method. because the OpenID CreateOpenIDUser action and SkeletonApp needs current_user->username to show welcome message and success message , which calls C method. See L for C method. =head2 View OpenID plugin provides AuthenticateOpenID Action. so that you can render an AuthenticateOpenID in your template: form { my $openid = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); render_action( $openid ); }; this action renders a form which provides openid url field. and you will need to provide a submit button in your form. form { my $openid = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); # .... render_action( $openid ); outs_raw( Jifty->web->return( to => '/openid_verify_done', label => _("Login with OpenID"), submit => $openid )); }; the C field is for verified user to redirect to. so that you will need to implement a template called C: template '/openid_verify_done' => page { h1 { "Done" }; }; =head2 Attribute Exchange You can retrieve information from remote profile on authentication server with OpenID Attribute Exchange service extension. Set in your config.yml - OpenID: ax_param: openid.ns.ax=http://openid.net/srv/ax/1.0&openid.ax.mode=fetch_request&openid.ax.type.email=http://axschema.org/contact/email&openid.ax.type.firstname=http://axschema.org/namePerson/first&openid.ax.type.lastname=http://axschema.org/namePerson/last&openid.ax.required=firstname,lastname,email ax_values: value.email,value.firstname,value.lastname ax_mapping: "{ 'email': 'value.email', 'name': 'value.firstname value.lastname' }" this parameters are usuable for all OpenID endpoints supporting Attribute Exchange extension. They can be overriden in your application. Watch and/or override C template from L. Or you can use in your view C. =head3 ax_param is the url send to authentication server. It defines namespace, mode, attributes types and requested attributes. hints : MyOpenID use schema.openid.net schemas instead of axschema.org, Google provides lastname and firstname, Yahoo only fullname =head3 ax_values keys of attributes values read from authentication server response. =head3 ax_mapping mapping of recieve values with your application fields in json format. =cut __PACKAGE__->mk_accessors(qw(ax_mapping ax_values ax_param)); sub init { my $self = shift; my %opt = @_; my $ua_class = $self->get_ua_class; eval "require $ua_class"; $self->ax_param($opt{ax_param}); $self->ax_mapping($opt{ax_mapping}); $self->ax_values($opt{ax_values}); Jifty->web->add_css('openidplugin.css'); } sub get_ua_class { return Jifty->config->app('OpenIDUA') || $ENV{OpenIDUserAgent} || 'LWPx::ParanoidAgent' ; } sub new_ua { my $class = shift; my $ua; my $ua_class = $class->get_ua_class; Jifty->log->info( "OpenID Plugin is using $ua_class as UserAgent" ); if( $ua_class eq 'LWPx::ParanoidAgent' ) { $ua = LWPx::ParanoidAgent->new( whitelisted_hosts => [ $ENV{JIFTY_OPENID_WHITELIST_HOST} ] ); } else { $ua = $ua_class->new; } return $ua; } sub get_csr { my $class = shift; return Net::OpenID::Consumer->new( ua => $class->new_ua , cache => Cache::FileCache->new, args => scalar Jifty->handler->cgi->Vars, consumer_secret => Jifty->config->app('OpenIDSecret'), @_, ); } =head1 AUTHORS Alex Vandiver, Cornelius , Yves Agostini =head1 LICENSE Copyright 2005-2010 Best Practical Solutions, LLC. This program is free software and may be modified and distributed under the same terms as Perl itself. =cut 1; Jifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/0000755000175000017500000000000011325032045021507 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/Action/0000755000175000017500000000000011325032045022724 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/Action/AuthenticateOpenID.pm0000644000175000017500000000474011325025073026747 0ustar agostiniagostiniuse warnings; use strict; =head1 NAME Jifty::Plugin::OpenID::Action::AuthenticateOpenID - make OpenId authentication =cut package Jifty::Plugin::OpenID::Action::AuthenticateOpenID; use base qw/Jifty::Action/; use LWPx::ParanoidAgent; use Net::OpenID::Consumer; use Cache::FileCache; =head2 arguments Return the OpenID URL field =cut use Jifty::Param::Schema; use Jifty::Action schema { param 'openid' => label is _('OpenID URL'), is mandatory, hints is _('For example: you.livejournal.com'); param 'ax_param' => render as 'Hidden'; param 'ax_values' => render as 'Hidden'; param 'ax_mapping' => render as 'Hidden'; param 'return_to' => render as 'Hidden', default is '/openid/verify_and_login'; }; =head2 take_action Creates local user if non-existant and redirects to OpenID auth URL =cut use Jifty::JSON qw /jsonToObj/; sub take_action { my $self = shift; my $openid = $self->argument_value('openid'); my $path = $self->argument_value('return_to'); my $plugin = Jifty->find_plugin('Jifty::Plugin::OpenID'); my $ax_mapping = $self->argument_value('ax_mapping') || $plugin->ax_mapping(); my $ax_param = $self->argument_value('ax_param') || $plugin->ax_param(); my $ax_values = $self->argument_value('ax_values') || $plugin->ax_values(); my $baseurl = Jifty->web->url; my $csr = Jifty::Plugin::OpenID->get_csr( required_root => $baseurl ); my $claimed_id = $csr->claimed_identity( $openid ); if ( not defined $claimed_id ) { $self->result->error(_("Invalid OpenID URL. Please check to make sure it is correct. (%1)",@{[$csr->err]})); return; } $openid = $claimed_id->claimed_url; my $return_to = Jifty->web->url( path => $path ); if(Jifty->web->request->continuation) { $return_to .= ($return_to =~ /\?/) ? '&' : '?'; $return_to .= "J:C=" . Jifty->web->request->continuation->id; } my $check_url = $claimed_id->check_url( return_to => $return_to, trust_root => $baseurl, delayed_return => 1 ); Jifty->web->session->set(ax_mapping => jsonToObj($ax_mapping)); Jifty->web->session->set(ax_values => $ax_values); $ax_param = '&'.$ax_param if $ax_param && $ax_param !~ m/^&/; Jifty->web->_redirect( $check_url . '&openid.sreg.optional=nickname'.$ax_param ); return 1; # should never get here } 1; Jifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/Action/VerifyOpenID.pm0000644000175000017500000000274111325025073025574 0ustar agostiniagostiniuse warnings; use strict; =head1 NAME Jifty::Plugin::OpenID::Action::VerifyOpenID - verify OpenID =cut package Jifty::Plugin::OpenID::Action::VerifyOpenID; use base qw/Jifty::Action/; use Net::OpenID::Consumer; use Cache::FileCache; =head2 arguments No args =cut sub arguments { return ( {} ) } =head2 take_action Check the result of the login. If it's good, load the user and log them in. Otherwise, throw an error. =cut sub take_action { my $self = shift; # XXX HACK: some OpenID servers (LJ and myopenid.com included) don't seem # to properly escape plus signs (+) in openid.sig when returning the user # back to us. We need to convert the pluses back from spaces to pluses again. my $sig = Jifty->handler->cgi->param('openid.sig'); $sig =~ s/ /+/g; Jifty->handler->cgi->param( 'openid.sig' => $sig ); my $csr = Jifty::Plugin::OpenID->get_csr; if ( my $setup = $csr->user_setup_url ) { Jifty->web->_redirect($setup); } elsif ( $csr->user_cancel ) { $self->result->error( _( 'OpenID verification failed. It looks like you cancelled the OpenID verification request.' ) ); return; } my $ident = $csr->verified_identity; if ( not defined $ident ) { $self->result->error( _('OpenID verification failed: ') . $csr->err ); return; } $self->log->debug( "identified as: " . $ident->url ); $self->result->content( openid => $ident->url ); return 1; } 1; Jifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/Action/CreateOpenIDUser.pm0000644000175000017500000000371511325025073026374 0ustar agostiniagostiniuse strict; use warnings; =head1 NAME Jifty::Plugin::OpenID::Action::CreateOpenIDUser - Create OpenID user =cut package Jifty::Plugin::OpenID::Action::CreateOpenIDUser; use base qw/Jifty::Action::Record/; =head2 record_class Returns the record class for this action =cut sub record_class { Jifty->app_class("Model", "User") } =head2 arguments The fields for C are: =over 4 =item name: a nickname =back =cut sub arguments { my $self = shift; my $args = $self->record_class->new->as_create_action->arguments; delete $args->{openid}; return $args; } =head2 take_action =cut sub take_action { my $self = shift; my $openid = Jifty->web->session->get('openid'); if ( not $openid ) { # Should never get here unless someone's trying weird things $self->result->error("Invalid verification result: '$openid'"); return; } my $user = $self->record_class->new(current_user => Jifty->app_class("CurrentUser")->superuser ); $user->load_by_cols( openid => $openid ); if ( $user->id ) { $self->result->error( "That OpenID already has an account. Something's gone wrong." ); return; } $user->create( openid => $openid, %{$self->argument_values} ); if ( not $user->id ) { $self->result->error( "Something bad happened and we couldn't log you in. Please try again later." ); return; } my $current_user = Jifty->app_class("CurrentUser")->new( openid => $openid ); # Actually do the signin thing. Jifty->web->current_user($current_user); Jifty->web->session->expires( undef ); Jifty->web->session->set_cookie; $self->report_success if not $self->result->failure; Jifty->web->session->remove('openid'); return 1; } =head2 report_success =cut sub report_success { my $self = shift; # Your success message here $self->result->message( _("Welcome, ") . Jifty->web->current_user->username . "." ); } 1; Jifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/Mixin/0000755000175000017500000000000011325032045022573 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/Mixin/Model/0000755000175000017500000000000011325032045023633 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/Mixin/Model/User.pm0000644000175000017500000000377611325025073025127 0ustar agostiniagostinipackage Jifty::Plugin::OpenID::Mixin::Model::User; use strict; use warnings; use Jifty::DBI::Schema; use base 'Jifty::DBI::Record::Plugin'; use URI; =head1 NAME Jifty::Plugin::OpenID::Mixin::Model::User - Mixin model user =head1 DESCRIPTION L mixin for the User model. Provides an 'openid' column. =cut use Jifty::Plugin::OpenID::Record schema { our @EXPORT = qw(has_alternative_auth link_to_openid); column openid => type is 'text', label is 'OpenID', hints is q{You can use your OpenID to log in quickly and easily.}, is distinct, is immutable; }; =head2 has_alternative_auth =cut sub has_alternative_auth { 1 } =head2 register_triggers =cut sub register_triggers { my $self = shift; $self->add_trigger(name => 'validate_openid', callback => \&validate_openid, abortable => 1); $self->add_trigger(name => 'canonicalize_openid', callback => \&canonicalize_openid); } =head2 validate_openid =cut sub validate_openid { my $self = shift; my $openid = shift; my $uri = URI->new( $openid ); return ( 0, q{That doesn't look like an OpenID URL.} ) if not defined $uri; my $temp_user = Jifty->app_class("Model", "User")->new; $temp_user->load_by_cols( openid => $uri->canonical ); # It's ok if *we* have the openid we're looking for return ( 0, q{It looks like somebody else has claimed that OpenID.} ) if $temp_user->id and ( not $self->id or $temp_user->id != $self->id ); return 1; } =head2 canonicalize_openid =cut sub canonicalize_openid { my $self = shift; my $openid = shift; return '' if not defined $openid or not length $openid; $openid = 'http://' . $openid if $openid !~ m{^https?://}; my $uri = URI->new( $openid ); return $uri->canonical; } =head2 link_to_openid Links User's account to the specified OpenID (bypassing ACLs) =cut sub link_to_openid { my $self = shift; my $openid = shift; $self->__set( column => 'openid', value => $openid ); } 1; Jifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/Dispatcher.pm0000644000175000017500000001071011325025073024135 0ustar agostiniagostiniuse strict; use warnings; package Jifty::Plugin::OpenID::Dispatcher; use Jifty::Dispatcher -base; =head1 NAME Jifty::Plugin::OpenID::Dispatcher - Dispatcher for OpenID plugin =head1 DESCRIPTION Dispatcher for L. Handles a lot of the work. =cut before qr'^/(?:openid/link)' => run { tangent('/openid/login') unless (Jifty->web->current_user->id) }; before qr'^/openid/login' => run { Jifty->api->allow('AuthenticateOpenID'); set action => Jifty->web->new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); }; before qr'^/openid/verify' => run { Jifty->api->allow('VerifyOpenID'); Jifty->web->request->add_action( class => 'VerifyOpenID', moniker => 'verifyopenid' ); }; on 'openid/verify_and_link' => run { my $result = Jifty->web->response->result('verifyopenid'); my $user = Jifty->web->current_user; if ( defined $result and $result->success and $user->id ) { my $openid = $result->content('openid'); my ( $ret, $msg ) = $user->user_object->validate_openid( $openid ); if ( not $ret ) { $result->error(_("It looks like someone is already using that OpenID.")); redirect '/openid/link'; } else { $user->user_object->link_to_openid( $openid ); $result->message(_("The OpenID '%1' has been linked to your account.",$openid)); } } redirect '/'; }; on 'openid/verify_and_login' => run { my $result = Jifty->web->response->result('verifyopenid'); if ( defined $result and $result->success ) { my $openid = $result->content('openid'); my $user = Jifty->app_class('CurrentUser')->new( openid => $openid ); Jifty->log->info("User Class: $user. OpenID: $openid"); if ( $user->id ) { # Set up our login message $result->message( _("Welcome back, ") . $user->username . "." ); # Actually do the signin thing. Jifty->web->current_user($user); Jifty->web->session->expires( undef ); Jifty->web->session->set_cookie; if(Jifty->web->request->continuation) { Jifty->web->request->continuation->call; } else { redirect '/'; } } else { # User needs to create account still Jifty->web->session->set( openid => $openid ); Jifty->log->info("got openid: $openid"); my $Mapping = Jifty->web->session->get('ax_mapping'); if ($Mapping) { # get ns, google set is own ns, usually ext1 # this need to be provided by csr my $signed = get('openid.signed'); my $ns = $1 if $signed =~ m/ns\.(\w+?),/; # get values my $AX=(); foreach my $param ( split ',', Jifty->web->session->get('ax_values') ) { $AX->{$param} = get('openid.'.$ns.'.'.$param); }; # map values foreach my $param (keys %$Mapping ) { my $val = $Mapping->{$param}; $val =~ s/(value\.\w+(\.\d)?)/$AX->{$1}/g; $Mapping->{$param} = $val; }; $Mapping->{openid} = $openid; }; my $nick = get('openid.sreg.nickname'); if ( $nick ) { redirect( Jifty::Web::Form::Clickable->new( url => '/openid/create', parameters => { nickname => $nick, openid => $openid } )); } elsif ($Mapping) { redirect( Jifty::Web::Form::Clickable->new( url => '/openid/create', parameters => $Mapping ) ); } else { redirect( Jifty::Web::Form::Clickable->new( url => '/openid/create' ) ); } } } else { if(Jifty->web->request->continuation) { Jifty->web->request->continuation->call; } else { redirect '/openid/login'; } } }; on 'openid/create' => run { if ( not Jifty->web->session->get('openid') ) { redirect '/'; } set action => Jifty->web->new_action( class => 'CreateOpenIDUser', parameters => { openid => Jifty->web->session->get("openid") } ); set 'next' => Jifty->web->request->continuation || Jifty::Continuation->new( request => Jifty::Request->new( path => "/" ) ); }; 1; Jifty-Plugin-OpenID-1.02/lib/Jifty/Plugin/OpenID/View.pm0000644000175000017500000001455011325025073022767 0ustar agostiniagostinipackage Jifty::Plugin::OpenID::View; use strict; use warnings; use Jifty::View::Declare -base; =head1 NAME Jifty::Plugin::OpenID::View - Login and create pages for OpenID plugin =head1 DESCRIPTION The view class for L. Provides login and create pages. =cut template 'openid/login' => page { { title is _("Login with your OpenID") } my ($action, $next) = get('action', 'next'); div { unless ( Jifty->web->current_user->id ) { div { attr { id => 'openid-login' }; outs( p { em { _( qq{If you have a Livejournal or other OpenID account, you don\'t even need to sign up. Just log in.} ); } } ); Jifty->web->form->start( call => $next ); render_action($action); form_submit( label => _("Go for it!"), submit => $action ); Jifty->web->form->end; }; } else { outs( _("You already logged in.") ); } } }; template 'openid/create' => page { title is _('Set your username'); my ( $action, $next ) = get( 'action', 'next' ); p { outs( _( 'We need you to set a username or quickly check the one associated with your OpenID. Your username is what other people will see when you ask questions or make suggestions' ) ); }; p { outs( _( 'If the username provided conflicts with an existing username or contains invalid characters, you will have to give us a new one.' ) ); }; Jifty->web->form->start( call => $next , name => 'openid-user-create' ); my $openidSP = Jifty->web->session->get('ax_mapping'); if ($openidSP) { foreach my $param (keys %$openidSP) { # keep get to use validation render_param($action, $param, default_value => get($param) ); div { class is "form_field"; span { class is "hints"; outs( _( 'A link to confirm this email will be sent to receive later notifications.' ) ); } } if ($param eq 'email'); } } else { render_action($action); }; form_submit( label => _('Continue'), submit => $action ); Jifty->web->form->end; }; # optionnal fragment to add direct links to Google, Yahoo, # MyOpenID login template 'openid/wayf' => sub { my ( $self, $return_to ) = @_; div { attr { class => ''; }; form { my $google = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); render_param($google, 'openid', render_as => 'hidden', default_value => 'www.google.com/accounts/o8/id'); render_param($google, 'ax_param', render_as => 'hidden', default_value => "openid.ns.ax=http://openid.net/srv/ax/1.0&openid.ax.mode=fetch_request&openid.ax.type.email=http://axschema.org/contact/email&openid.ax.type.firstname=http://axschema.org/namePerson/first&openid.ax.type.lastname=http://axschema.org/namePerson/last&openid.ax.required=firstname,lastname,email"); render_param($google, 'ax_mapping', render_as => 'hidden', default_value => "{ 'email': 'value.email', 'name': 'value.firstname value.lastname' }"); render_param($google, 'ax_values', render_as => 'hidden', default_value => "value.email,value.firstname,value.lastname" ); render_param($google,'return_to', render_as => 'hidden', default_value => '/openid/verify_and_login'); img { src is '/static/oidimg/FriendConnect.gif'; }; outs_raw( Jifty->web->return( as_link => 1, to => $return_to, label => _("Sign in with your Google Account"), submit => $google )); }; form { my $yahoo = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); render_param($yahoo, 'openid', render_as => 'hidden', default_value => 'me.yahoo.com'); render_param($yahoo, 'ax_param', render_as => 'hidden', default_value => "openid.ns.ax=http://openid.net/srv/ax/1.0&openid.ax.mode=fetch_request&openid.ax.type.email=http://axschema.org/contact/email&openid.ax.type.fullname=http://axschema.org/namePerson&openid.ax.required=fullname,email"); render_param($yahoo, 'ax_mapping', render_as => 'hidden', default_value => "{ 'email': 'value.email', 'name': 'value.fullname' }"); render_param($yahoo, 'ax_values', render_as => 'hidden', default_value => "value.email,value.fullname" ); render_param($yahoo,'return_to', render_as => 'hidden', default_value => '/openid/verify_and_login'); img { src is '/static/oidimg/yfavicon.gif'; }; outs_raw( Jifty->web->return( as_link => 1, to => $return_to, label => _("Sign in with your Yahoo account"), submit => $yahoo )); }; form { my $myoid = new_action( class => 'AuthenticateOpenID', moniker => 'authenticateopenid' ); render_param($myoid, 'openid', render_as => 'hidden', default_value => 'www.myopenid.com'); render_param($myoid, 'ax_param', render_as => 'hidden', default_value => "openid.ns.ax=http://openid.net/srv/ax/1.0&openid.ax.mode=fetch_request&openid.ax.type.email=http://schema.openid.net/contact/email&openid.ax.type.nickname=http://schema.openid.net/namePerson/friendly&openid.ax.required=nickname,email"); render_param($myoid, 'ax_mapping', render_as => 'hidden', default_value => "{ 'email': 'value.email.1', 'name': 'value.nickname.1' }"); render_param($myoid, 'ax_values', render_as => 'hidden', default_value => "value.email.1,value.nickname.1" ); render_param($myoid,'return_to', render_as => 'hidden', default_value => '/openid/verify_and_login'); img { src is '/static/oidimg/myopenid.png'; }; outs_raw( Jifty->web->return( as_link => 1, to => $return_to, label => _("Sign in with your MyOpenID Account"), submit => $myoid )); }; }; }; 1; Jifty-Plugin-OpenID-1.02/Changes0000644000175000017500000000112311325025073016573 0ustar agostiniagostiniRevision history for Perl module Jifty::Plugin::OpenID 1.02 Mon, 18 Jan 2010 10:07:19 +0100 - missing install_share in Makefile.PL - make TestApp tests - fix pod spelling, thx to Jonathan Yu from debian packaging group 1.01 Mon, 11 Jan 2010 10:59:19 +0100 - add Attribute Exchange management - bump Net::OpenID::Consumer dep 1.00 Wed, 10 Jun 2009 11:55:15 +0200 - bump version number to avoid conflict with debian - add minimal load test - temporary suspend tests with Test::OpenID::Server 0.10 Tue, 09 Jun 2009 22:28:10 +0200 - original version for CPAN Jifty-Plugin-OpenID-1.02/inc/0000755000175000017500000000000011325032045016051 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/inc/Module/0000755000175000017500000000000011325032045017276 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/inc/Module/Install.pm0000644000175000017500000002411411325032027021244 0ustar agostiniagostini#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.91'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); use Cwd (); use File::Find (); use File::Path (); use FindBin; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; # Save to the singleton $MAIN = $self; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; 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} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; if ( $] >= 5.006 ) { open( FH, '<', $_[0] ) or die "open($_[0]): $!"; } else { open( FH, "< $_[0]" ) or die "open($_[0]): $!"; } my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } sub _write { local *FH; if ( $] >= 5.006 ) { open( FH, '>', $_[0] ) or die "open($_[0]): $!"; } else { open( FH, "> $_[0]" ) or die "open($_[0]): $!"; } foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[0]) <=> _version($_[1]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2009 Adam Kennedy. Jifty-Plugin-OpenID-1.02/inc/Module/Install/0000755000175000017500000000000011325032045020704 5ustar agostiniagostiniJifty-Plugin-OpenID-1.02/inc/Module/Install/Base.pm0000644000175000017500000000176611325032027022126 0ustar agostiniagostini#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '0.91'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 154 Jifty-Plugin-OpenID-1.02/inc/Module/Install/Metadata.pm0000644000175000017500000003530411325032027022767 0ustar agostiniagostini#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract author version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords }; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}->{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the reall old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless $self->author; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub perl_version_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub license_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } sub _extract_bugtracker { my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than on rt.cpan.org link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Jifty-Plugin-OpenID-1.02/inc/Module/Install/Can.pm0000644000175000017500000000333311325032033021742 0ustar agostiniagostini#line 1 package Module::Install::Can; use strict; use Config (); use File::Spec (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible 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}), '.') { next if $dir eq ''; my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 156 Jifty-Plugin-OpenID-1.02/inc/Module/Install/Share.pm0000644000175000017500000000315511325032027022310 0ustar agostiniagostini#line 1 package Module::Install::Share; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub install_share { my $self = shift; my $dir = @_ ? pop : 'share'; my $type = @_ ? shift : 'dist'; unless ( defined $type and $type eq 'module' or $type eq 'dist' ) { die "Illegal or invalid share dir type '$type'"; } unless ( defined $dir and -d $dir ) { die "Illegal or missing directory install_share param"; } # Split by type my $S = ($^O eq 'MSWin32') ? "\\" : "\/"; if ( $type eq 'dist' ) { die "Too many parameters to install_share" if @_; # Set up the install $self->postamble(<<"END_MAKEFILE"); config :: \t\$(NOECHO) \$(MOD_INSTALL) \\ \t\t"$dir" \$(INST_LIB)${S}auto${S}share${S}dist${S}\$(DISTNAME) END_MAKEFILE } else { my $module = Module::Install::_CLASS($_[0]); unless ( defined $module ) { die "Missing or invalid module name '$_[0]'"; } $module =~ s/::/-/g; # Set up the install $self->postamble(<<"END_MAKEFILE"); config :: \t\$(NOECHO) \$(MOD_INSTALL) \\ \t\t"$dir" \$(INST_LIB)${S}auto${S}share${S}module${S}$module END_MAKEFILE } # The above appears to behave incorrectly when used with old versions # of ExtUtils::Install (known-bad on RHEL 3, with 5.8.0) # So when we need to install a share directory, make sure we add a # dependency on a moderately new version of ExtUtils::MakeMaker. $self->build_requires( 'ExtUtils::MakeMaker' => '6.11' ); # 99% of the time we don't want to index a shared dir $self->no_index( directory => $dir ); } 1; __END__ #line 125 Jifty-Plugin-OpenID-1.02/inc/Module/Install/Fetch.pm0000644000175000017500000000462711325032033022301 0ustar agostiniagostini#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } 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; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Jifty-Plugin-OpenID-1.02/inc/Module/Install/Makefile.pm0000644000175000017500000001600311325032027022757 0ustar agostiniagostini#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ( $self->{makemaker_args} ||= {} ); %$args = ( %$args, @_ ); return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # MakeMaker can complain about module versions that include # an underscore, even though its own version may contain one! # Hence the funny regexp to get rid of it. See RT #35800 # for details. $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $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 { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm 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)) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 394 Jifty-Plugin-OpenID-1.02/inc/Module/Install/Win32.pm0000644000175000017500000000340311325032033022141 0ustar agostiniagostini#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Jifty-Plugin-OpenID-1.02/inc/Module/Install/WriteAll.pm0000644000175000017500000000222211325032033022760 0ustar agostiniagostini#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91';; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Jifty-Plugin-OpenID-1.02/inc/Module/Install/AutoInstall.pm0000644000175000017500000000227311325032027023505 0ustar agostiniagostini#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; Jifty-Plugin-OpenID-1.02/inc/Module/Install/Include.pm0000644000175000017500000000101511325032027022622 0ustar agostiniagostini#line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; Jifty-Plugin-OpenID-1.02/inc/Module/AutoInstall.pm0000644000175000017500000005330611325032027022102 0ustar agostiniagostini#line 1 package Module::AutoInstall; use strict; use Cwd (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.03'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps ); my ( $PostambleActions, $PostambleUsed ); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } elsif ( $arg =~ /^--all(?:deps)?$/ ) { $AllDeps = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); # We want to know if we're under CPAN early to avoid prompting, but # if we aren't going to try and install anything anyway then skip the # check entirely since we don't want to have to load (and configure) # an old CPAN just for a cosmetic message $UnderCPAN = _check_lock(1) unless $SkipInstall; while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. my $cur = _load($mod); if (_version_cmp ($cur, $arg) >= 0) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { if (not defined $cur) # indeed missing { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; } else { # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above print "too old. ($cur < $arg)\n"; } push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or ($mandatory and $UnderCPAN) or $AllDeps or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) { require Config; print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; } sub _running_under { my $thing = shift; print <<"END_MESSAGE"; *** Since we're running under ${thing}, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing or @_; my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING}; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS'); } require CPAN; if ($CPAN::VERSION > '1.89') { if ($cpan_env) { return _running_under('CPAN'); } return; # CPAN.pm new enough, don't need to check further } # last ditch attempt, this -will- configure CPAN, very sorry _load_cpan(1); # force initialize even though it's already loaded # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( _version_cmp( _load($pkg), $ver ) >= 0 ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( _version_cmp( _load($pkg), $ver ) >= 0 ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^force$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $args{force} ? CPAN::Shell->force( install => $pkg ) : CPAN::Shell->install($pkg); $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # class/instance doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION and $CPAN::Config and not @_; require CPAN; if ( $CPAN::HandleConfig::VERSION ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison # return values same as <=> sub _version_cmp { my ( $cur, $min ) = @_; return -1 unless defined $cur; # if 0 keep comparing return 1 unless $min; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return version->new($cur) <=> version->new($min); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return Sort::Versions::versioncmp( $cur, $min ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return $cur <=> $min; } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; return <<"END_MAKE"; config :: installdeps \t\$(NOECHO) \$(NOOP) checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions END_MAKE } 1; __END__ #line 1056 Jifty-Plugin-OpenID-1.02/MANIFEST0000644000175000017500000000221011325025541016427 0ustar agostiniagostiniChanges doc/OpenID_zhtw.pod inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Share.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Jifty/Plugin/OpenID.pm lib/Jifty/Plugin/OpenID/Action/AuthenticateOpenID.pm lib/Jifty/Plugin/OpenID/Action/CreateOpenIDUser.pm lib/Jifty/Plugin/OpenID/Action/VerifyOpenID.pm lib/Jifty/Plugin/OpenID/Dispatcher.pm lib/Jifty/Plugin/OpenID/Mixin/Model/User.pm lib/Jifty/Plugin/OpenID/View.pm Makefile.PL MANIFEST This list of files META.yml README share/po/fr.po share/po/openid.pot share/web/static/css/openidplugin.css share/web/static/oidimg/FriendConnect.gif share/web/static/oidimg/myopenid.png share/web/static/oidimg/openid-icon-small.gif share/web/static/oidimg/yfavicon.gif t/00-load.t t/TestApp/bin/jifty t/TestApp/etc/config.yml t/TestApp/lib/TestApp/Model/User.pm t/TestApp/lib/TestApp/View.pm t/TestApp/t/00-model-User.t t/TestApp/t/00-openid-test.t t/TestApp/t/01-ax-test.t