Re: Simple example program to illustrate Goops

[Neil Jerram <neil at ossau dot uklinux dot net>]

Julien Rousseau writes:

   Hi everyone,

   I read (quite all) the GOOPS tutorial yesterday and
   was wondering where I could find a program using it
   that would be simple enough for a newbie to grasp it
   (that is not to big, nor using obscure features of
   Goops) but complete enough to illustrate its use.

   If there is no such program (yet) I may take the time
   (although not before at least next week) to make such
   one when I understand Goops better and if people are
   interested/can give me some clue about what it should
   cover.

Take a look at the following.  It's undocumented, sadly, but it does
at least demonstrate
- defining a class
- defining methods for that class
- use of slot accessors.

Does this help you at all?

     Neil

---------------------------------
(define-module (ice-9 db file scm-alist)
  :use-module (ice-9 filesys)
  :use-module (oop goops))

(define-class <db-file-scm-alist> ()
  (f #:init-value #f  #:accessor db-file-name)
  (p #:init-value #f  #:accessor db-port)
  (m #:init-value #f  #:accessor db-modified?)
  (c #:init-value '() #:accessor db-cache))

(define-method db-open ((db <db-file-scm-alist>) file-name)
  (if (db-file-name db)
      (error "Database already open for file:" (db-file-name db)))
  (set! (db-port db)
        (if (file-exists? file-name)
            (open-input-file file-name)
            #f))
  (set! (db-file-name db) file-name))

(define-method db-close ((db <db-file-scm-alist>))
  (if (db-file-name db)
      (begin
        (if (db-port db)
            (begin
              (close-input-port (db-port db))
              (set! (db-port db) #f)))
        (if (db-modified? db)
            (begin
              (mkpath (db-file-name db))
              (let ((p (open-output-file (db-file-name db))))
                (with-output-to-port p
                  (lambda ()
                    (map (lambda (entry)
                           (write entry)
                           (newline))
                         (db-cache db))))
                (close-output-port p))
              (set! (db-modified? db) #f)))
        (set! (db-cache db) '())
        (set! (db-file-name db) #f))))

(define-method db-sync ((db <db-file-scm-alist>))
  (if (not (db-file-name db))
      (error "Database is not open!"))
  (let ((file-name (db-file-name db)))
    (db-close db)
    (db-open db file-name)))

(define-method db-read-next ((db <db-file-scm-alist>))
  (let ((p (db-port db)))
    (if p
        (let ((next-entry (with-input-from-port p read)))
          (cond
           ((eof-object? next-entry) #f)
           ((pair? next-entry)
            (set! (db-cache db)
                  (append (db-cache db) (list next-entry)))
            next-entry)
           (else (error "Corrupt database entry!"))))
        #f)))

(define-method db-keys ((db <db-file-scm-alist>))
  (if (not (db-file-name db))
      (error "Database is not open!"))
  (let loop ((keys (map car (db-cache db)))
             (next-entry (db-read-next db)))
    (if (not next-entry)
        keys
        (loop (append keys (list (car next-entry)))
              (db-read-next db)))))

(define-method db-ref ((db <db-file-scm-alist>) key)
  (if (not (db-file-name db))
      (error "Database is not open!"))
  (or (assoc-ref (db-cache db) key)
      (let loop ((next-entry (db-read-next db)))
        (if (not next-entry)
            #f
            (if (equal? (car next-entry) key)
                (cdr next-entry)
                (loop (db-read-next db)))))))

(define-method db-set! ((db <db-file-scm-alist>) key value)
  (if (not (db-file-name db))
      (error "Database is not open!"))
  (db-keys db)
  (set! (db-cache db)
        (assoc-set! (db-cache db) key value))
  (set! (db-modified? db) #t))

(export <db-file-scm-alist>
        db-open
        db-close
        db-sync
        db-keys
        db-ref
        db-set!)
---------------------------------