Как читать PHP Serialize() данные в R

Question

Я подключения к базе данных MySQL с помощью R и некоторые данные о том, что база данных выглядит следующим образом:

a:1:{s:17:\"last_cart_refresh\";i:1470188219;} 

Я понимаю, что это PHP сериализованная данных с использованием функции PHP serialize(). Есть ли способ в пределах R (нативный или с пакетом), чтобы понять эти данные?

EDIT: добавлено уточнение, что я хочу, чтобы в R, а не PHP, можно было читать данные.

Answer 1

Чтобы использовать PHP сериализованных данных в R, вы можете использовать эту функцию:

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)) 
} 

Функция возвращает матрицу с ключом, и значением, портретируемого, PHP-массив.

string <- 'a:1:{s:17:\"last_cart_refresh\";s:17:\"last_cart_refresh\";}' 
php_unserialize(string) 

Если ваш массив php содержит другие массивы или даже вложенные массивы, используйте эту более сложную функцию. В результате, чем 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]]) 
}