1setRefClass('statusList', 2 contains='twitterObjList' 3 ) 4 5setValidity('statusList', function(object) { 6 listClassValidity(object, 'status') 7}) 8 9setRefClass("status", 10 contains='twitterObj', 11 fields = list( 12 text="character", 13 favorited="logical", 14 favoriteCount="numeric", 15 replyToSN="character", 16 created="POSIXct", 17 truncated="logical", 18 replyToSID="character", 19 id="character", 20 replyToUID="character", 21 statusSource="character", 22 screenName="character", 23 retweetCount="numeric", 24 isRetweet="logical", 25 retweeted="logical", 26 longitude="character", 27 latitude="character", 28 urls="data.frame" 29 ), 30 methods=list( 31 initialize = function(json, ...) { 32 if (!missing(json)) { 33 if ('user' %in% names(json)) { 34 userObj <- userFactory$new(json[['user']]) 35 screenName <<- userObj$getScreenName() 36 } else if ('from_user' %in% names(json)) { 37 screenName <<- json[['from_user']] 38 } else if ("screen_name" %in% names(json)) { 39 screenName <<- json[["screen_name"]] 40 } else { 41 screenName <<- "Unknown" 42 } 43 44 if (!is.null(json[['text']])) { 45 text <<- json[['text']] 46 } 47 48 if ((is.null(json[['favorited']])) || 49 (json[["favorited"]] == FALSE)) { 50 favorited <<- FALSE 51 } else { 52 favorited <<- TRUE 53 } 54 55 if ((is.null(json[['truncated']])) || 56 (json[["truncated"]] == FALSE)) { 57 truncated <<- FALSE 58 } else { 59 truncated <<- TRUE 60 } 61 62 status_source = get_json_value(json, c("source", "status_source")) 63 if (!is.null(status_source)) { 64 statusSource <<- status_source 65 } 66 67 created_at = get_json_value(json, c("created_at", "created")) 68 if (is.null(created_at)) { 69 created <<- Sys.time() 70 } else { 71 created <<- twitterDateToPOSIX(created_at) 72 } 73 74 in_reply_to_screen_name = get_json_value(json, c("reply_to_s_n", "in_reply_to_screen_name")) 75 if (!is.null(in_reply_to_screen_name) && (!is.na(in_reply_to_screen_name))) { 76 replyToSN <<- as.character(in_reply_to_screen_name) 77 } 78 79 in_reply_to_sid = get_json_value(json, c("reply_to_s_i_d", "in_reply_to_status_id_str")) 80 if ((!is.null(in_reply_to_sid)) && (!is.na(in_reply_to_sid))) { 81 replyToSID <<- as.character(in_reply_to_sid) 82 } 83 84 reply_to_uid = get_json_value(json, c("reply_to_u_i_d", "in_reply_to_user_id_str")) 85 if ((!is.null(reply_to_uid)) && (!is.na(reply_to_uid))) { 86 replyToUID <<- as.character(reply_to_uid) 87 } 88 89 # Note: Make sure id_str is first here, otherwise numeric id will be snagged 90 id_field = get_json_value(json, c("id_str", "id")) 91 if (!is.null(id_field)) { 92 id <<- as.character(id_field) 93 } 94 95 if (!is.null(json[["retweet_count"]])) { 96 retweetCount <<- as.numeric(json[["retweet_count"]]) 97 } 98 99 if ((is.null(json[['retweeted']])) || 100 (json[["retweeted"]] == FALSE)) { 101 retweeted <<- FALSE 102 } else { 103 retweeted <<- TRUE 104 } 105 if (!is.null(json[["favorite_count"]])) { 106 favoriteCount <<- as.numeric(json[["favorite_count"]]) 107 } 108 if (!is.null(json[["coordinates"]]) && (!is.null(json[["coordinates"]][["coordinates"]]))) { 109 longitude <<- as.character(json[["coordinates"]][["coordinates"]][1]) 110 latitude <<- as.character(json[["coordinates"]][["coordinates"]][2]) 111 } else { 112 if (!is.null(json[["longitude"]])) { 113 longitude <<- as.character(json[["longitude"]]) 114 } 115 if (!is.null(json[["latitude"]])) { 116 latitude <<- as.character(json[["latitude"]]) 117 } 118 } 119 120 ## If retweeted_status is provided (which contains the full original status), this is a retweet 121 isRetweet <<- any(c("retweeted_status", "isRetweet") %in% names(json)) 122 123 urls <<- build_urls_data_frame(json) 124 } 125 callSuper(...) 126 }, 127 getRetweets = function(n=20, ...) { 128 return(retweets(self$getId(), n, ...)) 129 }, 130 getRetweeters = function(n=20, ...) { 131 return(retweeters(self$getId(), n, ...)) 132 }, 133 toDataFrame = function(row.names=NULL, optional=FALSE, stringsAsFactors=FALSE) { 134 callSuper(row.names=row.names, optional=optional, stringsAsFactors=stringsAsFactors, 135 fieldsToRemove="urls") 136 } 137 ) 138 ) 139 140 141statusFactory = getRefClass("status") 142statusFactory$accessors(names(statusFactory$fields())) 143 144buildStatus = function(json) { 145 if (is.null(json)) { 146 NULL 147 } else { 148 statusFactory$new(json) 149 } 150} 151 152setMethod("show", signature="status", function(object) { 153 print(paste(screenName(object), object$text, sep=": ")) 154}) 155 156updateStatus <- function(text, lat=NULL, long=NULL, placeID=NULL, 157 displayCoords=NULL, inReplyTo=NULL, mediaPath=NULL, 158 bypassCharLimit=FALSE, ...) { 159 if (!has_oauth_token()) 160 stop("updateStatus requires OAuth authentication") 161 162 if (nchar(text) > 140 && !bypassCharLimit) 163 stop("Status can not be more than 140 characters") 164 165 params = buildCommonArgs(lat=lat, long=long, place_id=placeID, 166 display_coordinates=displayCoords, 167 in_reply_to_status_id=inReplyTo) 168 params[['status']] <- text 169 170 if (is.null(mediaPath)){ 171 endpoint = 'statuses/update' 172 } else { 173 endpoint = 'statuses/update_with_media' 174 params[['media']] <- upload_file(mediaPath) 175 } 176 json = twInterfaceObj$doAPICall(endpoint, 177 params=params, method='POST', ...) 178 return(buildStatus(json)) 179} 180 181tweet = function(text, ...) { 182 return(updateStatus(text, ...)) 183} 184 185deleteStatus = function(status, ...) { 186 if (!has_oauth_token()) { 187 stop("deleteStatus requires OAuth authentication") 188 } 189 if (!inherits(status, 'status')) { 190 stop("status argument must be of class status") 191 } 192 193 json = twInterfaceObj$doAPICall(paste('statuses/destroy', 194 status$getId(), sep='/'), 195 method='POST', ...) 196 if (is.null(json$errors)) { 197 return(TRUE) 198 } else { 199 for (error in json$errors) { 200 cat(error$message, error$code, fill = TRUE) 201 } 202 return(FALSE) 203 } 204} 205 206lookup_statuses = function(ids, ...) { 207 sapply(ids, check_id) 208 cmd = "statuses/lookup" 209 params = list(id=paste(ids, collapse=",")) 210 # FIXME: Note that this is set to GET but twitter recommends POST. See issue #78 211 return(sapply(twInterfaceObj$doAPICall(cmd, params=params, method="GET", ...), buildStatus)) 212} 213 214showStatus = function(id, ...) { 215 check_id(id) 216 buildStatus(twInterfaceObj$doAPICall(paste('statuses', 'show', id, sep='/'), ...)) 217} 218 219retweets = function(id, n=20, ...) { 220 check_id(id) 221 222 if (n > 100) { 223 stop("n must be less than 100, set to ", n) 224 } 225 226 cmd = "statuses/retweets" 227 params = list(id=id, count=n) 228 return(sapply(doAPICall(cmd, params=params), buildStatus)) 229} 230 231retweeters = function(id, n=20, ...) { 232 check_id(id) 233 234 cmd = "statuses/retweeters/ids" 235 params = list(id=id, count=n) 236 json = doCursorAPICall(cmd, "ids", num=n, params=params, method="GET", ...) 237 json 238} 239 240favorites = function(user, n=20, max_id=NULL, since_id=NULL, ...) { 241 uParams = parseUsers(user) 242 cmd = "favorites/list" 243 params = buildCommonArgs(max_id=max_id, since_id=since_id) 244 params[["user_id"]] = uParams[["user_id"]] 245 params[["screen_name"]] = uParams[["screen_name"]] 246 return(statusBase(cmd, params, n, 200, ...)) 247} 248 249userTimeline = function(user, n=20, maxID=NULL, sinceID=NULL, includeRts=FALSE, excludeReplies=FALSE, ...) { 250 uParams <- parseUsers(user) 251 cmd <- 'statuses/user_timeline' 252 params <- buildCommonArgs(max_id=maxID, since_id=sinceID) 253 params[['user_id']] <- uParams[['user_id']] 254 params[['screen_name']] <- uParams[['screen_name']] 255 params[["include_rts"]] <- ifelse(includeRts == TRUE, "true", "false") 256 params[["exclude_replies"]] <- ifelse(excludeReplies == TRUE, "true", "false") 257 return(statusBase(cmd, params, n, 3200, ...)) 258} 259 260homeTimeline <- function(n=25, maxID=NULL, sinceID=NULL, ...) { 261 return(authStatusBase(n, 'home_timeline', maxID=maxID, sinceID=sinceID, ...)) 262} 263 264mentions <- function(n=25, maxID=NULL, sinceID=NULL, ...) { 265 return(authStatusBase(n, 'mentions_timeline', maxID=maxID, sinceID=sinceID, ...)) 266} 267 268retweetsOfMe <- function(n=25, maxID=NULL, sinceID=NULL, ...) { 269 return(authStatusBase(n, 'retweets_of_me', maxID=maxID, sinceID=sinceID, ...)) 270} 271 272authStatusBase <- function(n, type, maxID=NULL, sinceID=NULL, ...) { 273 if (!has_oauth_token()) { 274 stop("OAuth is required for this functionality") 275 } 276 277 params <- buildCommonArgs(max_id=maxID, since_id=sinceID) 278 cmd <- paste('statuses', type, sep='/') 279 cmd <- paste('statuses', type, sep='/') 280 return(statusBase(cmd, params, n, 800, ...)) 281} 282 283statusBase <- function(cmd, params, n, maxN, ...) { 284 n <- as.integer(n) 285 if (n > maxN) { 286 warning(cmd, " has a cap of ", maxN, " statuses, clipping") 287 n <- maxN 288 } 289 return(sapply(doPagedAPICall(cmd, n, params, ...), buildStatus)) 290} 291 292build_urls_data_frame = function(json) { 293 ## takes a status JSON and will either return a data.frame of the URLs entity or an 294 ## empty data.frame if there were none provided 295 split_indices = function(urls_block) { 296 urls_block$start_index = urls_block$indices[1] 297 urls_block$stop_index = urls_block$indices[2] 298 urls_block$indices = NULL 299 urls_block 300 } 301 302 if (length(json$entities$urls) > 0) { 303 urls = json$entities$urls 304 massaged_urls = lapply(urls, split_indices) 305 return(do.call("rbind", lapply(massaged_urls, as.data.frame, stringsAsFactors=FALSE))) 306 } else { 307 data.frame(url=character(), expanded_url=character(), dispaly_url=character(), indices=numeric(), stringsAsFactors=FALSE) 308 } 309} 310