view release on metacpan or  search on metacpan

lib/Catalyst/Helper/AuthDBIC.pm  view on Meta::CPAN

    my $found = PPI::Find->new(\&_find_setup);
    my ($setup) = $found->in($doc);
    croak "unable to find __PACKAGE__->setup in $module\n" if !$setup;
    my $auth_doc_plain;

    if ( $credential eq 'http' ) {
        warn "Configuring http credential\n";
        $auth_doc_plain = Catalyst::Helper->get_file(__PACKAGE__, 'auth_conf_http');
    }
    elsif ( $credential eq 'password' ) {
        warn "Configuring password (web based) authentication credential\n";
        $auth_doc_plain = Catalyst::Helper->get_file(__PACKAGE__, 'auth_conf_passwd');
    }

    $auth_doc_plain =~ s/__MYSCHEMA__/Auth/msg;
    my $auth_doc = PPI::Document->new(\$auth_doc_plain);
    my $auth_conf = $auth_doc->find_first('PPI::Statement');
    # the code produced here is a little ugly and lacks a \n between
    # the config and the __PACKAGE__->setup declaration. The usage of
    # PPI to modify source is also inconsistent here to elewhere.
    $setup->insert_before($auth_conf);
    $doc->save($module);
}

sub _find_setup {
    my ($element, $search) = @_;
    if ( $element->isa('PPI::Statement')
         && $element =~ /setup.*?;/
     ) {
        return 1;
    }
    return 0;
}

sub _get_ppi {
    my $app_name = app_name() || 'TestApp';
    my @path = split /::/, $app_name;
    my $app_path = join '/', @path;
    my $module = "lib/$app_path.pm";
    my $doc = PPI::Document->new($module);
    return ($module, $doc);
}

=head2 sub write_templates()

make the login, logout and unauth templates

=cut

sub write_templates {
    my $helper = Catalyst::Helper->new();
    my $login = $helper->get_file(__PACKAGE__, 'login.tt');
    my $logout = $helper->get_file(__PACKAGE__, 'logout.tt');
    my $unauth = $helper->get_file(__PACKAGE__, 'unauth.tt');
    $helper->mk_dir("root/auth");
    $helper->mk_file("root/auth/login.tt", $login);
    $helper->mk_file("root/auth/logout.tt", $logout);
    $helper->mk_file("root/auth/unauth.tt", $unauth);
}

=head2 sub update_makefile()

Adds the auth and session dependencies to Makefile.PL

=cut

sub update_makefile {
    my $deps = Catalyst::Helper->get_file(__PACKAGE__, 'requires');
    my $doc = PPI::Document->new('Makefile.PL');
    my $find = PPI::Find->new( \&_find_install_script );
    my ($found) = $find->in($doc);
    croak "There's something wrong with your Makefile.PL so we can't continue (can't find  the install_script directive\n" if ! $found;
    my $install_script = $found->find_first('PPI::Token::Word');
    my $install_script_str = scalar($install_script);
    $install_script->set_content($deps . "\n" . $install_script_str);
    $doc->save('Makefile.PL')
}

sub _find_install_script {
    my ($element, $search) = @_;
    if ($element->isa('PPI::Statement')
            && $element =~ 'install_script') {
        return 1;
    }
    return 0;
}

=head2 sub add_user_helper()

A little script to add a user to the database.

=cut

sub add_user_helper {
    my $helper = Catalyst::Helper->new;
    my $app_prefix = Catalyst::Utils::appprefix(app_name());
    my $script_dir = File::Spec->catdir( '.', 'script' );
    my $script = "$script_dir\/$app_prefix\_auth_admin.pl";
    my $startperl = "#!$Config{perlpath} -w";
    $DB::single=1;
    $helper->render_file('auth_admin',
                         $script,
                         { start_perl => $startperl,
                           appprefix  => $app_prefix,
                           startperl => $startperl,
                           app_name => app_name(),
                       });
    chmod 0700, $script;
}

=head2 BUGS

This is experimental, fairly rough code.  It's a proof of concept for
helper modules for Catalyst that need to alter the application
configuration, Makefile.PL and other parts of the application.  Bug
reports, and patches are encouraged.  Report bugs or provide patches
to http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Helper-AuthDBIC.

=head2 AUTHOR

Kieren Diment <zarquon@cpan.org>


=head1 COPYRIGHT AND LICENCE

Copyright (c) 2008 Kieren Diment