use strict;
      use WWW::Mechanize;
      
>>    my $agent = WWW::Mechanize->new( autocheck => 1 );
> >      $agent->get('http://cgi.darwinawards.com/cgi/random.pl');
>  >> my $content = $agent->content( format => "text" );
   | >my $cr = chr 169;
   > |$content =~ s/.*\d\d\s+Urban Legend//s;
   > |$content =~ s/.*\d\d\s+Personal Account//s;
   > |$content =~ s/.*Reader Submission\s+Pending Acceptance//s;
   > >$content =~ s/\s*DarwinAwards\.com\s*$cr.*//s;
   >  $content =~ s/.*?\([^\)]*?\d{2}[^\)]*\) //s;
   >  $content =~ s/.*Darwin\s?Award\s?Nominee//si;
   >  $content =~ s/.*Confirmed \S+\s?by Darwin//si;
   >  $content =~ s/.*Honorable Mentions//s;
   >  $content =~ s/submitted by.*//si;
   >  $content =~ s/109876543210.*//s;
   >  $content =~ s/^\s+//;
   |  
   >  print $content;

##</code><code>##

(add-to-list 'load-path "~/.site-lisp")
(autoload 'b-xref "b-xref.el" "Cross-references perl symbols" t)

##</code><code>##

(defun b-xref ()
  (interactive)
  (let ((output-buffer-name (concat "*b-xref-" (buffer-name) "*")))
    (let ((old-buffer (get-buffer output-buffer-name)))
      (if old-buffer
	  (kill-buffer old-buffer)))
    (let ((point (point))
	  (mark (if mark-active (mark) (point)))
	  (orig-buffer (current-buffer))
	  (buffer (get-buffer-create (concat "*b-xref-" (buffer-name) "*"))))
      (save-excursion
	(save-restriction
	  (widen)
	  (copy-to-buffer buffer (point-min) (point-max))
	  (set-buffer buffer)
	  (b-xref-mode)
	  (buffer-disable-undo)
	  (let ((jots (b-xref-summarize (sort (let ((xref (b-xref-buffer orig-buffer)))
						(b-xref-filter-lines xref
								     (point->line (min point mark))
								     (point->line (max point mark))))
					      'b-xref-alist->))))
	    (mapc 'b-xref-do-jots jots))
	  (set-buffer-modified-p nil)
	  (toggle-read-only)))
      (display-buffer buffer))))

(defvar b-xref-bin "perl")
(defvar b-xref-jot ">")
(defvar b-xref-fill "|")
(defvar b-xref-fill-space " ")

(defvar b-xref-mode-map nil
  "Keymap for B::Xref major mode.")
(if b-xref-mode-map
    nil
  (setq b-xref-mode-map (make-sparse-keymap)))
  
(defun b-xref-mode ()
  "Major mode for viewing B::Xref data overlayed on perl code.
Special commands:
\\{b-xref-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (fundamental-mode)
  (setq major-mode 'b-xref-mode)
  (setq mode-name "B::Xref")
  (use-local-map b-xref-mode-map)
  (run-hooks 'b-xref-hook))



(defun point->line (point)
  (let ((line 1))
    (save-excursion
      (goto-char (point-min))
      (while (< (point) point)
        (incf line)
        (forward-line)))
    line))
      

;  

(defun b-xref-summarize (xref)
  (loop with xref-output
        for (subname line pack type name event) in xref
        do (let ((key (list pack name)))
             (let ((pair (assoc key xref-output)))
               (if pair
                   (let ((lines (cdr pair)))
                     (or (member line lines) 
                         (nconc lines (list line))))
                 (push (cons key (list line)) xref-output))))
        finally (return xref-output)))

(defun b-xref-filter-lines (xref start end)
  (let ((to-find (loop for (subname line pack type name event) in xref
                       when (and (>= line start)
                                 (<= line end))
                       collect (list pack name))))
    (remove-if-not (lambda (i)
                     (member (list (nth 2 i) (nth 4 i)) to-find))
                   xref)))


(defun b-xref-list-> (a b)
  "Sorts a list so larger numbers go first, then shorter lists."
  (if (and (numberp (car a))
           (numberp (car b)))
      (or (> (car a) (car b))
          (and (= (car a) (car b))
               (b-xref-list-> (cdr a) (cdr b))))
    (and (null a)
          (not (null b)))))
(defun b-xref-alist-> (a b)
  "Sorts the elements of an alist with `b-xref-list->'"
  (b-xref-list-> (cdr a) (cdr b)))

;        (sort xref-output 'b-xref-alist->)))))




(require 'cl)
(defsubst min-list (list) (reduce 'min list))
(defsubst max-list (list) (reduce 'max list))
(defsubst line->point (line)
  (goto-line line)
  (point))
(defun b-xref-do-jots (pair)
  "Make space for jots and call `b-xref-jot-line' to place them."
  (string-rectangle (point-min)
                    (progn (goto-char (point-max))
                           (beginning-of-line)
                           (point))
                    b-xref-fill-space)
  (let ((name (concat (nth 0 (car pair)) ":" (nth 1 (car pair))))
	(lines (cdr pair)))
    (let ((min-line (min-list lines))
          (max-line (max-list lines)))
      (delete-rectangle (line->point min-line)
                        (+ 1 (line->point max-line)))
      (string-rectangle (line->point min-line)
                        (line->point max-line)
                        b-xref-fill)
      (mapcar (lambda (l) (b-xref-jot-line l name)) lines))))
(defun b-xref-jot-line (line name)
  "Jot a note on LINE."
  (goto-char (line->point line))
  (delete-char 1)
  (insert (propertize b-xref-jot
		      'help-echo name
		      'point-entered (message-displayer name))))

(defun message-displayer (message)
  (lexical-let ((lexical-message message))
    (lambda (old-point new-point) (display-message-or-buffer lexical-message))))
;(setq message-displayer-cache nil)
;(defadvice message-displayer (around singleton-displayer)
;  (let ((cached-function (assoc (ad-get-arg 1) message-displayer-cache)))
;    (if (not cached-function)
;	(push (cons (ad-get-arg 1) ad-do-it) message-displayer-cache))
;    (cdr (assoc (ad-get-arg 1) message-displayer-cache))))
;(ad-activate 'message-displayer)


(defun b-xref-buffer (buffer)
  "Runs a buffer through 'perl -MO=Xref,-raw' and returns the parsed data."
  (save-excursion
    (save-restriction
      (set-buffer buffer)
      (widen)
      (goto-char (point-min))
      (let ((perl (if (looking-at auto-mode-interpreter-regexp)
                      (match-string 2)
                    (or b-xref-bin "perl")))
            (infile (if (buffer-modified-p)
                        (error "TODO: Copy modified buffer to temp file.")
                      (buffer-file-name)))
            (buffer (generate-new-buffer "*b-xref-raw*")))
        (let ((rc (call-process perl infile buffer nil "-MO=Xref,-raw")))
          (or (zerop rc)
              (error "%s exited with %d" perl rc)))
        (let ((xref-output (b-xref-read-raw buffer "-")))
          (kill-buffer buffer)
          xref-output)))))



(defun trim (str) (rtrim (ltrim str)))
(defun ltrim (str) (replace-regexp-in-string "^ +" "" str))
(defun rtrim (str) (replace-regexp-in-string " +$" "" str))

(defun b-xref-read-raw (buffer filename)
  "Reads the output from 'perl -MO=Xref,-raw'."
  (save-excursion
    (save-restriction
      (set-buffer buffer)
      (widen)
      (goto-char (point-min))
      (let (xref-output
            (xref-regexp (concat "^"
                                 (regexp-quote filename)
                                 (let ((pad (- 16 (length filename))))
                                   (if (> pad 0)
                                       (make-string pad ? )
                                     ""))
                                 " \\(............[^ \n]*\\)"
                                 " \\(.....[^ \n]*\\)"
                                 " \\(............[^ \n]*\\)"
                                 " \\(....[^ \n]*\\)"
                                 " \\(................[^ \n]*\\)"
                                 " \\([^\n]+\\)\n")))
        (while (re-search-forward xref-regexp nil t)
          (or (bolp) (forward-line))
          (let ((subname (trim (match-string 1)))
                (line (string-to-number (trim (match-string 2))))
                (pack (trim (match-string 3)))
                (type (trim (match-string 4)))
                (name (trim (match-string 5)))
                (event (trim (match-string 6))))
            (push (list subname line pack type name event) xref-output)))
        xref-output))))

(provide 'b-xref)