| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package App::starbucksloginator; |
|
2
|
|
|
|
|
|
|
{ |
|
3
|
|
|
|
|
|
|
$App::starbucksloginator::VERSION = '0.0012'; |
|
4
|
|
|
|
|
|
|
} |
|
5
|
|
|
|
|
|
|
# ABSTRACT: Access the wireless at Starbucks (via AT&T) |
|
6
|
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
109905
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
27
|
|
|
8
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
22
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
1111
|
use Getopt::Long qw/ GetOptions /; |
|
|
1
|
|
|
|
|
11178
|
|
|
|
1
|
|
|
|
|
5
|
|
|
12
|
1
|
|
|
1
|
|
951
|
use Getopt::Usaginator <<_END_; |
|
|
1
|
|
|
|
|
36613
|
|
|
|
1
|
|
|
|
|
8
|
|
|
13
|
|
|
|
|
|
|
Usage: starbucksloginator |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
--agent The agent to pass the loginator off as (user agent string). |
|
16
|
|
|
|
|
|
|
Windows Firefox by default |
|
17
|
|
|
|
|
|
|
_END_ |
|
18
|
|
|
|
|
|
|
|
|
19
|
1
|
|
|
1
|
|
1331
|
use WWW::Mechanize; |
|
|
1
|
|
|
|
|
166738
|
|
|
|
1
|
|
|
|
|
498
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $__agent__ = WWW::Mechanize->new; |
|
22
|
|
|
|
|
|
|
$__agent__->agent( "Mozilla/5.0 (Windows; U; Windows NT 6.0; en-GB; rv:1.9.0.6) Gecko/2009011913 Firefox/3.0.6" ); |
|
23
|
0
|
|
|
0
|
0
|
|
sub agent { $__agent__ } |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub try { |
|
26
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
27
|
0
|
|
|
|
|
|
my $site = shift; |
|
28
|
0
|
|
|
|
|
|
my $response = agent->get( "http://$site" ); |
|
29
|
0
|
|
|
|
|
|
my $success = $response->decoded_content !~ m/[^<]*Starbucks.*?</i; </td>
</tr>
<tr>
<td class="h" >
<a name="30">30</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> return ( $success, $response ); </td>
</tr>
<tr>
<td class="h" >
<a name="31">31</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="32">32</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="33">33</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> sub try_to_get_out { </td>
</tr>
<tr>
<td class="h" >
<a name="34">34</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--subroutine.html#34-1">
0
</a>
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--subroutine.html#34-1">
0
</a>
</td>
<td >
</td>
<td class="s"> my $self = shift; </td>
</tr>
<tr>
<td class="h" >
<a name="35">35</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> my ( $success, $response ); </td>
</tr>
<tr>
<td class="h" >
<a name="36">36</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> for my $site ( qw/ google.com example.com bing.com yahoo.com / ) { </td>
</tr>
<tr>
<td class="h" >
<a name="37">37</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> ( $success, $response ) = $self->try( $site ); </td>
</tr>
<tr>
<td class="h" >
<a name="38">38</a>
</td>
<td class="c0" >
0
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--branch.html#38-1">
0
</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> return ( $success, $response ) unless $success; </td>
</tr>
<tr>
<td class="h" >
<a name="39">39</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="40">40</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> return ( $success, $response ); </td>
</tr>
<tr>
<td class="h" >
<a name="41">41</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="42">42</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="43">43</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> sub say { </td>
</tr>
<tr>
<td class="h" >
<a name="44">44</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--subroutine.html#44-1">
0
</a>
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--subroutine.html#44-1">
0
</a>
</td>
<td >
</td>
<td class="s"> print "> ", @_, "\n"; </td>
</tr>
<tr>
<td class="h" >
<a name="45">45</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="46">46</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="47">47</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> sub run { </td>
</tr>
<tr>
<td class="h" >
<a name="48">48</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--subroutine.html#48-1">
0
</a>
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--subroutine.html#48-1">
0
</a>
</td>
<td >
</td>
<td class="s"> my $self = shift; </td>
</tr>
<tr>
<td class="h" >
<a name="49">49</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> my @arguments = @_; </td>
</tr>
<tr>
<td class="h" >
<a name="50">50</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="51">51</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> my ( $help, $agent ); </td>
</tr>
<tr>
<td class="h" >
<a name="52">52</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> { </td>
</tr>
<tr>
<td class="h" >
<a name="53">53</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> local @ARGV = @arguments; </td>
</tr>
<tr>
<td class="h" >
<a > </a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="54">54</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> GetOptions( </td>
</tr>
<tr>
<td class="h" >
<a name="55">55</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> 'agent=s' => \$agent, </td>
</tr>
<tr>
<td class="h" >
<a name="56">56</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> 'help|h|?' => \$help, </td>
</tr>
<tr>
<td class="h" >
<a name="57">57</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> ); </td>
</tr>
<tr>
<td class="h" >
<a name="58">58</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="59">59</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="60">60</a>
</td>
<td class="c0" >
0
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--branch.html#60-1">
0
</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> usage 0 if $help; </td>
</tr>
<tr>
<td class="h" >
<a name="61">61</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="62">62</a>
</td>
<td class="c0" >
0
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--branch.html#62-1">
0
</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> agent->agent( $agent ) if defined $agent; </td>
</tr>
<tr>
<td class="h" >
<a name="63">63</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="64">64</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> my ( $connected, $response ); </td>
</tr>
<tr>
<td class="h" >
<a name="65">65</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> ( $connected, $response ) = $self->try_to_get_out; </td>
</tr>
<tr>
<td class="h" >
<a name="66">66</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="67">67</a>
</td>
<td class="c0" >
0
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--branch.html#67-1">
0
</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> if ( $connected ) { </td>
</tr>
<tr>
<td class="h" >
<a name="68">68</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> say "It looks like you can already get out -- Cancelling login"; </td>
</tr>
<tr>
<td class="h" >
<a name="69">69</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> exit 0; </td>
</tr>
<tr>
<td class="h" >
<a name="70">70</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="71">71</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> else { </td>
</tr>
<tr>
<td class="h" >
<a name="72">72</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> say "Unable to get out -- Attempting to login"; </td>
</tr>
<tr>
<td class="h" >
<a name="73">73</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="74">74</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="75">75</a>
</td>
<td class="c0" >
0
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--branch.html#75-1">
0
</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> if ( agent->form_number( 1 ) ) { </td>
</tr>
<tr>
<td class="h" >
<a name="76">76</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> say "Attempting to connect"; </td>
</tr>
<tr>
<td class="h" >
<a name="77">77</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> $response = agent->submit_form( </td>
</tr>
<tr>
<td class="h" >
<a name="78">78</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> fields => { </td>
</tr>
<tr>
<td class="h" >
<a name="79">79</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> aupAgree => 1, </td>
</tr>
<tr>
<td class="h" >
<a name="80">80</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> }, </td>
</tr>
<tr>
<td class="h" >
<a name="81">81</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> ); </td>
</tr>
<tr>
<td class="h" >
<a name="82">82</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="83">83</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> else { </td>
</tr>
<tr>
<td class="h" >
<a name="84">84</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> say "Unable to find connect form -- Cancelling login"; </td>
</tr>
<tr>
<td class="h" >
<a name="85">85</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> print $response->as_string; </td>
</tr>
<tr>
<td class="h" >
<a name="86">86</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> exit -1; </td>
</tr>
<tr>
<td class="h" >
<a name="87">87</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="88">88</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="89">89</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> ( $connected ) = $self->try_to_get_out; </td>
</tr>
<tr>
<td class="h" >
<a name="90">90</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="91">91</a>
</td>
<td class="c0" >
0
</td>
<td class="c0" >
<a href="blib-lib-App-starbucksloginator-pm--branch.html#91-1">
0
</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> if ( $connected ) { </td>
</tr>
<tr>
<td class="h" >
<a name="92">92</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> say "Connected -- Login successful"; </td>
</tr>
<tr>
<td class="h" >
<a name="93">93</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> exit 0; </td>
</tr>
<tr>
<td class="h" >
<a name="94">94</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="95">95</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="96">96</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> say "Unable to get out -- Login failed"; </td>
</tr>
<tr>
<td class="h" >
<a name="97">97</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> print $response->as_string; </td>
</tr>
<tr>
<td class="h" >
<a name="98">98</a>
</td>
<td class="c0" >
0
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> exit -1; </td>
</tr>
<tr>
<td class="h" >
<a name="99">99</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> } </td>
</tr>
<tr>
<td class="h" >
<a name="100">100</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="101">101</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> 1; </td>
</tr>
<tr>
<td class="h" >
<a name="102">102</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> </td>
</tr>
<tr>
<td class="h" >
<a name="103">103</a>
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td >
</td>
<td class="s"> __END__ </td>
</tr>
</table>
</body>
</html>
|