[Bps-public-commit] r10436 - in Text-Quoted: . bin dists etc scripts shipwright
ruz at bestpractical.com
ruz at bestpractical.com
Tue Jan 22 16:12:05 EST 2008
Author: ruz
Date: Tue Jan 22 16:12:04 2008
New Revision: 10436
Added:
Text-Quoted/Changes
Text-Quoted/MANIFEST
Text-Quoted/META.yml
Text-Quoted/Makefile.PL
Text-Quoted/Quoted.pm
Text-Quoted/README
Removed:
Text-Quoted/bin/
Text-Quoted/dists/
Text-Quoted/etc/
Text-Quoted/scripts/
Text-Quoted/shipwright/
Text-Quoted/t/
Log:
* add back Text::Quoted to its place
Added: Text-Quoted/Changes
==============================================================================
--- (empty file)
+++ Text-Quoted/Changes Tue Jan 22 16:12:04 2008
@@ -0,0 +1,38 @@
+Revision history for Perl extension Text::Quoted.
+
+2.03 Wed Nov 7 2007
+ - delete a lot of unused code
+ - many micro optimisations
+ - performance improvements, up to 1.5x in total
+ - clanups of Makefile, README
+
+2.02 Wed Feb 20 2007
+ - fix a missing test in MANIFEST
+
+2.01 Wed Feb 20 2007
+ - fix a problem with $VERSION
+
+1.10 Tue Feb 13 2007
+ - fix a bug where lines are hidden when the quote character
+ changes midstream. Reported by Dirk Pape and Sven Sternberger
+
+1.9 Fri Jun 24 15:34:46 EDT 2005
+ - Manifest cleanup. From Mike Castle
+
+1.8 Thu Jul 1 23:21:14 EDT 2004
+ - Fix handling for the case where we we're quoting
+ a false but defined string. From Stephen Quinney.
+
+1.7 Wed Jun 16 16:54:57 EDT 2004
+
+ - New maintainer learns to remove his debugging output
+
+1.6 Wed Jun 16 13:36:00 EDT 2004
+
+ - New maintainer
+ - Better handle attempts to quote an empty or undef string
+
+1.0 Tue Dec 3 15:01:07 2002
+ - original version; created by h2xs 1.22 with options
+ -AX -n Text::Quoted
+
Added: Text-Quoted/MANIFEST
==============================================================================
--- (empty file)
+++ Text-Quoted/MANIFEST Tue Jan 22 16:12:04 2008
@@ -0,0 +1,20 @@
+Changes
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+Quoted.pm
+README
+t/1.t
+t/2.t
+t/3.t
+t/4.t
+t/5.t
+t/6.t
Added: Text-Quoted/META.yml
==============================================================================
--- (empty file)
+++ Text-Quoted/META.yml Tue Jan 22 16:12:04 2008
@@ -0,0 +1,20 @@
+---
+abstract: Extract the structure of a quoted mail message
+author:
+ - Jesse Vincent <jesse at bestpractical.com>
+distribution_type: module
+generated_by: Module::Install version 0.68
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
+name: Text-Quoted
+no_index:
+ directory:
+ - inc
+ - t
+requires:
+ Text::Autoformat: 0
+ Text::Tabs: 0
+ perl: 5.6.0
+version: 2.03
Added: Text-Quoted/Makefile.PL
==============================================================================
--- (empty file)
+++ Text-Quoted/Makefile.PL Tue Jan 22 16:12:04 2008
@@ -0,0 +1,13 @@
+use 5.006;
+use inc::Module::Install;
+
+name 'Text-Quoted';
+license 'perl';
+author 'Jesse Vincent <jesse at bestpractical.com>';
+
+all_from 'Quoted.pm';
+
+requires 'Text::Autoformat';
+requires 'Text::Tabs';
+
+WriteAll;
Added: Text-Quoted/Quoted.pm
==============================================================================
--- (empty file)
+++ Text-Quoted/Quoted.pm Tue Jan 22 16:12:04 2008
@@ -0,0 +1,236 @@
+package Text::Quoted;
+our $VERSION = "2.03";
+use 5.006;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(extract);
+
+use Text::Autoformat(); # Provides the Hang package, heh, heh.
+use Text::Tabs();
+
+=head1 NAME
+
+Text::Quoted - Extract the structure of a quoted mail message
+
+=head1 SYNOPSIS
+
+ use Text::Quoted;
+ my $structure = extract($text);
+
+=head1 DESCRIPTION
+
+C<Text::Quoted> examines the structure of some text which may contain
+multiple different levels of quoting, and turns the text into a nested
+data structure.
+
+The structure is an array reference containing hash references for each
+paragraph belonging to the same author. Each level of quoting recursively
+adds another list reference. So for instance, this:
+
+ > foo
+ > # Bar
+ > baz
+
+ quux
+
+turns into:
+
+ [
+ [
+ { text => 'foo', quoter => '>', raw => '> foo' },
+ [
+ { text => 'Bar', quoter => '> #', raw => '> # Bar' }
+ ],
+ { text => 'baz', quoter => '>', raw => '> baz' }
+ ],
+
+ { empty => 1 },
+ { text => 'quux', quoter => '', raw => 'quux' }
+ ];
+
+This also tells you about what's in the hash references: C<raw> is the
+paragraph of text as it appeared in the original input; C<text> is what
+it looked like when we stripped off the quotation characters, and C<quoter>
+is the quotation string.
+
+=cut
+
+sub extract {
+ return organize( "",
+ map +{
+ raw => $_->{'raw'},
+ empty => $_->{'empty'},
+ text => $_->{'text'},
+ quoter => $_->{'quoter'},
+ }, classify( @_ )
+ );
+}
+
+=head1 CREDITS
+
+Most of the heavy lifting is done by a modified version of Damian Conway's
+C<Text::Autoformat>.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002-2003 Kasei Limited
+Copyright (C) 2003-2004 Simon Cozens
+Copyright (C) 2004 Best Practical Solutions, LLC
+
+This software is distributed WITHOUT ANY WARRANTY; without even the implied
+warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+sub organize {
+ my $top_level = shift;
+ my @todo = @_;
+ $top_level = '' unless defined $top_level;
+
+ my @ret;
+
+ # Recursively form a data structure which reflects the quoting
+ # structure of the list.
+ while (my $line = shift @todo) {
+ my $q = defined $line->{quoter}? $line->{quoter}: '';
+ if ( $q eq $top_level ) {
+
+ # Just append lines at "my" level.
+ push @ret, $line
+ if exists $line->{quoter}
+ or exists $line->{empty};
+ }
+ elsif ( $q =~ /^\Q$top_level\E./ ) {
+
+ # Find all the lines at a quoting level "below" me.
+ my $newquoter = find_below( $top_level, $line, @todo );
+ my @next = $line;
+ push @next, shift @todo while defined $todo[0]->{quoter}
+ and $todo[0]->{quoter} =~ /^\Q$newquoter/;
+
+ # Find the
+ # And pass them on to organize()!
+ #print "Trying to organise the following lines over $newquoter:\n";
+ #print $_->{raw}."\n" for @next;
+ #print "!-!-!-\n";
+ push @ret, organize( $newquoter, @next );
+ } # else { die "bugger! I had $top_level, but now I have $line->{raw}\n"; }
+ }
+ return \@ret;
+}
+
+# Given, say:
+# X
+# > > hello
+# > foo bar
+# Stuff
+#
+# After "X", we're moving to another level of quoting - but which one?
+# Naively, you'd pick out the prefix of the next line, "> >", but this
+# is incorrect - "> >" is actually a "sub-quote" of ">". This routine
+# works out which is the next level below us.
+
+sub find_below {
+ my ( $top_level, @stuff ) = @_;
+
+ # Find the prefices, shortest first.
+ # And return the first one which is "below" where we are right
+ # now but is a proper subset of the next line.
+ return (
+ sort { length $a <=> length $b }
+ grep $_ && /^\Q$top_level\E./ && $stuff[0]->{quoter} =~ /^\Q$_\E/,
+ map $_->{quoter},
+ @stuff
+ )[0];
+}
+
+# Everything below this point is essentially Text::Autoformat.
+
+# BITS OF A TEXT LINE
+
+my $quotechar = qq{[!#%=|:]};
+my $quotechunk = qq{(?:$quotechar(?!\\w)|\\w*>+)};
+my $quoter = qq{(?:(?i)(?:$quotechunk(?:[ \\t]*$quotechunk)*))};
+
+my $separator = q/(?:[-_]{2,}|[=#*]{3,}|[+~]{4,})/;
+
+sub defn($) { return $_[0] if (defined $_[0]); return "" }
+
+sub classify {
+ my $text = shift;
+ $text = "" unless defined $text;
+ # If the user passes in a null string, we really want to end up with _something_
+
+ # DETABIFY
+ my @lines = Text::Tabs::expand( split /\n/, $text );
+
+
+ # PARSE EACH LINE
+
+ foreach (splice @lines) {
+ my %line = ( raw => $_ );
+ @line{'quoter', 'text'} = (/\A *($quoter?) *(.*?)\s*\Z/o);
+ $line{hang} = Hang->new( $line{'text'} );
+ $line{empty} = $line{hang}->empty() && $line{'text'} !~ /\S/;
+ $line{separator} = $line{text} =~ /^$separator$/o;
+ push @lines, \%line;
+ }
+
+ # SUBDIVIDE DOCUMENT INTO COHERENT SUBSECTIONS
+
+ my @chunks;
+ push @chunks, [ shift @lines ];
+ foreach my $line (@lines) {
+ if ( $line->{separator}
+ || $line->{quoter} ne $chunks[-1][-1]->{quoter}
+ || $line->{empty}
+ || $chunks[-1][-1]->{empty} )
+ {
+ push @chunks, [$line];
+ }
+ else {
+ push @{ $chunks[-1] }, $line;
+ }
+ }
+
+ # REDIVIDE INTO PARAGRAPHS
+
+ my @paras;
+ foreach my $chunk (@chunks) {
+ my $first = 1;
+ my $firstfrom;
+ foreach my $line ( @{$chunk} ) {
+ if ( $first
+ || $line->{quoter} ne $paras[-1]->{quoter}
+ || $paras[-1]->{separator} )
+ {
+ push @paras, $line;
+ $first = 0;
+ # We get warnings from undefined raw and text values if we don't supply alternates
+ $firstfrom = length( $line->{raw} ||'' ) - length( $line->{text} || '');
+ }
+ else {
+ my $extraspace =
+ length( $line->{raw} ) - length( $line->{text} ) - $firstfrom;
+ $paras[-1]->{text} .= "\n" . q{ } x $extraspace . $line->{text};
+ $paras[-1]->{raw} .= "\n" . $line->{raw};
+ }
+ }
+ }
+
+ # Reapply hangs
+ for (grep $_->{hang}, @paras) {
+ next unless my $str = $_->{hang}->stringify;
+ $_->{text} = $str . " " . $_->{text};
+ }
+ return @paras;
+}
+
+1;
Added: Text-Quoted/README
==============================================================================
--- (empty file)
+++ Text-Quoted/README Tue Jan 22 16:12:04 2008
@@ -0,0 +1,26 @@
+Text::Quoted
+========================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+SEE ALSO
+
+`perldoc Text::Quoted`
More information about the Bps-public-commit
mailing list