Page Menu
Home
Software Heritage
Search
Configure Global Search
Log In
Files
F8393530
import.lisp
No One
Temporary
Actions
Download File
Edit File
Delete File
View Transforms
Subscribe
Mute Notifications
Award Token
Flag For Later
Size
5 KB
Subscribers
None
import.lisp
View Options
(
in-package
#:forgerie-phabricator
)
(
defun
query
(
query
)
(
let*
((
result
(
car
(
cl-mysql:query
query
)))
(
rows
(
car
result
))
(
definitions
(
cadr
result
)))
(
mapcar
(
lambda
(
row
)
(
apply
#'
append
(
mapcar
(
lambda
(
col
def
)
(
list
(
intern
(
string-upcase
(
car
def
))
:keyword
)
col
))
row
definitions
)))
rows
)))
(
defun
initialize
()
(
cl-mysql:connect
:password
*database-password*
)
(
cl-mysql:query
"set names 'utf8'"
))
; This function is only for development mode. While we have emails
; turned off for gitlab, there's a chance that something screwed up will happen
; so we should make it so the aren't real email addresses
(
defun
sanitize-address
(
address
)
(
format
nil
"~A@opentechstrategies.com"
(
cl-ppcre:regex-replace-all
"@"
address
"_"
)))
(
defun
get-emails
(
user-phid
)
(
query
(
format
nil
"select * from phabricator_user.user_email where userphid = '~A'"
user-phid
)))
(
defun
get-user
(
phid
)
(
query
"select username, realName from phabricator_user.user where phid = '~A'"
phid
))
(
defun
get-users
()
(
query
"select username, realName, phid from phabricator_user.user"
))
(
defun
get-project
(
phid
)
(
first
(
query
(
format
nil
"select phid, name, icon from phabricator_project.project where phid = '~A'"
phid
))))
(
defun
get-projects
()
(
query
"select phid, name, icon from phabricator_project.project"
))
(
defun
get-tasks
()
(
mapcar
(
lambda
(
task
)
(
append
(
list
:projects
(
mapcar
(
lambda
(
result
)
(
get-project
(
getf
result
:dst
)))
(
query
(
format
nil
"select dst from phabricator_maniphest.edge where src = '~A' and dst like 'PHID-PROJ%'"
(
getf
task
:phid
)))))
task
))
(
query
"select * from phabricator_maniphest.maniphest_task"
)))
(
defun
get-repositories
()
(
let
((
repositories
(
query
"select phid, repositoryslug, name, localpath from phabricator_repository.repository"
)))
(
mapcar
(
lambda
(
repo
)
(
let
((
associated-projects
(
mapcar
#'
get-project
(
mapcar
(
lambda
(
result
)
(
getf
result
:dst
))
(
query
(
format
nil
"select * from phabricator_repository.edge where src = '~A' and dst like 'PHID-PROJ%'"
(
getf
repo
:phid
)))))))
(
append
(
list
:primary-projects
(
remove-if-not
(
lambda
(
project
)
(
string=
"folder"
(
getf
project
:icon
)))
associated-projects
))
(
list
:projects
associated-projects
)
repo
)))
repositories
)))
(
defun
get-file
(
file-phid
)
(
let*
((
file
(
first
(
query
(
format
nil
"select name, storageEngine, storageFormat, storageHandle from phabricator_file.file where phid = '~A'"
file-phid
)))))
(
append
file
(
list
:data
(
cond
((
and
(
string=
"blob"
(
getf
file
:storageengine
))
(
string=
"raw"
(
getf
file
:storageformat
)))
(
map
'string
#'
code-char
(
getf
(
first
(
query
(
format
nil
"select data from phabricator_file.file_storageblob where id = '~A';"
(
getf
file
:storagehandle
))))
:data
)))
(
t
(
error
"Don't know how to handle files of with engine/format of ~A/~A encounted on ~A"
(
getf
file
:storageengine
)
(
getf
file
:storageformat
)
file-phid
)))))))
(
defun
get-pastes
()
(
remove
nil
(
mapcar
(
lambda
(
paste
)
(
let
; ignore-errors here is due to the nature of the data we're working with,
; and should probably get removed later on
((
file
(
ignore-errors
(
get-file
(
getf
paste
:filephid
)))))
(
when
file
(
append
(
list
:file
file
)
paste
))))
(
query
"select id, title, filePHID from phabricator_paste.paste"
))))
(
defun
convert-repository-to-core
(
repository-def
)
(
forgerie-core:make-vc-repository
:name
(
getf
repository-def
:name
)
:slug
(
getf
repository-def
:repositoryslug
)
:projects
(
mapcar
#'
convert-project-to-core
(
getf
repository-def
:projects
))
:primary-projects
(
mapcar
#'
convert-project-to-core
(
getf
repository-def
:primary-projects
))
:git-location
(
format
nil
"~A~A"
*git-location*
(
car
(
last
(
pathname-directory
(
pathname
(
getf
repository-def
:localpath
))))))))
(
defun
convert-project-to-core
(
project-def
)
(
forgerie-core:make-project
:name
(
getf
project-def
:name
)))
(
defun
convert-email-to-core
(
email-def
)
(
forgerie-core:make-email
:address
(
sanitize-address
(
getf
email-def
:address
))
:is-primary
(
eql
(
getf
email-def
:isprimary
)
1
)))
(
defun
convert-user-to-core
(
user-def
)
(
forgerie-core:make-user
:username
(
getf
user-def
:username
)
:name
(
getf
user-def
:realname
)
:emails
(
mapcar
#'
convert-email-to-core
(
get-emails
(
getf
user-def
:phid
)))))
(
defun
convert-task-to-core
(
task-def
)
(
forgerie-core:make-ticket
:id
(
getf
task-def
:id
)
:title
(
getf
task-def
:title
)
:projects
(
mapcar
#'
convert-project-to-core
(
getf
task-def
:projects
))))
(
defun
convert-file-to-core
(
file-def
)
(
forgerie-core:make-file
:name
(
getf
file-def
:name
)
:data
(
getf
file-def
:data
)))
(
defun
convert-paste-to-core
(
paste-def
)
(
forgerie-core:make-snippet
:id
(
getf
paste-def
:id
)
:title
(
getf
paste-def
:title
)
:files
(
list
(
convert-file-to-core
(
getf
paste-def
:file
)))))
(
defmethod
forgerie-core:import-forge
((
forge
(
eql
:phabricator
)))
(
initialize
)
(
list
:users
(
mapcar
#'
convert-user-to-core
(
get-users
))
:projects
(
mapcar
#'
convert-project-to-core
(
get-projects
))
:vc-repositories
(
mapcar
#'
convert-repository-to-core
(
get-repositories
))
:snippets
(
mapcar
#'
convert-paste-to-core
(
get-pastes
))
:tickets
(
mapcar
#'
convert-task-to-core
(
get-tasks
))))
File Metadata
Details
Attached
Mime Type
text/x-lisp
Expires
Wed, Jun 4, 7:14 PM (6 d, 3 h ago)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
3280500
Attached To
R263 forgerie
Event Timeline
Log In to Comment