php - 如何在 R 中读取 PHP serialize() 数据

Question

我正在通过 R 连接到 MySQL 数据库，数据库中的一些数据如下所示:

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

我的理解是，这是使用 PHP serialize() 函数对 PHP 序列化的数据。 R 中是否有一种方法(原生的或带有包的)来理解这些数据？

编辑:添加了说明，我希望 R 而不是 PHP 能够读取数据。

Answer 1

要在R中使用php序列化数据，可以使用这个函数:

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 数组包含其他数组甚至嵌套数组，请使用这个更复杂的函数。结果不是列表:

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