From f1f8e781aec55e77bf7d3856cdbcf05ee1200fb6 Mon Sep 17 00:00:00 2001
From: Sean O'Rourke <seano@enh.local>
Date: Mon, 7 Jan 2008 18:32:49 -0800
Subject: [PATCH] basic CPAN interface

---
 lib/Sepia/CPAN.pm | 51 ++++++++++++++++++++++++++++++++++++++
 lib/sepia/CPAN.pm | 45 +++++++++++++++++++++++++++++++++
 sepia-cpan.el     | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 170 insertions(+)
 create mode 100644 lib/Sepia/CPAN.pm
 create mode 100644 lib/sepia/CPAN.pm
 create mode 100644 sepia-cpan.el

diff --git a/lib/Sepia/CPAN.pm b/lib/Sepia/CPAN.pm
new file mode 100644
index 0000000..7f15784
--- /dev/null
+++ b/lib/Sepia/CPAN.pm
@@ -0,0 +1,51 @@
+package Sepia::CPAN;
+use CPAN;
+use LWP::Simple;
+
+sub init
+{
+      CPAN::HandleConfig->load;
+      CPAN::Shell::setup_output;
+      CPAN::Index->reload;
+}
+
+sub list
+{
+    grep $_->inst_file, CPAN::Shell->expand('Module', shift || '/./');
+}
+
+sub outdated
+{
+    grep !$_->uptodate, list @_;
+}
+
+## stolen from CPAN::Shell...
+sub readme
+{
+    my $dist = CPAN::Shell->expand('Module', shift);
+    return unless $dist;
+    $dist = $dist->cpan_file;
+    # my ($dist) = $self->id;
+    my ($sans, $suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
+    my ($local_file);
+    my ($local_wanted) = File::Spec->catfile(
+        $CPAN::Config->{keep_source_where}, "authors", "id",
+        split(/\//,"$sans.readme"));
+    $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
+    local (*IN, $/);
+    open IN, $local_wanted;
+    my $ret = <IN>;
+    close IN;
+    $ret;
+}
+
+sub perldoc
+{
+    get($CPAN::Defaultdocs . shift);
+}
+
+sub install
+{
+    my $dist = CPAN::Shell->expand('Module', shift);
+    $dist->install if $dist;
+}
diff --git a/lib/sepia/CPAN.pm b/lib/sepia/CPAN.pm
new file mode 100644
index 0000000..1930590
--- /dev/null
+++ b/lib/sepia/CPAN.pm
@@ -0,0 +1,45 @@
+package Sepia::CPAN;
+use CPAN;
+use LWP::Simple;
+
+sub init
+{
+      CPAN::HandleConfig->load;
+      CPAN::Shell::setup_output;
+      CPAN::Index->reload;
+}
+
+sub list
+{
+    grep $_->inst_file, CPAN::Shell->expand('Module', shift || '/./');
+}
+
+sub outdated
+{
+    grep !$_->uptodate, list @_;
+}
+
+## stolen from CPAN::Shell...
+sub readme
+{
+    my $dist = CPAN::Shell->expand('Module', shift);
+    return unless $dist;
+    $dist = $dist->cpan_file;
+    # my ($dist) = $self->id;
+    my ($sans, $suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
+    my ($local_file);
+    my ($local_wanted) = File::Spec->catfile(
+        $CPAN::Config->{keep_source_where}, "authors", "id",
+        split(/\//,"$sans.readme"));
+    $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
+    local (*IN, $/);
+    open IN, $local_wanted;
+    my $ret = <IN>;
+    close IN;
+    $ret;
+}
+
+sub perldoc
+{
+    get($CPAN::Defaultdocs . shift);
+}
diff --git a/sepia-cpan.el b/sepia-cpan.el
new file mode 100644
index 0000000..f1b9a71
--- /dev/null
+++ b/sepia-cpan.el
@@ -0,0 +1,74 @@
+(require 'button)
+
+(define-button-type 'sepia-cpan
+  'follow-link nil
+  'action 'sepia-cpan-button
+  'help-echo "[r]eadme, [d]ocumentation, [i]nstall, [b]rowse"
+  'keymap sepia-cpan-keymap)
+
+(defvar sepia-cpan-actions
+  '(("r" . sepia-cpan-readme)
+    ("d" . sepia-cpan-doc)
+    ("i" . sepia-cpan-install)
+    ("b" . sepia-cpan-browse)
+    ("?" . sepia-cpan-readme)))
+
+(defun sepia-cpan-doc (mod)
+  (interactive "sModule: ")
+  (browse-url (concat "http://search.cpan.org/perldoc?" mod)))
+
+(defun sepia-cpan-readme (mod)
+  (interactive "sModule: ")
+  (with-current-buffer (get-buffer-create "*sepia-cpan-readme*")
+    (insert (sepia-call "Sepia::CPAN::readme" 'list-context mod))
+    (pop-to-buffer (current-buffer))))
+
+(defun sepia-cpan-install (mod)
+  (interactive "sModule: ")
+  (when (y-or-n-p (format "install %s?" mod))
+    (sepia-call "Sepia::CPAN::install" 'void-context mod)))
+
+(defun sepia-cpan-list (pattern)
+  (interactive "sPattern (regexp): ")
+  (sepia-eval (format "map $_->id, Sepia::CPAN::list('/%s/')" pattern)
+              'list-context))
+
+(defun sepia-cpan-button (button)
+  (funcall (cdr (assoc sepia-cpan-button sepia-cpan-actions))
+           (button-label button)))
+
+(defvar sepia-cpan-button)
+
+(defun sepia-cpan-button-press ()
+  (interactive)
+  (let ((sepia-cpan-button (this-command-keys)))
+    (push-button)))
+
+(defvar sepia-cpan-keymap
+  (let ((km (make-sparse-keymap)))
+    (set-keymap-parent km button-map)
+    (define-key km "q" 'bury-buffer)
+    (dolist (k (mapcar #'car sepia-cpan-actions))
+      (define-key km k 'sepia-cpan-button-press))
+    km))
+
+(defun sepia-cpan-buffer (pat)
+  (interactive  "sPattern (regexp): ")
+  (switch-to-buffer "*sepia-cpan*")
+  (kill-all-local-variables)
+  (let ((inhibit-read-only t))
+    (erase-buffer))
+  (remove-overlays)
+  (insert (format "\
+CPAN modules matching /%s/
+    [r]eadme, [d]ocumentation, [i]nstall, [b]rowse
+
+" pat))
+  (dolist (mod (sepia-cpan-list pat))
+    (let ((beg (point)))
+      (insert mod)
+      (make-button beg (point) :type 'sepia-cpan))
+      (insert "\n"))
+  (use-local-map sepia-cpan-keymap))
+
+(provide 'sepia-cpan)
-- 
2.11.4.GIT