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