1setRefClass('userList',
2            contains='twitterObjList'
3            )
4
5setValidity('userList', function(object) {
6  listClassValidity(object, 'user')
7})
8
9setRefClass("user",
10            contains='twitterObj',
11            fields = list(
12              description="character",
13              statusesCount="numeric",
14              followersCount="numeric",
15              favoritesCount="numeric",
16              friendsCount="numeric",
17              url="character",
18              name="character",
19              created="POSIXct",
20              protected="logical",
21              verified="logical",
22              screenName="character",
23              location="character",
24              lang="character",
25              id="character",
26              lastStatus="status",
27              listedCount="numeric",
28              followRequestSent="logical",
29              profileImageUrl="character"
30              ),
31            methods = list(
32              initialize = function(json, ...) {
33                if (!missing(json)) {
34                  if (!is.null(json[['status']]))
35                    lastStatus <<- buildStatus(json[['status']])
36
37                  if (is.character(json[['description']]))
38                    description <<- json[['description']]
39
40                  if (!is.null(json[['statuses_count']]))
41                    statusesCount <<- as.numeric(json[['statuses_count']])
42
43                  if (!is.null(json[['followers_count']]))
44                    followersCount <<- as.numeric(json[['followers_count']])
45
46                  if (!is.null(json[['friends_count']]))
47                    friendsCount <<- as.numeric(json[['friends_count']])
48
49                  ## NOTE: Twitter uses the british spelling for historical reasons
50                  favorites_count = get_json_value(json, c("favourites_count", "favorites_count"))
51                  if (!is.null(favorites_count)) {
52                    favoritesCount <<- as.numeric(favorites_count)
53                  }
54
55                  if ((!is.null(json[['url']]))&&(!is.na(json[['url']])))
56                    url <<- json[['url']]
57
58                  if (is.character(json[['name']]))
59                    name <<- json[['name']]
60
61                  created_at = get_json_value(json, c("created_at", "created"))
62                  if (is.null(created_at)) {
63                    created <<- Sys.time()
64                  } else {
65                    created <<- twitterDateToPOSIX(created_at)
66                  }
67
68                  if ((is.null(json[['protected']])) ||
69                      (json[['protected']] == FALSE))
70                    protected <<- FALSE
71                  else
72                    protected <<- TRUE
73
74                  if ((is.null(json[['verified']])) ||
75                      (json[['verified']] == FALSE))
76                    verified <<- FALSE
77                  else
78                    verified <<- TRUE
79
80                  if (is.character(json[['screen_name']]))
81                    screenName <<- json[['screen_name']]
82
83                  # Note: id_str must be checked first!
84                  id_field = get_json_value(json, c("id_str", "id"))
85                  if (!is.null(id_field)) {
86                    id <<- as.character(id_field)
87                  }
88
89                  if (!is.null(json[['location']])) {
90                    location <<- json[['location']]
91                  }
92
93                  if (!is.null(json[['lang']])) {
94                    lang <<- json[['lang']]
95                  }
96
97                  if (!is.null(json[["listed_count"]])) {
98                    listedCount <<- json[["listed_count"]]
99                  }
100
101                  if ((is.null(json[["followRequestSent"]])) ||
102                      (json[["followRequestSent"]] == FALSE)) {
103                    followRequestSent <<- FALSE
104                  } else {
105                    followRequestSent <<- TRUE
106                  }
107
108                  if (!is.null(json[["profile_image_url"]])) {
109                    profileImageUrl <<- json[["profile_image_url"]]
110                  }
111                }
112
113                callSuper(...)
114              },
115              getFollowerIDs = function(n=NULL, ...) {
116                return(unlist(followers(.self$id, n, ...)))
117              },
118              getFollowers = function(n=NULL, ...) {
119                fol <- .self$getFollowerIDs(n, ...)
120                lookupUsers(fol, ...)
121              },
122              getFriendIDs = function(n=NULL, ...) {
123                return(unlist(friends(.self$id, n, ...)))
124              },
125              getFriends = function(n=NULL, ...) {
126                fri <- .self$getFriendIDs(n, ...)
127                lookupUsers(fri, ...)
128              },
129              getFavouritesCount = function() {
130                return(favoritesCount)
131              },
132              getFavorites = function(n=20, max_id=NULL, since_id=NULL, ...) {
133                return(favorites(screenName, n=n, max_id=max_id, since_id=since_id, ...))
134              },
135              toDataFrame = function(row.names=NULL, optional=FALSE, stringsAsFactors=FALSE) {
136                callSuper(row.names=row.names, optional=optional, stringsAsFactors=stringsAsFactors,
137                          fieldsToRemove='lastStatus')
138              }
139            )
140          )
141
142userFactory <- getRefClass("user")
143userFactory$accessors(names(userFactory$fields()))
144
145buildUser <- function(json) {
146  if (is.null(json)) {
147    NULL
148  } else {
149    userFactory$new(json)
150  }
151}
152
153setMethod("show", signature="user", function(object) {
154    print(screenName(object))
155})
156
157getUser <- function(user, ...) {
158  params <- parseUsers(user)
159  buildUser(twInterfaceObj$doAPICall(paste('users', 'show', sep='/'),
160                                     params=params, ...))
161}
162
163lookupUsers <- function(users, includeNA=FALSE, ...) {
164  MatchLookedUpUsers <- function(vals) {
165    order <- match(tolower(users), tolower(vals))
166    na.eles <- which(is.na(order))
167
168    if (length(na.eles) > 0) {
169      if (!includeNA) {
170        order <- order[-na.eles]
171        users <- users[-na.eles]
172      }
173    }
174    out <- out[order]
175    names(out) <- users
176
177    return(out)
178  }
179
180  if (is.null(users) || length(users) == 0) {
181    return(list())
182  }
183
184  batches <- split(users, ceiling(seq_along(users) / 100))
185  results <- lapply(batches, function(batch) {
186    params <- parseUsers(batch)
187    twInterfaceObj$doAPICall(paste('users', 'lookup', sep='/'),
188                             params=params, ...)
189  })
190  out <- sapply(do.call(c, results), buildUser)
191
192  ## Order these to match the users vector - if !includeNA,
193  ## drop out the elements of the return list which weren't
194  ## found
195  sn.lookups <- MatchLookedUpUsers(sapply(out,
196                                          function(x) x$getScreenName()))
197  id.lookups <- MatchLookedUpUsers(sapply(out, function(x) x$getId()))
198
199  ## The problem with doing it in the two batch way above is that
200  ## anything that was SN will be NULL for ID and vice versa.
201  ## If includeNA is TRUE, we can't just remove all empty
202  ## entries. As a hack, only retain the NULL values that are shared
203  ## between both lists
204  if (includeNA) {
205    sn.nulls <- sapply(sn.lookups, is.null)
206    id.nulls <- sapply(id.lookups, is.null)
207    false.nulls <- xor(sn.nulls, id.nulls)
208    sn.lookups <- sn.lookups[!(sn.nulls & false.nulls)]
209    id.lookups <- id.lookups[!(id.nulls & false.nulls)]
210  } else {
211    ## Otherwise, just strip out the names that have been
212    ## taken out
213    users <- intersect(users, union(names(sn.lookups), names(id.lookups)))
214  }
215
216  out <- c(sn.lookups, id.lookups)
217  return(out[users])
218}
219
220
221