emacs/external/ljupdate/lj-acct.el

   1 ;;; lj-acct.el --- LiveJournal account handling code for ljupdate
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor <ted@oconnor.cx>
   4
   5 ;; Author: Edward O'Connor <ted@oconnor.cx>
   6 ;; Keywords: convenience
   7
   8 ;; This file is part of ljupdate, a LiveJournal client for Emacs.
   9
  10 ;; ljupdate is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or
  13 ;; {at your option} any later version.
  14
  15 ;; ljupdate is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING, or type `C-h C-c'. If
  22 ;; not, write to the Free Software Foundation at this address:
  23
  24 ;;   Free Software Foundation
  25 ;;   51 Franklin Street, Fifth Floor
  26 ;;   Boston, MA 02110-1301
  27 ;;   USA
  28
  29 ;;; Commentary:
  30 ;;
  31
  32 ;;; History:
  33 ;;
  34
  35 ;;; Code:
  36
  37 (require 'lj-custom)
  38
  39 ;; backing store
  40
  41 (defvar lj-acct-hash nil
  42   "Hash in which internal account information is stored.")
  43
  44 (defun lj-make-acct-hash ()
  45   "Create a new value for variable `lj-acct-hash'."
  46   (make-hash-table :test 'equal))
  47
  48 (defun lj-acct-hash ()
  49   "Return the hash table in which internal account information is stored.
  50 Will attempt to load our cached configuration if it is available."
  51   (when (null lj-acct-hash)
  52     (lj-cache-load))
  53   (or lj-acct-hash
  54       (setq lj-acct-hash (lj-make-acct-hash))))
  55
  56 ;; sever/user property getters/setters
  57
  58 (defun lj-servers ()
  59   "Return a list of LiveJournal servers that we know about."
  60   (let ((servers '()))
  61     (maphash (lambda (server server-hash)
  62                (push server servers))
  63              (lj-acct-hash))
  64     (nreverse servers)))
  65
  66 (defun lj-server-get (server property)
  67   "Fetch the value of SERVER's PROPERTY."
  68   (let ((server-hash (gethash server (lj-acct-hash))))
  69     (when server-hash
  70       (gethash property server-hash))))
  71
  72 (defun lj-users (server)
  73   "Return a list of users on SERVER whose accounts we can use."
  74   (let ((server-hash (gethash server (lj-acct-hash)))
  75         (users '()))
  76     (when server-hash
  77       (maphash (lambda (user user-hash)
  78                  (when (and (stringp user)
  79                             (hash-table-p user-hash))
  80                    (push user users)))
  81                server-hash)
  82       users)))
  83
  84 (defun lj-server-put (server property value)
  85   "Set SERVER' value of PROPERTY to VALUE."
  86   (let ((server-hash (gethash server (lj-acct-hash))))
  87     (unless server-hash
  88       (setq server-hash (make-hash-table :test 'equal))
  89       (puthash server server-hash (lj-acct-hash)))
  90     (puthash property value server-hash)))
  91
  92 (defun lj-server-rem (server property)
  93   "Remove SERVER's PROPERTY."
  94   (let ((server-hash (gethash server (lj-acct-hash))))
  95     (when server-hash
  96       (remhash property server-hash))))
  97
  98 (defun lj-user-get (server username property)
  99   "Fetch SERVER's value of USERNAME's PROPERTY."
 100   (let ((user-hash (lj-server-get server username)))
 101     (when user-hash
 102       (gethash property user-hash))))
 103
 104 (defun lj-user-put (server username property value)
 105   "Set SERVER's value of USERNAME's PROPERTY to VALUE."
 106   (let ((user-hash (lj-server-get server username)))
 107     (unless user-hash
 108       (setq user-hash (make-hash-table :test 'equal))
 109       (lj-server-put server username user-hash))
 110     (puthash property value user-hash)))
 111
 112 (defun lj-user-rem (server username property)
 113   "Remove SERVER's USERNAME's PROPERTY."
 114   (let ((user-hash (lj-server-get server username)))
 115     (when user-hash
 116       (remhash property user-hash))))
 117
 118 ;; serialization / deserialization routines
 119
 120 (defun lj-hash-from-alist (alist)
 121   "Return a new hash table with the same mappings as in ALIST."
 122   (let ((hash (make-hash-table :test 'equal)))
 123     (mapcar (lambda (element)
 124               (puthash (car element) (cdr element) hash))
 125             alist)
 126     hash))
 127
 128 (defun lj-alist-from-hash (hash)
 129   "Return a new alist with the same mapping as in HASH."
 130   (let ((alist '()))
 131     (maphash (lambda (k v)
 132                (push (cons k v) alist))
 133              hash)
 134     alist))
 135
 136 ;; loading and saving cache
 137
 138 (defun lj-cache-file (&optional filename)
 139   "Return the absolute path to FILENAME.
 140 If FILENAME is nil, returns the absolute path to the file named
 141 \"cache\" in `lj-cache-dir'."
 142   (if filename
 143       (expand-file-name filename)
 144     (expand-file-name "cache" lj-cache-dir)))
 145
 146 (defun lj-cache-load (&optional filename)
 147   "Load server and user information out of cache FILENAME.
 148 We use our default cache location if FILENAME is nil."
 149   (setq filename (lj-cache-file filename))
 150   (when (file-readable-p filename)
 151     (with-temp-buffer
 152       (insert-file-contents filename)
 153       (eval-buffer))))
 154
 155 (defvar lj-cache-format 1
 156   "Version of the cache file format.")
 157
 158 (defun lj-cache-save-forms ()
 159   "Return Lisp forms which would restore this ljupdate config if evalled."
 160   (let ((forms '()))
 161     (push '(setq lj-cache-format 1) forms)
 162     (push '(setq lj-acct-hash (lj-make-acct-hash)) forms)
 163     (maphash (lambda (server server-hash)
 164                (push `(lj-server-put ,server :mood-max
 165                                      ,(or (lj-server-get server :mood-max)
 166                                           "0"))
 167                      forms)
 168                (push `(lj-server-put ,server :moods
 169                                      ',(lj-server-get server :moods))
 170                      forms)
 171                (maphash (lambda (username user-hash)
 172                           (when (stringp username)
 173                             ;; handle users
 174                             (mapc (lambda (field)
 175                                     (let ((val (lj-user-get server username field)))
 176                                       (when val
 177                                         (push `(lj-user-put
 178                                                 ,server ,username ,field
 179                                                 ;; Conservatively quoting everything
 180                                                 ',val)
 181                                               forms))))
 182                                   '(:name :access :pics :friends-groups))
 183                             (let ((pass (lj-user-get server username :password)))
 184                               (when (and pass lj-cache-login-information)
 185                                 (push `(lj-user-put
 186                                         ,server ,username :password
 187                                         ,pass)
 188                                       forms)))))
 189                         server-hash))
 190              (lj-acct-hash))
 191     (nreverse forms)))
 192
 193 (defun lj-make-directory (directory &optional parents modes)
 194   "Create DIRECTORY.
 195 If PARENTS is non-null, create any parent directories as necessary.
 196 If MODES is null, 0700 are used."
 197   (let ((umask (default-file-modes)))
 198     (unwind-protect
 199         (progn
 200           (set-default-file-modes (or modes ?\700))
 201           (make-directory directory parents))
 202       (set-default-file-modes umask))))
 203
 204 (defun lj-cache-save (&optional filename)
 205   "Save server and user information out to cache FILENAME.
 206 We use our default cache location if FILENAME is nil."
 207   (setq filename (lj-cache-file filename))
 208   (let ((dir (file-name-directory filename)))
 209     (unless (file-exists-p dir)
 210       (lj-make-directory dir t))
 211     (unless (file-directory-p dir)
 212       (error "File `%s' is not a directory" dir)))
 213   (unless (file-writable-p filename)
 214     (error "Unable to write to `%s'" filename))
 215   (find-file filename nil)
 216   (delete-region (point-min) (point-max))
 217   (insert ";; -*- emacs-lisp -*-\n"
 218           ";; ljupdate configuration cache file\n")
 219   (let ((standard-output (current-buffer)))
 220     (mapc (lambda (form)
 221             (prin1 form)
 222             (terpri))
 223           (lj-cache-save-forms)))
 224   (save-buffer)
 225   (kill-buffer (current-buffer)))
 226
 227 (add-hook 'kill-emacs-hook 'lj-cache-save)
 228
 229 (provide 'lj-acct)
 230 ;;; lj-acct.el ends here