Paste: example expansion

Author:	Peter Stirling
Mode:	lisp
Date:	Sat, 17 Sep 2011 15:29:29

Plain Text |

Delete Paste

(PROGN
 (DEFCLASS DB-QUERY-PLAYLIST (PLAYLIST)
           ((QUERY-SQL :INITARG :QUERY-SQL :ACCESSOR
             DB-QUERY-PLAYLIST-QUERY-SQL)
            (ARGS :INITFORM NIL :ACCESSOR DB-QUERY-PLAYLIST-ARGS)))
 (LET ((TYPE-INSTANCE
        (OR (GETHASH 'DB-QUERY-PLAYLISTS *PLAYLIST-TYPE-MAP*)
            (SETF (GETHASH 'DB-QUERY-PLAYLISTS *PLAYLIST-TYPE-MAP*)
                    (MAKE-INSTANCE 'PLAYLIST-TYPE :NAME
                                   "DB-QUERY-PLAYLISTS")))))
   (SETF (PLAYLIST-TYPE-LOAD-FUNC TYPE-INSTANCE)
           (LAMBDA (DB NAME ID VISIBLE)
             (DECLARE (IGNORABLE DB))
             (LET ((INSTANCE
                    (MULTIPLE-VALUE-BIND (QUERY-SQL)
                        (SQLITE:EXECUTE-ONE-ROW-M-V DB
                                                    "SELECT query_sql FROM db_query_playlists WHERE id = ?"
                                                    ID)
                      (MAKE-INSTANCE 'DB-QUERY-PLAYLIST :ID ID :NAME NAME
                                     :VISIBLE VISIBLE :QUERY-SQL QUERY-SQL))))
               (SETF (DB-QUERY-PLAYLIST-ARGS INSTANCE)
                       (SQLITE-EXECUTE-TO-FLAT-LIST DB
                                                    "SELECT value FROM db_query_playlist_arg_entries WHERE id = ? ORDER BY value_index"
                                                    (PLAYLIST-ID INSTANCE)))
               INSTANCE)))
   (DEFMETHOD SAVE-PLAYLIST (DB (INSTANCE DB-QUERY-PLAYLIST))
     (LET ((ID (PLAYLIST-ID INSTANCE)))
       (IF ID
           (PROGN
            (UPDATE-PLAYLISTS DB ID :PLAYLIST-NAME (PLAYLIST-NAME INSTANCE)
                              :VISIBLE (PLAYLIST-VISIBLE INSTANCE))
            (UPDATE-DB-QUERY-PLAYLISTS DB ID QUERY-SQL
                                       (DB-QUERY-PLAYLIST-QUERY-SQL INSTANCE)))
           (PROGN
            (SETF ID
                    (INSERT-PLAYLISTS DB (PLAYLIST-NAME INSTANCE)
                                      (PLAYLIST-ID-FOR-TYPE DB TYPE-INSTANCE)
                                      (PLAYLIST-VISIBLE INSTANCE)))
            (SETF (PLAYLIST-ID INSTANCE) ID)
            (INSERT-DB-QUERY-PLAYLISTS DB ID
                                       (DB-QUERY-PLAYLIST-QUERY-SQL
                                        INSTANCE))))
       (PROGN
        (SQLITE:EXECUTE-NON-QUERY DB
                                  "DELETE FROM db_query_playlist_arg_entries WHERE id = ?"
                                  ID)
        (LET ((I 0))
          (DOLIST (VAL (DB-QUERY-PLAYLIST-ARGS INSTANCE) NIL)
            (INSERT-DB-QUERY-PLAYLIST-ARG-ENTRIES DB ID I VAL)
            (INCF I))))))
   (PROGN
    (DEFPARAMETER +CREATE-DB-QUERY-PLAYLISTS-SQL+
      "CREATE TABLE db_query_playlists (
       id INTEGER REFERENCES playlists ( id ) ON DELETE CASCADE NOT NULL,
      query_sql TEXT NOT NULL,
      PRIMARY KEY ( id )
   )")
    (DEFUN CREATE-DB-QUERY-PLAYLISTS-TABLE (PJS-SQLITE::DB PJS-SQLITE::RECURSIVE)
      (WHEN (MEMBER 'DB-QUERY-PLAYLISTS PJS-SQLITE::RECURSIVE)
        (ERROR "table reference loop ~a" PJS-SQLITE::RECURSIVE))
      (PUSH 'DB-QUERY-PLAYLISTS PJS-SQLITE::RECURSIVE)
      (LET (PJS-SQLITE::DEP-CHANGED)
        (DOLIST (PJS-SQLITE::TABLE '(PLAYLISTS))
          (SETF PJS-SQLITE::DEP-CHANGED
                  (OR PJS-SQLITE::DEP-CHANGED
                      (FUNCALL
                       (GETHASH PJS-SQLITE::TABLE PJS-SQLITE::*SQLITE-TABLES*)
                       PJS-SQLITE::DB PJS-SQLITE::RECURSIVE))))
        (LET* ((PJS-SQLITE::TABLE-SCHEMA
                (SQLITE:EXECUTE-SINGLE PJS-SQLITE::DB
                                       "SELECT sql FROM sqlite_master WHERE type = 'table' AND tbl_name = 'db_query_playlists'"))
               (PJS-SQLITE::NEED-TO-MIGRATE
                (AND PJS-SQLITE::TABLE-SCHEMA
                     (STRING/= PJS-SQLITE::TABLE-SCHEMA
                               +CREATE-DB-QUERY-PLAYLISTS-SQL+))))
          (WHEN
              (OR (NOT PJS-SQLITE::TABLE-SCHEMA) PJS-SQLITE::NEED-TO-MIGRATE
                  PJS-SQLITE::DEP-CHANGED)
            (WITH-RECURSIVE-TRANSACTION PJS-SQLITE::DB
              (WHEN PJS-SQLITE::NEED-TO-MIGRATE
                (FORMAT T
                        "TABLE SQL FOR 'db_query_playlists' DIFFERS, ATTEMPTING MIGRATION~%"))
              (WHEN PJS-SQLITE::TABLE-SCHEMA
                (FORMAT T "Old schema was: ~w~%New schema is: ~w~%"
                        PJS-SQLITE::TABLE-SCHEMA +CREATE-DB-QUERY-PLAYLISTS-SQL+)
                (LET* ((#:G1379 PJS-SQLITE::DB)
                       (#:G1378 (SQLITE:EXECUTE-SINGLE #:G1379 "PRAGMA foreign_keys")))
                  (UNWIND-PROTECT
                      (PROGN
                       (SQLITE:EXECUTE-NON-QUERY #:G1379 "PRAGMA foreign_keys=0")
                       (SQLITE:EXECUTE-NON-QUERY PJS-SQLITE::DB
                                                 "ALTER TABLE db_query_playlists RENAME TO db_query_playlists_temp"))
                    (SQLITE:EXECUTE-NON-QUERY #:G1379
                                              (FORMAT NIL "PRAGMA foreign_keys=~w" #:G1378)))))
              (SQLITE:EXECUTE-NON-QUERY PJS-SQLITE::DB
                                        +CREATE-DB-QUERY-PLAYLISTS-SQL+)
              (PJS-SQLITE::CREATE-INDEX-HELPER PJS-SQLITE::DB "db_query_playlists_id_index"
                                               "CREATE INDEX db_query_playlists_id_index ON db_query_playlists ( id )")
              (WHEN PJS-SQLITE::TABLE-SCHEMA
                (IF (PJS-SQLITE::MIGRATE-TABLE-DATA PJS-SQLITE::DB
                                                    "db_query_playlists_temp"
                                                    "db_query_playlists")
                    (PROGN
                     (WHEN PJS-SQLITE::NEED-TO-MIGRATE
                       (LOG-MESSAGE 'PJS-SQLITE::MESSAGE
                                    "AUTOMATED MIGRATION SUCCEEDED, APPARENTLY~%")
                       (SQLITE:EXECUTE-NON-QUERY PJS-SQLITE::DB
                                                 "DROP TABLE db_query_playlists_temp")))
                    (PROGN
                     (LOG-MESSAGE 'ERROR
                                  "AUTOMATED MIGRATION FAILED, HERE BE DRAGONS!~%")
                     (ERROR "can't migrate table db_query_playlists")))
                T))))))
    (EVAL-WHEN (:LOAD-TOPLEVEL)
      (SETF (GETHASH 'DB-QUERY-PLAYLISTS PJS-SQLITE::*SQLITE-TABLES*)
              #'CREATE-DB-QUERY-PLAYLISTS-TABLE)
      (SETF (GETHASH 'DB-QUERY-PLAYLISTS PJS-SQLITE::*SQLITE-TABLE-DEPENDENCIES*)
              '(PLAYLISTS)))
    (DEFUN INSERT-DB-QUERY-PLAYLISTS (PJS-SQLITE::DB ID QUERY-SQL &KEY)
      (LET ((PJS-SQLITE::STMT
             (SQLITE:PREPARE-STATEMENT PJS-SQLITE::DB
                                       (SCONC* "INSERT INTO db_query_playlists ( "
                                               (JOIN* PJS-SQLITE::+SEPARATOR-STRING+
                                                      "id,
            query_sql")
                                               " ) VALUES ( " (JOIN* "," "?,?")
                                               " )"))))
        (UNWIND-PROTECT
            (PROGN
             (IF ID
                 (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT 1 ID)
                 (ERROR "Missing value for not-null column db_query_playlists.id"))
             (IF QUERY-SQL
                 (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT 2 QUERY-SQL)
                 (ERROR
                  "Missing value for not-null column db_query_playlists.query_sql"))
             NIL
             (SQLITE:STEP-STATEMENT PJS-SQLITE::STMT)
             (SQLITE:RESET-STATEMENT PJS-SQLITE::STMT)
             (SQLITE:LAST-INSERT-ROWID PJS-SQLITE::DB))
          (SQLITE:FINALIZE-STATEMENT PJS-SQLITE::STMT))))
    (DEFUN UPDATE-DB-QUERY-PLAYLISTS
           (PJS-SQLITE::DB ID &KEY (QUERY-SQL NIL QUERY-SQL-P))
      (LET ((PJS-SQLITE::STMT
             (SQLITE:PREPARE-STATEMENT PJS-SQLITE::DB
                                       (SCONC "UPDATE db_query_playlists SET "
                                              (OR
                                               (IF QUERY-SQL-P
                                                   (PROGN "query_sql = ?")
                                                   NIL)
                                               "")
                                              " WHERE " "id = ?"))))
        (UNWIND-PROTECT
            (PROGN
             (LET ((PJS-SQLITE::INDEX 1))
               (WHEN QUERY-SQL-P
                 (IF QUERY-SQL
                     (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT (1++ PJS-SQLITE::INDEX)
                                            QUERY-SQL)
                     (ERROR
                      "Missing value for not-null column db_query_playlists.query_sql")))
               (IF ID
                   (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT (1++ PJS-SQLITE::INDEX)
                                          ID)
                   (ERROR "Missing value for not-null column db_query_playlists.id"))
               (SQLITE:STEP-STATEMENT PJS-SQLITE::STMT)))
          (SQLITE:FINALIZE-STATEMENT PJS-SQLITE::STMT))))
    (DEFUN DELETE-DB-QUERY-PLAYLISTS (PJS-SQLITE::DB ID)
      (LET ((PJS-SQLITE::STMT
             (SQLITE:PREPARE-STATEMENT PJS-SQLITE::DB
                                       "DELETE FROM db_query_playlists WHERE id = ?")))
        (UNWIND-PROTECT
            (PROGN
             (LET ((PJS-SQLITE::INDEX 0))
               (IF ID
                   (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT (INCF PJS-SQLITE::INDEX)
                                          ID)
                   (ERROR "missing value for not-null column db_query_playlists.id"))
               (SQLITE:STEP-STATEMENT PJS-SQLITE::STMT)))
          (SQLITE:FINALIZE-STATEMENT PJS-SQLITE::STMT)))))
   (PROGN
    (DEFPARAMETER +CREATE-DB-QUERY-PLAYLIST-ARG-ENTRIES-SQL+
      "CREATE TABLE db_query_playlist_arg_entries (
       id INTEGER REFERENCES playlists ( id ) ON DELETE CASCADE NOT NULL,
      value_index INTEGER NOT NULL,
      value TEXT NOT NULL,
      PRIMARY KEY ( id, value_index )
   )")
    (DEFUN CREATE-DB-QUERY-PLAYLIST-ARG-ENTRIES-TABLE
           (PJS-SQLITE::DB PJS-SQLITE::RECURSIVE)
      (WHEN (MEMBER 'DB-QUERY-PLAYLIST-ARG-ENTRIES PJS-SQLITE::RECURSIVE)
        (ERROR "table reference loop ~a" PJS-SQLITE::RECURSIVE))
      (PUSH 'DB-QUERY-PLAYLIST-ARG-ENTRIES PJS-SQLITE::RECURSIVE)
      (LET (PJS-SQLITE::DEP-CHANGED)
        (DOLIST (PJS-SQLITE::TABLE '(PLAYLISTS))
          (SETF PJS-SQLITE::DEP-CHANGED
                  (OR PJS-SQLITE::DEP-CHANGED
                      (FUNCALL
                       (GETHASH PJS-SQLITE::TABLE PJS-SQLITE::*SQLITE-TABLES*)
                       PJS-SQLITE::DB PJS-SQLITE::RECURSIVE))))
        (LET* ((PJS-SQLITE::TABLE-SCHEMA
                (SQLITE:EXECUTE-SINGLE PJS-SQLITE::DB
                                       "SELECT sql FROM sqlite_master WHERE type = 'table' AND tbl_name = 'db_query_playlist_arg_entries'"))
               (PJS-SQLITE::NEED-TO-MIGRATE
                (AND PJS-SQLITE::TABLE-SCHEMA
                     (STRING/= PJS-SQLITE::TABLE-SCHEMA
                               +CREATE-DB-QUERY-PLAYLIST-ARG-ENTRIES-SQL+))))
          (WHEN
              (OR (NOT PJS-SQLITE::TABLE-SCHEMA) PJS-SQLITE::NEED-TO-MIGRATE
                  PJS-SQLITE::DEP-CHANGED)
            (WITH-RECURSIVE-TRANSACTION PJS-SQLITE::DB
              (WHEN PJS-SQLITE::NEED-TO-MIGRATE
                (FORMAT T
                        "TABLE SQL FOR 'db_query_playlist_arg_entries' DIFFERS, ATTEMPTING MIGRATION~%"))
              (WHEN PJS-SQLITE::TABLE-SCHEMA
                (FORMAT T "Old schema was: ~w~%New schema is: ~w~%"
                        PJS-SQLITE::TABLE-SCHEMA
                        +CREATE-DB-QUERY-PLAYLIST-ARG-ENTRIES-SQL+)
                (LET* ((#:G1381 PJS-SQLITE::DB)
                       (#:G1380 (SQLITE:EXECUTE-SINGLE #:G1381 "PRAGMA foreign_keys")))
                  (UNWIND-PROTECT
                      (PROGN
                       (SQLITE:EXECUTE-NON-QUERY #:G1381 "PRAGMA foreign_keys=0")
                       (SQLITE:EXECUTE-NON-QUERY PJS-SQLITE::DB
                                                 "ALTER TABLE db_query_playlist_arg_entries RENAME TO db_query_playlist_arg_entries_temp"))
                    (SQLITE:EXECUTE-NON-QUERY #:G1381
                                              (FORMAT NIL "PRAGMA foreign_keys=~w" #:G1380)))))
              (SQLITE:EXECUTE-NON-QUERY PJS-SQLITE::DB
                                        +CREATE-DB-QUERY-PLAYLIST-ARG-ENTRIES-SQL+)
              (PJS-SQLITE::CREATE-INDEX-HELPER PJS-SQLITE::DB
                                               "db_query_playlist_arg_entries_id_index"
                                               "CREATE INDEX db_query_playlist_arg_entries_id_index ON db_query_playlist_arg_entries ( id )")
              (WHEN PJS-SQLITE::TABLE-SCHEMA
                (IF (PJS-SQLITE::MIGRATE-TABLE-DATA PJS-SQLITE::DB
                                                    "db_query_playlist_arg_entries_temp"
                                                    "db_query_playlist_arg_entries")
                    (PROGN
                     (WHEN PJS-SQLITE::NEED-TO-MIGRATE
                       (LOG-MESSAGE 'PJS-SQLITE::MESSAGE
                                    "AUTOMATED MIGRATION SUCCEEDED, APPARENTLY~%")
                       (SQLITE:EXECUTE-NON-QUERY PJS-SQLITE::DB
                                                 "DROP TABLE db_query_playlist_arg_entries_temp")))
                    (PROGN
                     (LOG-MESSAGE 'ERROR
                                  "AUTOMATED MIGRATION FAILED, HERE BE DRAGONS!~%")
                     (ERROR "can't migrate table db_query_playlist_arg_entries")))
                T))))))
    (EVAL-WHEN (:LOAD-TOPLEVEL)
      (SETF (GETHASH 'DB-QUERY-PLAYLIST-ARG-ENTRIES PJS-SQLITE::*SQLITE-TABLES*)
              #'CREATE-DB-QUERY-PLAYLIST-ARG-ENTRIES-TABLE)
      (SETF (GETHASH 'DB-QUERY-PLAYLIST-ARG-ENTRIES
                     PJS-SQLITE::*SQLITE-TABLE-DEPENDENCIES*)
              '(PLAYLISTS)))
    (DEFUN INSERT-DB-QUERY-PLAYLIST-ARG-ENTRIES
           (PJS-SQLITE::DB ID VALUE-INDEX VALUE &KEY)
      (LET ((PJS-SQLITE::STMT
             (SQLITE:PREPARE-STATEMENT PJS-SQLITE::DB
                                       "INSERT INTO db_query_playlist_arg_entries ( id,
                                                   value_index,
                                                   value ) VALUES ( ?,?,? )")))
        (UNWIND-PROTECT
            (PROGN
             (IF ID
                 (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT 1 ID)
                 (ERROR
                  "Missing value for not-null column db_query_playlist_arg_entries.id"))
             (IF VALUE-INDEX
                 (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT 2 VALUE-INDEX)
                 (ERROR
                  "Missing value for not-null column db_query_playlist_arg_entries.value_index"))
             (IF VALUE
                 (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT 3 VALUE)
                 (ERROR
                  "Missing value for not-null column db_query_playlist_arg_entries.value"))
             NIL
             (SQLITE:STEP-STATEMENT PJS-SQLITE::STMT)
             (SQLITE:RESET-STATEMENT PJS-SQLITE::STMT)
             (SQLITE:LAST-INSERT-ROWID PJS-SQLITE::DB))
          (SQLITE:FINALIZE-STATEMENT PJS-SQLITE::STMT))))
    (DEFUN UPDATE-DB-QUERY-PLAYLIST-ARG-ENTRIES
           (PJS-SQLITE::DB ID VALUE-INDEX &KEY (VALUE NIL VALUE-P))
      (LET ((PJS-SQLITE::STMT
             (SQLITE:PREPARE-STATEMENT PJS-SQLITE::DB
                                       (SCONC
                                        "UPDATE db_query_playlist_arg_entries SET "
                                        (OR
                                         (IF VALUE-P
                                             (PROGN "value = ?")
                                             NIL)
                                         "")
                                        " WHERE "
                                        "id = ? AND value_index = ?"))))
        (UNWIND-PROTECT
            (PROGN
             (LET ((PJS-SQLITE::INDEX 1))
               (WHEN VALUE-P
                 (IF VALUE
                     (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT (1++ PJS-SQLITE::INDEX)
                                            VALUE)
                     (ERROR
                      "Missing value for not-null column db_query_playlist_arg_entries.value")))
               (IF ID
                   (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT (1++ PJS-SQLITE::INDEX)
                                          ID)
                   (ERROR
                    "Missing value for not-null column db_query_playlist_arg_entries.id"))
               (IF VALUE-INDEX
                   (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT (1++ PJS-SQLITE::INDEX)
                                          VALUE-INDEX)
                   (ERROR
                    "Missing value for not-null column db_query_playlist_arg_entries.value_index"))
               (SQLITE:STEP-STATEMENT PJS-SQLITE::STMT)))
          (SQLITE:FINALIZE-STATEMENT PJS-SQLITE::STMT))))
    (DEFUN DELETE-DB-QUERY-PLAYLIST-ARG-ENTRIES (PJS-SQLITE::DB ID VALUE-INDEX)
      (LET ((PJS-SQLITE::STMT
             (SQLITE:PREPARE-STATEMENT PJS-SQLITE::DB
                                       "DELETE FROM db_query_playlist_arg_entries WHERE id = ? AND value_index = ?")))
        (UNWIND-PROTECT
            (PROGN
             (LET ((PJS-SQLITE::INDEX 0))
               (IF ID
                   (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT (INCF PJS-SQLITE::INDEX)
                                          ID)
                   (ERROR
                    "missing value for not-null column db_query_playlist_arg_entries.id"))
               (IF VALUE-INDEX
                   (SQLITE:BIND-PARAMETER PJS-SQLITE::STMT (INCF PJS-SQLITE::INDEX)
                                          VALUE-INDEX)
                   (ERROR
                    "missing value for not-null column db_query_playlist_arg_entries.value_index"))
               (SQLITE:STEP-STATEMENT PJS-SQLITE::STMT)))
          (SQLITE:FINALIZE-STATEMENT PJS-SQLITE::STMT)))))))

New Annotation

Summary:
Author:
Mode:	textPostgreSQLPowerCenter Parameter Fileactionscriptadaada95ans-forth94antantlrantlr4apacheconfapdlapplescriptaspaspect-jassembly-agcassembly-agsassembly-arm32assembly-m68kassembly-macro32assembly-mcs51assembly-parrotassembly-r2000assembly-x86avroawkbbatchbbjbcelbeanshellbibtexbinsource-agccc#c++cfscriptchillcilclipsclojurecmakecobolcoffeescriptcoldfusioncplex-lpcsscsvcvs-commitddartdjangodockerfiledotdoxygendrawj2ddsssleiffelembperlerlangfactorfhtmlforthfortranfortran90foxprofreemarkergcbasicgettextgherkingnuplotgogradlegroovygsphaskellhaxehexhl7v2hlslhtaccesshtmlhxmli4glicalendariconidlinforminiinno-setupinterlisiojamonjavajava module-infojavaccjavafxjavascriptjcljedit-actionsjflexjhtmljmkjsonjspkotlinlatexlexlilypondlispliterate-haskelllogslogtalklotosluam4macroschedulermailmakefilemaplemarkdownmavenmavscriptmetapostmlmodula3moinmqscmustache-templatemxmlmyghtymysqln3netrexxnqcnsis2objective-cobjectrexxoccamomnimarkopensipsoutlinepascalpatchperlphppikepl-sqlpl-sql9pl1plaintexplantumlpop11postscriptpovraypowerdynamopowershellprogressprologpropertiesprotobufpspptlpurepvwavepyrexpythonqdocrakefilercprdrebolredcoderelax-ng-compactrenderman-ribrestrfcrhtmlroffrpm-specrtfrubyrustrviews#s+sassbtscalaschemesdl/prsgmlshellscriptshtmlsipsippslateslaxsmalltalksmartysmi-mibsparqlsql-loadersqrsquidconfstatasvn-commitswiftswigtcltemplate-toolkittextexinfotldtransact-sqltsptwikityposcripturluscriptvalavbscriptvelocityverilogvhdlvisualbasicvrml2wellknowntextxmlxqxslyabyamlzpt
Body:

Done