I am connecting to a MySQL database via R and some of the data that the database looks like the following:
a:1:{s:17:\"last_cart_refresh\";i:1470188219;}
My understanding is that this is PHP serialized data using the PHP serialize() function. Is there a way within R (either native or with a package) to make sense of this data?
EDIT: added clarification that I want a way in R not PHP to be able to read the data.
To use php serialized data in R, you can use this function:
php_unserialize <- function(string){
first <- unlist(strsplit(string, "\\{|\\}", fixed=F))
inside_array <- unlist(strsplit(first[-1], ";", fixed=T))
infomation_type <- substr(inside_array, 1,1)
if(any(nchar(gsub("s|i", "", unique(infomation_type) )) != 0)){
stop("unknow datatype in serilize data")
}
inside_array_s <- rep(NA, length(inside_array))
pos <- infomation_type == "s"
string_length <- as.numeric(sapply(strsplit(inside_array, ":", fixed=T), function(x) x[2]))[pos]
inside_array_s[pos] <- substr(inside_array[pos], nchar(string_length)+4, nchar(inside_array[pos]))
pos <- infomation_type == "i"
inside_array_s[pos] <- substr(inside_array[pos],3,nchar(inside_array[pos]))
# create key and value for each elment
key <- inside_array_s[seq(1,length(inside_array_s),2)]
value <- inside_array_s[seq(2,length(inside_array_s),2)]
return(cbind(key, value))
}
The function returns a matrix with the key's and value's of the php-array.
string <- 'a:1:{s:17:\"last_cart_refresh\";s:17:\"last_cart_refresh\";}'
php_unserialize(string)
If your php array contain other arrays or even nested arrays, use this more complex function. The result is than a list:
php_unserialize <- function(string){
first <- unlist(strsplit(string, "\\{|\\}", fixed=F))
inside_array <- unlist(strsplit(first[-1], ";", fixed=T))
infomation_type <- substr(inside_array, 1,1)
if(any(nchar(gsub("a|s|i", "", unique(infomation_type) )) != 0)){
stop("unknow datatype in serilize data")
}
# element info: key & value ####
# mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
inside_array_s <- rep(NA, length(inside_array))
pos <- infomation_type == "s"
string_length <- as.numeric(sapply(strsplit(inside_array, ":", fixed=T), function(x) x[2]))[pos]
inside_array_s[pos] <- substr(inside_array[pos], nchar(string_length)+4, nchar(inside_array[pos]))
pos <- infomation_type == "i"
inside_array_s[pos] <- substr(inside_array[pos],3,nchar(inside_array[pos]))
# create key and value for each elment
key <- inside_array_s[seq(1,length(inside_array_s),2)]
value <- inside_array_s[seq(2,length(inside_array_s),2)]
# map array stuctur ####
# mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
# create map1: sub-array beginning and sub-array lengths
pos <- which(infomation_type == "a")
if(length(pos) > 0){
sa_begin <- pos/2
sa_len <- as.numeric(substr(inside_array[pos],3,nchar(inside_array[pos])-1))
array_depth0 <- cbind(sa_begin, sa_len)
z=1
# in case of sub arrays shorten the maped sub-array length
if(nrow(array_depth0) > 1){
for(z in 1:(nrow(array_depth0)-1)){
tmp <- array_depth0
val <- tmp[z,1] + tmp[z,2]
while(val >= tmp[z+1,1]){
array_depth0[z,2] <- array_depth0[z,2] + tmp[z+1,2]
val <- tmp[z,1] + array_depth0[z,2]
tmp <- tmp[(z+1)*-1,]
if(nrow(tmp) <= z) {
break
}
}
}
}
# map2: for each element of the data the maximum depth
array_depth <- rep(1, length(inside_array)/2)
for(z in 1:nrow(array_depth0)){
pos <- (array_depth0[z,1]+1) : (array_depth0[z,1] + array_depth0[z,2])
array_depth[pos] <- array_depth[pos] + 1
}
# add to map1: the array depth for each sub-array
array_depth0 <- cbind(array_depth0, NA)
for(z in 1:nrow(array_depth0)){
pos <- (array_depth0[z,1]+1) : (array_depth0[z,1] + array_depth0[z,2])
array_depth0[z,3] <- min(array_depth[pos])
}
# create map3: elements of array
out <- NULL
for(z in 1:nrow(array_depth0)){
a_memb <- rep(F, length(array_depth))
a_memb[(array_depth0[z,1] + 1) : (array_depth0[z,1] + array_depth0[z,2])] <- T
out <- cbind(out, a_memb)
}
a_memb <- out
# some uggly fix in map1 and map3: add the whole array
a_memb <- cbind(a_memb, T)
array_depth0 <- rbind(array_depth0, c(1,length(value),1))
} else {
a_memb <- matrix(T, ncol=1, nrow=length(key))
array_depth0 <- matrix(c(1,length(key),1), nrow=1)
}
# build ####
# mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
# for the deppest array
# need prepare for the main loop
deppest <- which(max(array_depth0[,3])==array_depth0[,3])
anchor_tmp <- array_depth0[deppest,1]
content_tmp <- list()
for(y in 1:ncol(as.matrix(a_memb[,deppest]))){
pos <- which(as.matrix(a_memb[,deppest])[,y])
all_content <- as.list(value[pos])
content_tmp[[y]] <- setNames(all_content, key[pos])
}
content_tmp2 <- list()
if(max(array_depth0[,3]) > 1){
# construct the list from the deppest array level
for(y in (max(array_depth0[,3]) - 1 ) : 1){
deppest <- which(y==array_depth0[,3])
content_tmp2 <- list()
x=1
for(x in 1:ncol(as.matrix(a_memb[,deppest]))){
pos <- which(as.matrix(a_memb[,deppest])[,x])
all_content <- as.list(value[pos])
if(any(is.na(all_content))){
pos <- which(array_depth == y & as.matrix(a_memb[,deppest])[,x])
all_content <- as.list(value[pos])
for(z in 1:sum(is.na(all_content))){
pos_a <- pos[is.na(all_content)][1]
cot <- content_tmp[[which(anchor_tmp==pos_a)]]
pos_b <- which(is.na(all_content))[1]
all_content[[pos_b]] <- cot
}
}
content_tmp2[[x]] <- setNames(all_content, key[pos])
}
content_tmp <- content_tmp2
anchor_tmp <- array_depth0[deppest,1]
}
} else {
content_tmp2 <- content_tmp
}
return(content_tmp2[[1]])
}
