my $bc = Authen::Bitcard->new;
   $bc->token($assigned_bitcard_token);
   $bc->info_optional([qw(name username email)]);
   $bc->expires( 86400*30 );
   $bc->key_cache($bitcard_pubkey_cache);

##</code><code>##

   print $cgi->p("Hi there...");
   print $cgi->p("Please ", $cgi->a({ href=>$bc->login_url({r=>$cgi->url}) }, "login") . ".");

##</code><code>##

$ses->expire("+1y");  # most of the session lasts forever

my $dood = $ses->param("dood");
my $user = $ses->param("user");

if( not $user and (my $bcd = $ses->param("bc_data")) ) {
    $user = $bc->verify( $bcd );  # we only verify the bc_data every hour or so
}

if( not $user and (my $f = $cgi->param("bc_fields")) and ($user = $bc->verify($cgi)) ) {
    # This line is stolen from Authen::Bitcard directly (minus a few bytes)...
    # Why don't they export this?
    my %data = map { $_ => $cgi->param($_) } split(/,/, $f), 'bc_sig';

    $ses->param( bc_data => \%data ); # so we can verify above

    $dood = $user->{username} || $user->{name} || $user->{email}
         || "Incognito #" . $user->{id};

    $ses->param( dood => $dood );
    $ses->flush;

    print $cgi->redirect($cgi->url);
    exit 0;
}

if( $cgi->param("lo") or ($user and not $dood) ) {
    $ses->clear([qw(user bc_data)]);

    print $cgi->redirect($cgi->url);
    exit 0;
}

if( $user and not $ses->param("user") ) {
    $ses->param( user => $user );
    $ses->expire( user => "+1h" ); # this means every hour we'll verify(bc_data)
}


##</code><code>##

use Net::OpenID::Consumer;
use Digest::SHA1 qw(sha1);
use LWPx::ParanoidAgent;
use Cache::File;
use DBM::Deep;
use URI; # for port parsing
use Time::HiRes qw(time);

##</code><code>##

my $nonce_pattern = q(%s%d%d%s my secret code words here) . $0;
my $nonce = $ses->param("nonce") 
       || sha1(sprintf($nonce_pattern, time, (stat $0)[9], -s _, $claim));

##</code><code>##

my $ua = LWPx::ParanoidAgent->new;

$ua->timeout(5);
$ua->blocked_hosts(sub {
    my $host = shift;

    return 1 if $host =~ $my_local_networks; # some precompiled regular...
    return 0 if $host =~ m/^[\w\d\-_]+\.myopenid\.com\//;
    return 0 if $host =~ m/^[\w\d_.-]+\.(?:com|net|org)(?:\/\??[\w\d_&=;%-]+)?\z/;
    return 0 if $host =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\z/ and 
        not $host =~m/^(?:10\.|192\.168|172\.16|127\.)/;

    return 1;
});

##</code><code>##

my $csr = Net::OpenID::Consumer->new( 
    consumer_secret => $nonce,
    args            => $cgi,
    ua              => $ua,
    required_root   => $this_domain,
    cache           => Cache::File->new(cache_root=>"$session_directory/csr.cache/"));

##</code><code>##

if ( $claim and not $cgi->param("checked") ) {
    if( my $ci = $csr->claimed_identity($claim) ) {
        my $check_url = $ci->check_url(
            return_to  => $this_domain . "myscript.pl?claim=$claim;checked=1",
            trust_root => $this_domain,
        );

        $ses->param( nonce => $nonce ); # keep this for when they come back
        print $cgi->redirect( $check_url );
        exit 0;
    }

}

##</code><code>##

elsif( my $setup_url = $csr->user_setup_url ) {
    # We only get here if we're not already logged into myopenid...

    print $cgi->redirect( $setup_url
        . '&openid.sreg.optional='
        . 'email,nickname,fullname,dob,gender,postcode,country,language,timezone'
    );
    exit 0;

}

##</code><code>##

elsif( (my $vfid = $csr->verified_identity) or (my $user = $ses->param("user")) ) {
    my $dbm = DBM::Deep->new(file=>$dbm_file, locking => 1, autoflush => 1);

    if( $vfid ) {
        my $url = $vfid->url;

        my $max = 20;
        for my $p ( grep {m/^openid\.sreg\./} $cgi->param ) {
            if( $p =~ m/\.([^.]+)\z/ ) {
                my $k = $1;
                my $v = substr $cgi->param($p), 0, 1024;

                warn "adding $k=$v to $url";
                $dbm->{$url}{$k} = $v;
            }

            last if (--$max)<1;
        }

        $user = {
            url  => $url,
            disp => $dbm->{$url}->{nickname} || $dbm->{$url}->{fullname} || $vfid->display,
            time => time,
        };

        $ses->param(user=>$user);
        $ses->flush;

    } elsif( $cgi->param("lo") ) {
        $ses->clear([qw(user nonce)]); # kill the nonce so they get a new one next time
        $ses->flush;

        print $cgi->redirect( $cgi->url );
        exit 0;
    }

    my $url = $user->{url};

    print $ses->header;
    print $cgi->start_html({title=>"openid test"});

    print $cgi->h3("Hi there $user->{disp}!");
    print $cgi->p("We've come a long way I think, no?", $cgi->a({href=>"?lo=1"}, "logout"));

    print $cgi->p("reg params:", 
        $cgi->ul( map {$cgi->li("$_: " . $dbm->{$url}{$_}) } keys %{ $dbm->{$url} } )) 
            if %{ $dbm->{$url} }

    exit 0;
}