package HTTP::Session::State::MobileAttributeID; use strict; use warnings; use HTTP::Session::State::Base; use HTTP::MobileAttribute plugins => [ 'UserID', 'CIDR', ]; use 5.00800; our $VERSION = '0.41'; __PACKAGE__->mk_ro_accessors(qw/mobile_attribute check_ip/); sub new { my $class = shift; my %args = ref($_[0]) ? %{$_[0]} : @_; # check required parameters for (qw/mobile_attribute/) { Carp::croak "missing parameter $_" unless $args{$_}; } # set default values $args{check_ip} = exists($args{check_ip}) ? $args{check_ip} : 1; $args{permissive} = exists($args{permissive}) ? $args{permissive} : 1; bless {%args}, $class; } sub get_session_id { my ($self, $req) = @_; my $ma = $self->mobile_attribute; if ($ma->can('user_id')) { if (my $user_id = $ma->user_id) { if ($self->check_ip) { my $ip = $ENV{REMOTE_ADDR} || (Scalar::Util::blessed($req) ? $req->address : $req->{REMOTE_ADDR}) || die "cannot get address"; if (!$ma->isa_cidr($ip)) { die "SECURITY: invalid ip($ip, $ma, $user_id)"; } } return $user_id; } else { die "cannot detect mobile id from $ma"; } } else { die "this carrier doesn't supports user_id: $ma"; } } sub response_filter { } 1; __END__ =encoding utf8 =head1 NAME HTTP::Session::State::MobileAttributeID - (DEPRECATED) =head1 SYNOPSIS use HTTP::Session::State::MobileAttribute; use HTTP::Session; HTTP::Session->new( state => HTTP::Session::State::MobileAttributeID->new( mobile_attribute => HTTP::MobileAttribute->new($r), ), store => ..., request => ..., ); =head1 DESCRIPTION Maintain session IDs using mobile phone's unique id B< THIS MODULE WAS DEPRECATED. DO NOT USE THIS MODULE. I WILL REMOVE THIS MODULE FROM CPAN AFTER 2011-12-31>. B. =head1 CONFIGURATION =over 4 =item mobile_attribute instance of L =item check_ip check the IP address in the carrier's cidr/ or not? see also L =back =head1 METHODS =over 4 =item get_session_id =item response_filter for internal use only =back =head1 AUTHOR Tokuhiro Matsuno Etokuhirom AAJKLFJEF GMAIL COME =head1 SEE ALSO L, L, L =head1 LICENSE Copyright (C) Tokuhiro Matsuno This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut