This user has either cancelled their membership, or their account has been deleted.)/io, is_comedy => qr/http\:\/\/.*?myspace\.com\/images\/comedy\/mscomedy\.gif/io, is_film => qr/http\:\/\/.*?myspace\.com\/images\/film_logo\.gif/io, is_music => qr/http\:\/\/.*?myspace\.com\/images\/music_logo\.gif/io, last_login => qr/Last Login:/io, basic_info => qr/Table2".*?>(.*Last Login:.*?)
/smo, basic_info_sub => qr/align="left">(.*)/smo, basic_info_band => qr/Arial, Helvetic, sans-serif">(.*Last Login:.*?)
/smo, comment_posted => qr/Your Comment has been posted/io, not_logged_in => qr/You Must Be Logged-In to do That\!/io, verify_message_sent => qr/Your Message Has Been Sent\!/o, comment_p1 => qr/ctl00\$(cp)?Main\$postComment\$commentTextBox.*<\/form|$NOT_FRIEND_ERROR|($CAPTCHA)|($INVALID_ID)/smio, comment_p2 => qr/ctl00\$(cp)?Main\$postComment\$Button1.*<\/form/smo, comment_approval_msg => qr/This user requires all comments to be approved before being posted/o, not_friend => qr/$NOT_FRIEND_ERROR/smo, bulletin_url => qr/fuseaction=bulletin\.edit/io, bulletin_post_action => qr/<\s*input .*?value\s*=\s*"Post".*?submitPage\s*\(\s*'\s*(.*?)\s*'/ismo, bulletin_p1 => qr/ctl00\$cpMain\$Subject_Textbox/io, bulletin_p2 => qr/Confirm\s+Bulletin/o, bulletin_confirm_action => qr/function postBulletin\(\).*?submitPage\('(.*?)'/ismo, bulletin_posted => qr/Bulletin Has Been Posted/io, verify_get_profile => qr/fuseaction=invite\.addfriend/io, exceed_usage => qr/User has exceeded their daily use?age/io, ); ###################################################################### # Methods # (These "sub" lines make section dividers in BBedit's function menu. # I'm sure there's a better way, so don't go "learning" anything from me # here. :) sub ____SET_OPTIONS__LOG_IN____ {} =head1 SET OPTIONS / LOG IN The new method takes the following options, all of which are optional. See the accessor methods below for defaults. Any option can be passed in a hash or hashref to the "new" method, and retreived or set using the appropriate accessor method below. account_name => 'myaccount', password => 'mypass', cache_dir => '/path/to/dir', cache_file => 'filename', # $cache_dir/$cache_file auto_login => 1 # 1 or 0, default is 1. human => 1 # Go slow. Saves bandwidth. =cut # Options they can pass via hash or hashref. const default_options => { account_name => 0, password => 0, cache_dir => 0, # Default set by field method below cache_file => 0, # Default set by field method below auto_login => 0, # Default set by field method below human => 0, # Default set by field method below max_get_attempts => 0, # Default set by field method below max_post_attempts => 0, # Default set by field method below captcha_killer_api_key => 0, # Default set by field method below captcha_tries => 0, # Default set by field method below }; # Options they can pass by position. # Just "new( 'joe@myspace.com', 'mypass' )". const positional_parameters => [ 'account_name', 'password' ]; =head1 OPTION ACCESSORS These methods can be used to set/retreive the respective option's value. They're also up top here to document the option, which can be passed directly to the "new" method. =head2 account_name Sets or returns the account name (email address) under which you're logged in. Note that the account name is retreived from the user or from your program depending on how you called the "new" method. You'll probably only use this accessor method to get account_name. EXAMPLE The following would prompt the user for their login information, then print out the account name: use WWW::Myspace; my $myspace = new WWW::Myspace; print $myspace->account_name; $myspace->account_name( 'other_account@myspace.com' ); $myspace->password( 'other_accounts_password' ); $myspace->site_login; WARNING: If you do change account_name, make sure you change password and call site_login. Changing account_name doesn't (currently) log you out, nor does it clear "password". If you change this and don't log in under the new account, it'll just have the wrong value, which will probably be ignored, but who knows. =cut field 'account_name'; =head2 password Sets or returns the password you used, or will use, to log in. See the warning under "account_name" above - same applies here. =cut field 'password'; =head2 cache_dir WWW::Myspace stores the last account/password used in a cache file for convenience if the user's entering it. Other modules store other cache data as well. cache_dir sets or returns the directory in which we should store cache data. Defaults to $ENV{'HOME'}/.www-myspace. If using this from a CGI script, you will need to provide the account and password in the "new" method call, or call "new" with "auto_login => 0" so cache_dir will not be used. =cut field cache_dir => catfile( "$HOME_DIR", '.www-myspace' ); =head2 cache_file Sets or returns the name of the file into which the login cache data is stored. Defaults to login_cache. If using this from a CGI script, you will need to provide the account and password in the "new" method call, so cache_file will not be used. =cut field cache_file => 'login_cache'; =head2 auto_login Really only useful as an option passed to the "new" method when creating a new WWW::Myspace object. # Don't log in, just create a new object my $myspace = new WWW::Myspace( auto_login => 0 ); Defaults to 1 for backwards compatibility. =cut field 'auto_login' => 1; =head2 human When set to a true value (which is the default), adds delays to make the module act more like a human. This is both to offset "faux security" measures, and to conserve bandwidth. If you're dumb enough to try to use multiple accounts to spam users who don't want to hear what you have to say, you should turn this off because it'll make your spamming go faster. =cut field 'human' => 1; =head2 max_get_attempts This is only here by request and should probably be left alone. Setting max_get_attempts controls the number of times the module will attempt to get a page. You can make your script really robust by setting this to a really high number. For example setting it to about 17280 would make the module try to get a given page for about 24 hours before giving up. Default is 20. You could also set this to a lower number if you wanted to be "nice" to Myspace, although set get_page mostly retries on errors, this is a bit pointless. Note though that on some occasions if a regular expression on the page being requested doesn't match (possibly due to a change in the site), get_page will keep trying a page that will never load up to max_get_attempts times. =cut field 'max_get_attempts' => 20; =head2 max_post_attempts This is the form version of max_get_attempts. This controls the number of times the submit_form function will attempt to submit a form before giving up. This defaults to 5. This should probably be kept at 5 since posting a form means you're usually sending some data (i.e. a comment), so in the event of a problem (such as the regular expression matching issue mentioned in max_get_attempts above), you could in theory be posting a successful form up to max_post_attempts times. In normal operation, however, submit_form will attempt to post until the post is successful, no matter what the outcome, so it will only retry if it gets an error page or the page doesn't match an expected regular expression. That is, when you're using myspace and have to keep trying things, submit_form does the same thing, but only up to max_post_attempts times. Change at your own risk. =cut field 'max_post_attempts' => 5; =head2 captcha_killer_api_key If you have an API key for captchakiller.com, you can set it using this method, or pass it to the "new" method when creating the myspace object. Methods that support it will use captchakiller to process captchas. use WWW::Myspace; my $myspace = new WWW::Myspace( captcha_killer_api_key => 'asdfjhasdfe' ); =cut field 'captcha_killer_api_key' => ""; =head2 captcha_tries Sets or returns the number of attempts that should be made to retreive the catpcha code (basically, how long it should wait before it gives up - each try takes about 5 seconds). Defaults to 20. =cut field 'captcha_tries' => 20; #--------------------------------------------------------------------- # new method # If we're passed an account and possibly a password, we store them. # Otherwise, we check the login cache file, and if we still # don't have them, we ask the user. =head2 new( $account, $password ) =head2 new( ) If called without the optional account and password, the new method looks in a user-specific preferences file in the user's home directory for the last-used account and password. It prompts for the username and password with which to log in, providing the last-used data (from the preferences file) as defaults. Once the account and password have been retreived, the new method automatically invokes the "site_login" method and returns a new WWW::Myspace object reference. The new object already contains the content of the user's "home" page, the user's friend ID, and a UserAgent object used internally as the "browser" that is used by all methods in the WWW::Myspace class. Myspace.pm is now a subclass of WWW::Myspace::MyBase (I couldn't resist, sorry), which basically just means you can call new in many ways: EXAMPLES use WWW::Myspace; # Prompt for username and password my $myspace = new WWW::Myspace; # Pass just username and password my $myspace = new WWW::Myspace( 'my@email.com', 'mypass' ); # Pass options as a hashref my $myspace = new WWW::Myspace( { account_name => 'my@email.com', password => 'mypass', cache_file => 'passcache', } ); # Hash my $myspace = new WWW::Myspace( account_name => 'my@email.com', password => 'mypass', cache_file => 'passcache', auto_login => 0, ); # Print my friend ID print $myspace->my_friend_id; # Print the contents of the home page print $myspace->current_page->decoded_content; # Print all my friends with a link to their profile. @friend_ids = $myspace->get_friends; foreach $id ( @friend_ids ) { print 'http://profile.myspace.com/index.cfm?'. 'fuseaction=user.viewprofile&friendID='. ${id}."\n"; } # How many friends do we have? (Note: we don't include Tom # because he's everybody's friend and we don't want to be # bugging him with comments and such). print @friend_ids . " friends (not incl Tom)\n"; =cut sub _old_new() { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; bless ($self, $class); if ( @_ ) { $self->{account_name} = shift } if ( @_ ) { $self->{password} = shift } unless ( $self->{account_name} ) { # Get account/password from the user $self->_get_acct(); } # And for convenience, log in $self->_site_login(); return $self; } sub new() { # Call the MyBase new method (it's ok to feel special about it). my $self = super; # Log in if requested if ( $self->auto_login ) { # Prompt for username/password if we don't have them yet. # (should this be moved to site_login?) $self->_get_acct unless $self->account_name; $self->site_login; } else { $self->logout; # Why? Resets variables and gets Mech object. } return $self; } #--------------------------------------------------------------------- # site_login() # Log into myspace with the stored account login name, password, and # URL (probably "http://www.myspace.com/") =head2 site_login Logs into the myspace account identified by the "account_name" and "password" options. You don't need to call this right now, because "new" does it for you. BUT I PLAN TO CHANGE THAT. You don't need to be logged in to access certain functions, so it's semi-silly to make you log in the second you call "new". Plus, it's not good practice to have "new" require stuff. Bad me. If you call the new method with "auto_login => 0", you'll need to call this method if you want to log in. It's also called automatically if the _check_login method finds that you've been mysteriously logged out, for example if Myspace.com were written in Cold Fusion running on Windows. If the login gets a "you must be logged-in" page when you first try to log in, $myspace->error will be set to an error message that says to check the username and password. Once login is successful for a given username/password combination, the object "remembers" that the username/password is valid, and if it encounters a "you must be logged-in" page, it will try up to 20 times to re-login. Clever, huh? =cut sub site_login { # Reset everything (oddly, this also happens to create a new browser # object). $self->logout; croak "site_login called but account_name isn't set" unless ( $self->account_name ); croak "site_login called but password isn't set" unless ( $self->password ); # Now log in $self->_try_login; return if $self->error; # We probably have an ad or somesuch (started 1/7/2006) # so explicitly request our Home. # We can't click "home", because as of 10/10/07 Myspace sets the Home # link using Javascript if you're logged in. Why do the work on the # server when you can just add extra code and do it on the browser instead? # In fact, why not just make all of Myspace run in the browser? $self->follow_to( $HOME_PAGE, '' ) or warn "Couldn't go to user's home page"; # ( $DEBUG ) && warn $self->current_page->content; # Verify we're logged in if ( $self->_apply_regex( regex => 'is_logged_in' ) ) { $self->logged_in( 1 ); warn "Logged in\n" if ( $DEBUG ); } else { $self->logged_in( 0 ); unless ( $self->error ) { $self->error( "Login Failed. Couldn't verify load of home page." ) } warn $self->current_page->decoded_content if $DEBUG; return; } # Initialize basic account/login-specific settings after login $self->_init_account; } # _try_login # You call this as $self->_try_login. Attempts to log in using # the set account_name and password. It gets and submits the login form, # then checks for a valid submission and for a "you must be logged-in" # page. # If called with a number as an argument, tries that many times to # submit the form. It calls itself recursively. sub _try_login { # Set the recursive tries counter. my ( $tries_left ) = @_; if ( $tries_left ) { $tries_left--; return if ( $tries_left ) < 1; } $tries_left = 20 unless defined $tries_left; # Submit the login form. They have two different ones, so if we see indication of # the ASP form (new as of late Jun 2007), use it, otherwise use the CFM version. # 9/17/07 - they changed from "ctl01" to "ctl00", so we check for both in case # they go back and forth. my $submitted=""; $self->get_page( 'http://www.myspace.com/' ); if ( $self->current_page->decoded_content =~ /ctl00\$Main\$SplashDisplay\$ctl00\$Email_Textbox/io ) { $submitted = $self->submit_form( { # page => 'http://www.myspace.com/', form_name => 'aspnetForm', fields_ref => { 'ctl00$Main$SplashDisplay$ctl00$Email_Textbox' => $self->account_name, 'ctl00$Main$SplashDisplay$ctl00$Password_Textbox' => $self->password, # '__EVENTTARGET' => 'ctl00$Main$SplashDisplay$ctl00$Login_ImageButton', # '__EVENTARGUMENT' => '', }, action => 'http://secure.myspace.com/index.cfm?fuseaction=login.process', # no_click => 1, } ) ; } elsif ( $self->current_page->decoded_content =~ /ctl00\$Main\$SplashDisplay\$ctl01\$Email_Textbox/io ) { $submitted = $self->submit_form( { # page => 'http://www.myspace.com/', form_name => 'aspnetForm', fields_ref => { 'ctl00$Main$SplashDisplay$ctl01$Email_Textbox' => $self->account_name, 'ctl00$Main$SplashDisplay$ctl01$Password_Textbox' => $self->password, # '__EVENTTARGET' => 'ctl00$Main$SplashDisplay$ctl01$Login_ImageButton', # '__EVENTARGUMENT' => '', }, action => 'http://secure.myspace.com/index.cfm?fuseaction=login.process', # no_click => 1, } ) } else { my $btn_name = $self->current_page->decoded_content =~ /ctl00\$Main\$SplashDisplay\$ctl00\$loginbutton/ ? 'ctl00$Main$SplashDisplay$ctl00$loginbutton' : 'ctl00$Main$SplashDisplay$ctl01$loginbutton'; $submitted = $self->submit_form( { # page => 'http://www.myspace.com/', form_name => 'theForm', fields_ref => { email => $self->account_name, password => $self->password }, button => $btn_name } ); } # Check for success if ( $submitted ) { # ( $DEBUG ) && print $self->current_page->decoded_content; # Check for invalid login page, which means we either have # an invalid login/password, or myspace is messing up again. unless ( $self->_check_login ) { # Fail unless we already know this account/password is good, in # which case we'll just beat the door down until we can get in # or the maximum number of attempts has been reached. if ( $self->_account_verified ) { $self->_try_login( $tries_left ); } else { $self->error( "Login Failed. Got 'You Must Be Logged-In' page ". "when logging in.\nCheck username and password." ); return; } } } else { return; # croak $self->error; } } # _account_verified # Returns true if we've verified that the current account and password # are valid (by successfully logging in with them) sub _account_verified { ( ( $self->{_account_verified}->{ $self->account_name } ) && ( $self->password = $self->{_account_verified}->{ $self->account_name } ) ) } # _init_account # Initialize basic account/login-specific settings after login sub _init_account { # Get our friend ID from our home page (which happens to # be the page we go to after logging in). $self->_get_friend_id( $self->current_page ); # If for some reason we couldn't set this, fail login. unless ( $self->my_friend_id ) { $self->logged_in(0) ; return } # Set the user_name and friend_count fields. $self->user_name( $self->current_page ); $self->friend_count( $self->current_page ); # Cache whether or not we're a band. $self->is_band; # Note that we've verified this account/password $self->{_account_verified}->{ $self->account_name } = $self->password; } =head2 mech_params Pass this parameters you wish the WWW::Mechanize object to use, inside a hash reference. for example: $myspace->mech_params({ onerror => undef, agent => 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)' stack_depth => 1, quiet => 1, }); See the docs for WWW::Mechanize for more information. You should really know what you are doing before using this feature. =cut field mech_params => undef; sub _new_mech { my %default_mech_params = ( onerror => undef, agent => 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)', stack_depth => 1, quiet => 1, ); my $new_p = $self->mech_params(); if (defined($new_p)) { if (ref($new_p) eq "HASH") { while (my ($k,$v) = each %$new_p) { $default_mech_params{$k} = $v; } } else { warn "Please pass mech_params() a HASH reference. Thanks!\n"; } } # Set up our web browser (WWW::Mechanize object) $self->mech( new WWW::Mechanize( %default_mech_params ) ); # We need to follow redirects for POST too. push @{ $self->mech->requests_redirectable }, 'POST'; } =head2 logout Clears the current web browsing object and resets any login-specific internal values. Currently this drops and creates a new WWW::Mechanize object. This may change in the future to actually clicking "logout" or something. =cut sub logout { # If you change this to just log out instead of making a new Mech # object, be sure you change site_login too. $self->_new_mech; # Clear anything login-specific $self->{user_name} = undef; $self->{is_band} = undef; $self->{my_friend_id} = undef; $self->logged_in(0); $self->error(0); $self->{page_cache} = undef; # Do NOT clear options that are set by the user! # $self->{account_name} = undef; # $self->{password} = undef; } =head2 get_login_form This handy little convenience method returns a string of HTML code that is a login form pre-filled with the account_name and password. I use it in a little "Dashboard" script I wrote that displays the notifications and a Login button. use WWW::Myspace; use CGI qw/:standard/;; my $myspace = new WWW::Myspace; # Display a login form print header, start_html('Is it worth logging in?'), $myspace->get_login_form, end_html; =cut sub get_login_form { my $x = ''; return $x; } #--------------------------------------------------------------------- # Value return methods # These methods return internal data that is of use to outsiders sub ____CHECK_STATUS____ {} =head1 CHECK STATUS =head2 logged_in Returns true if login was successful. When you call the new method of WWW::Myspace, the class logs in using the username and password you provided (or that it prompted for). It then retreives your "home" page (the one you see when you click the "Home" button on myspace.com, and checks it against an RE. If the page matches the RE, logged_in is set to a true value. Otherwise it's set to a false value. Notes: - This method is only set on login. If you're logged out somehow, this method won't tell you that (yet - I may add that later). - The internal login method calls this method to set the value. You can (currently) call logged_in with a value, and it'll set it, but that would be stupid, and it might not work later anyway, so don't. Examples: my $myspace = new WWW::Myspace; unless ( $myspace->logged_in ) { die "Login failed\n"; } # This will try forever to log in my $myspace; do { $myspace = new WWW::Myspace( $username, $password ); } until ( $myspace->logged_in ); =cut field logged_in => 0; =head2 error This value is set by some methods to return an error message. If there's no error, it returns a false value, so you can do this: $myspace->get_profile( 12345 ); if ( $myspace->error ) { warn $myspace->error . "\n"; } else { # Do stuff } =cut field 'error' => 0; =head2 current_page Returns a reference to an HTTP::Response object that contains the last page retreived by the WWW::Myspace object. All methods (i.e. get_page, post_comment, get_profile, etc) set this value. EXAMPLE The following will print the content of the user's profile page: use WWW::Myspace; my $myspace = new WWW::Myspace; print $myspace->current_page->decoded_content; =cut sub current_page { return $self->{current_page}; } =head2 mech The internal WWW::Mechanize object. Use at your own risk: I don't promise this method will stay here or work the same in the future. The internal methods used to access Myspace are subject to change at any time, including using something different than WWW::Mechanize. =cut field 'mech'; sub ____GET_INFO____ {} =head1 GET INFO =head2 get_notifications Returns a hash of status codes and printable indicators for "New" indicators ("New Messages!", "New Comments!", etc). Note that you probably want to call this right after logging in, as if you use any of the "read" methods, Myspace will reset that indicator. For example, if you use "get_inbox", Myspace will think you looked at your mail. Codes returned are: NC => New Comments! NM => New Messages! NFR => New Friend Requests! NIC => New Image Comments! EV => New Event Invitation! BC => New Blog Comments! BP => New Blog Posts! # Print all notifications use WWW::Myspace; my $myspace = new WWW::Myspace( $account, $password ); my $notifiers = $myspace->get_notifications; foreach $code ( keys( %notifiers ) ) { print $notifiers{ $code }; } # CGI script to display notifications and a Login button # to click if it's worth logging in (be sure you provide the # account and password ;-): use CGI qw/:standard/; use WWW::Myspace; my $myspace = new WWW::Myspace( $account, $password ); print header, start_html('Is it worth logging in?'); my ( %notifiers ) = $myspace->get_notifications; foreach $code ( keys( %notifiers ) ) { print $notifiers{ $code }, br; } print p, $myspace->get_login_form, p, end_html; =cut my $stats_ref = { 'NC' => { 'search' => { css => '
',
db => 'New Comments!',
},
'display' => 'New Comments!'
},
'NM' => { 'search' => { css => '
