/usr/share/perl5/Net/Google/Code/Role/Authentication.pm is in libnet-google-code-perl 0.19-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | package Net::Google::Code::Role::Authentication;
use Any::Moose 'Role';
with 'Net::Google::Code::Role::Fetchable';
has 'email' => (
isa => 'Str',
is => 'rw',
);
has 'password' => (
isa => 'Str',
is => 'rw',
);
sub sign_in {
my $self = shift;
return 1 if $self->signed_in;
die "need password" unless $self->password;
$self->mech->get('https://www.google.com/accounts/Login');
$self->mech->submit_form(
with_fields => {
Email => $self->email,
Passwd => $self->password,
},
);
die 'sign in failed to google code'
unless $self->signed_in;
return 1;
}
sub sign_out {
my $self = shift;
$self->mech->get('https://www.google.com/accounts/Logout');
die 'sign out failed to google code'
unless $self->signed_in;
return 1;
}
sub signed_in {
my $self = shift;
my $html = $self->mech->content;
return unless $html;
# remove lines of head, style and script
$html =~ s!<head>.*?</head>!!sg;
$html =~ s!<style.*?</style>!!sg;
$html =~ s!<script.*?</script>!!sg;
my @lines = split /\n/, $html;
my $signed_in;
my $line = 0;
# only check the first 30 lines or so in case user input of 'sign out'
# exists below
for ( @lines ) {
$signed_in = 1 if /sign out/i;
$line++;
last if $line == 30;
}
return $signed_in;
}
no Any::Moose;
1;
__END__
=head1 NAME
Net::Google::Code::Role::Authentication - Authentication Role
=head1 DESCRIPTION
=head1 INTERFACE
=head2 sign_in
sign in
=head2 sign_out
sign out
=head2 signed_in
return 1 if already signed in, return undef elsewise.
=head1 AUTHOR
sunnavy C<< <sunnavy@bestpractical.com> >>
=head1 LICENCE AND COPYRIGHT
Copyright 2008-2010 Best Practical Solutions.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
|