navi2ch-be2ch.el

   1 ;;; navi2ch-be2ch.el --- View be@2ch module for Navi2ch. -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 2005, 2008 by Navi2ch Project
   4
   5 ;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
   6 ;; Keywords: network, 2ch
   7
   8 ;; This file is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; This file is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;
  26
  27 ;;; Code:
  28 (provide 'navi2ch-be2ch)
  29
  30 (eval-when-compile
  31   (require 'cl-lib)
  32   (require 'navi2ch-decls)
  33   (require 'navi2ch-inline))
  34
  35 (require 'navi2ch-vars)
  36 (require 'navi2ch-vars)
  37
  38 (defconst navi2ch-be2ch-ident
  39   "$Id$")
  40 (defconst navi2ch-be2ch-coding-system 'euc-jp)
  41 (defconst navi2ch-be2ch-cookie-names '("MDMD" "DMDM"))
  42 (defconst navi2ch-be2ch-cookie-domain '2ch.net)
  43 (defconst navi2ch-be2ch-cookie-path '/)
  44
  45 (defvar navi2ch-be2ch-login-url "http://be.2ch.net/test/login.php")
  46
  47 (defvar navi2ch-be2ch-mail-address nil)
  48 (defvar navi2ch-be2ch-password nil)
  49
  50 (defvar navi2ch-be2ch-login-flag nil)
  51
  52 (defun navi2ch-be2ch-login-p ()
  53   (let ((cookies (navi2ch-net-match-cookies navi2ch-be2ch-login-url)))
  54     (setq navi2ch-be2ch-login-flag
  55           (null (memq nil
  56                       (mapcar (lambda (name) (assoc name cookies))
  57                               navi2ch-be2ch-cookie-names))))))
  58
  59 (defun navi2ch-be2ch-login (mail password)
  60   (interactive
  61    (list
  62     (or navi2ch-be2ch-mail-address
  63         (read-string "mail address: "))
  64     (or navi2ch-be2ch-password
  65         (read-passwd "password: "))))
  66   (navi2ch-be2ch-logout t)
  67   (let ((proc (navi2ch-net-send-request
  68                navi2ch-be2ch-login-url
  69                "POST"
  70                (list
  71                 (cons "Referer" navi2ch-be2ch-login-url)
  72                 (cons "Content-Type" "application/x-www-form-urlencoded"))
  73                (navi2ch-net-get-param-string
  74                 (list
  75                  (cons "m" mail)
  76                  (cons "p" password)
  77                  (cons "submit" "\e$BEPO?\e(B"))
  78                 navi2ch-be2ch-coding-system))))
  79     (navi2ch-net-update-cookies navi2ch-be2ch-login-url
  80                                 proc
  81                                 navi2ch-be2ch-coding-system)
  82     (navi2ch-net-save-cookies)
  83     (when (navi2ch-be2ch-login-p)
  84       (message "Be@2ch \e$B$K%m%0%$%s$7$^$7$?!#\e(B"))))
  85
  86 (defun navi2ch-be2ch-logout (&optional no-msg)
  87   (interactive)
  88   (dolist (name navi2ch-be2ch-cookie-names)
  89     (navi2ch-net-store-cookie (list name "" 0 0)
  90                               navi2ch-be2ch-cookie-domain
  91                               navi2ch-be2ch-cookie-path))
  92   (navi2ch-net-save-cookies)
  93   (setq navi2ch-be2ch-login-flag nil)
  94   (unless no-msg
  95     (message "Be@2ch \e$B$+$i%m%0%"%&%H$7$^$7$?!#\e(B")))
  96
  97 (defun navi2ch-be2ch-toggle-login ()
  98   "Be@2ch \e$B$X$N%m%0%$%s>uBV$r@Z$jBX$($k!#\e(B"
  99   (interactive)
 100   (if navi2ch-be2ch-login-flag
 101       (navi2ch-be2ch-logout)
 102     (call-interactively 'navi2ch-be2ch-login)))
 103
 104 ;;; navi2ch-be2ch.el ends here