r4935 - in /packages/libregexp-copy-perl: ./ branches/
branches/upstream/
branches/upstream/current/ branches/upstream/current/lib/
branches/upstream/current/lib/Regexp/ tags/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Mon Mar 12 16:50:19 CET 2007
Author: eloy
Date: Mon Mar 12 15:50:18 2007
New Revision: 4935
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4935
Log:
[svn-inject] Installing original source of libregexp-copy-perl
Added:
packages/libregexp-copy-perl/
packages/libregexp-copy-perl/branches/
packages/libregexp-copy-perl/branches/upstream/
packages/libregexp-copy-perl/branches/upstream/current/
packages/libregexp-copy-perl/branches/upstream/current/CHANGES
packages/libregexp-copy-perl/branches/upstream/current/Copy.xs
packages/libregexp-copy-perl/branches/upstream/current/MANIFEST
packages/libregexp-copy-perl/branches/upstream/current/Makefile.PL
packages/libregexp-copy-perl/branches/upstream/current/README
packages/libregexp-copy-perl/branches/upstream/current/lib/
packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/
packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Copy.pm
packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Storable.pm
packages/libregexp-copy-perl/branches/upstream/current/test.pl
packages/libregexp-copy-perl/tags/
Added: packages/libregexp-copy-perl/branches/upstream/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libregexp-copy-perl/branches/upstream/current/CHANGES?rev=4935&op=file
==============================================================================
--- packages/libregexp-copy-perl/branches/upstream/current/CHANGES (added)
+++ packages/libregexp-copy-perl/branches/upstream/current/CHANGES Mon Mar 12 15:50:18 2007
@@ -1,0 +1,22 @@
+0.06 -
+ + made it work with Perl 5.8.1
+0.05 -
+ + okay, so maybe I didn't fix it. But I did this time m'kay.
+0.04 -
+ + we were getting a strange warning that was fixed by ensuring
+ Regexp::Storable created an empty regexp if there wasn't one
+ present in $thaw.
+0.03 -
+ + fixed bug that meant the magic data structures were getting
+ longer and longer. We mg_free all of that data away now
+ *before* assigning the new re.
+ + made mention of storable qr// freezing in main docs.
+
+0.02 -
+ + fixed bug that caused segfaults with large
+ data structures. This was a piece of bizarre
+ behavior on Perl's part, which I can't explain
+ or reduce to a simple test case.
+ + Updated documentation
+
+0.01 - Initial idea
Added: packages/libregexp-copy-perl/branches/upstream/current/Copy.xs
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libregexp-copy-perl/branches/upstream/current/Copy.xs?rev=4935&op=file
==============================================================================
--- packages/libregexp-copy-perl/branches/upstream/current/Copy.xs (added)
+++ packages/libregexp-copy-perl/branches/upstream/current/Copy.xs Mon Mar 12 15:50:18 2007
@@ -1,0 +1,47 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+MAGIC *
+_find_mg(SV* sv) {
+ MAGIC *mg;
+ return mg_find(sv, 'r');
+}
+
+MODULE = Regexp::Copy PACKAGE = Regexp::Copy
+
+SV*
+re_copy_xs(newre,re)
+ SV* newre
+ SV* re
+PREINIT:
+ SV *sv, *othersv;
+ MAGIC *mg;
+ MGVTBL *vtable = 0;
+CODE:
+ if (!SvROK(re)) {
+ croak("re_copy needs a reference");
+ }
+
+ sv = (SV*) SvRV(re);
+ othersv = (SV*) SvRV(newre);
+ mg = _find_mg(othersv);
+
+ if (mg) {
+ mg_free( sv );
+ /* ensure that we are doing the right thing for the
+ right version of Perl. 5.8.1 changed behaviour of
+ qr// things to have S-magic rather than R-magic. */
+ if (SvNV(PL_patchlevel) > 5.008) {
+ SvSMAGICAL_on(sv);
+ } else {
+ SvRMAGICAL_on(sv);
+ }
+ /* copy the magic in mg to sv */
+ sv_magicext(sv, mg->mg_obj, 'r', vtable, NULL, 0);
+ } else {
+ croak("no re magic currently set in re");
+ }
+OUTPUT:
+ newre
+
Added: packages/libregexp-copy-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libregexp-copy-perl/branches/upstream/current/MANIFEST?rev=4935&op=file
==============================================================================
--- packages/libregexp-copy-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libregexp-copy-perl/branches/upstream/current/MANIFEST Mon Mar 12 15:50:18 2007
@@ -1,0 +1,8 @@
+CHANGES
+Copy.xs
+README
+MANIFEST This list of files
+Makefile.PL
+lib/Regexp/Copy.pm
+lib/Regexp/Storable.pm
+test.pl
Added: packages/libregexp-copy-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libregexp-copy-perl/branches/upstream/current/Makefile.PL?rev=4935&op=file
==============================================================================
--- packages/libregexp-copy-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libregexp-copy-perl/branches/upstream/current/Makefile.PL Mon Mar 12 15:50:18 2007
@@ -1,0 +1,10 @@
+use 5.008;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Regexp::Copy',
+ 'VERSION_FROM' => 'lib/Regexp/Copy.pm', # finds $VERSION
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+ 'LIBS' => [''], # e.g., '-lm'
+);
Added: packages/libregexp-copy-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libregexp-copy-perl/branches/upstream/current/README?rev=4935&op=file
==============================================================================
(empty)
Added: packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Copy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Copy.pm?rev=4935&op=file
==============================================================================
--- packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Copy.pm (added)
+++ packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Copy.pm Mon Mar 12 15:50:18 2007
@@ -1,0 +1,89 @@
+package Regexp::Copy;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+use Regexp::Storable;
+
+require Carp;
+require Exporter;
+require DynaLoader;
+require AutoLoader;
+
+ at ISA = qw(Exporter DynaLoader);
+
+ at EXPORT = qw( );
+ at EXPORT_OK = qw(re_copy);
+$VERSION = '0.06';
+
+
+bootstrap Regexp::Copy $VERSION;
+
+sub re_copy {
+ for (@_) {
+ if (uc(ref($_)) eq ref($_) && !$_->isa('Regexp')) {
+ Carp::croak "parameters to re_copy must be blessed and isa(Regexp)";
+ }
+ }
+ re_copy_xs(@_);
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Regexp::Copy - copy Regexp objects
+
+=head1 SYNOPSIS
+
+ use Regexp::Copy qw( re_copy );
+
+ my $re1 = qr/Hello!/;
+ my $re2 = qr/Goodbye!/;
+
+ re_copy($re1, $re2);
+
+ print "ok\n" if 'Goodbye!' =~ $re1;
+
+=head1 DESCRIPTION
+
+C<Regexp::Copy> allows you to copy the contents of one Regexp object to another.
+A problem that I have found with the qr// operator is that the Regexp objects that
+it creates are is impossible to dereference. This causes problems if you want to change
+the data in the regexp without losing the reference to it. Its impossible. Regexp::Copy
+allows you to change the Regexp by copying one object created through qr// to another.
+
+This module came about through discussions on the London.pm mailing list in regards to
+attempts various people had made to serialize objects with qr// created Regexp objects in
+them. The Regex::Copy distribution also loads Regexp::Storable, which provides hooks to
+allow the Storable persistence method to freeze and thaw Regexp objects created by qr//.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item re_copy(FROM, TO)
+
+The C<re_copy> function copies the regular expression magic contained within the
+variable FROM to the variable named in TO.
+
+=back
+
+=head1 THANKS TO
+
+Piers Cawley, who provided the magic Pixie::Info code, that forms the basis of Regexp::Copy.
+
+=head1 AUTHOR
+
+James A. Duncan <jduncan at fotango.com>
+
+=head1 COPYRIGHT
+
+Copyright 2002 All Rights Reserved.
+
+This module is released under the same license as Perl itself.
+
+=cut
Added: packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Storable.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Storable.pm?rev=4935&op=file
==============================================================================
--- packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Storable.pm (added)
+++ packages/libregexp-copy-perl/branches/upstream/current/lib/Regexp/Storable.pm Mon Mar 12 15:50:18 2007
@@ -1,0 +1,19 @@
+package Regexp::Storable;
+
+our $VERSION = '0.06';
+
+package Regexp;
+
+
+sub STORABLE_freeze {
+ my $serialized = substr($_[0], rindex($_[0],':')+1, -1);
+ return $serialized;
+}
+
+sub STORABLE_thaw {
+ my ( $original, $cloning, $thaw ) = @_;
+ my $final = ($thaw) ? qr/$thaw/ : qr//;
+ Regexp::Copy::re_copy($final, $original);
+}
+
+1;
Added: packages/libregexp-copy-perl/branches/upstream/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libregexp-copy-perl/branches/upstream/current/test.pl?rev=4935&op=file
==============================================================================
--- packages/libregexp-copy-perl/branches/upstream/current/test.pl (added)
+++ packages/libregexp-copy-perl/branches/upstream/current/test.pl Mon Mar 12 15:50:18 2007
@@ -1,0 +1,43 @@
+#!/usr/bin/perl
+
+use blib;
+use Storable qw( freeze thaw );
+use Regexp::Copy qw(re_copy);
+
+use Test::More tests => 6;
+
+ok(1,"we loaded fine...");
+
+my $re = qr/Hello!/;
+my $re2 = qr/Goodbye!/;
+
+re_copy( $re, $re2 );
+
+ok( $re eq $re2, "stringified regexes are equal");
+
+my $stored = freeze( $re );
+my $relief = thaw( $stored );
+
+ok($relief eq $re, "frozen/thawed are equal");
+
+eval {
+ re_copy( 'hello', 'goodbye' );
+};
+if ($@) {
+ ok(1, "re_copy died on non-regexp objects");
+} else {
+ ok(0, "re_copy did not die on non-regexp object");
+}
+
+my $deep = { my => { your => { this => { that => bless({ this => qr/^\/(index\.html|value\.html)/ },'App') } } } };
+my $clone = thaw( freeze( $deep ) );
+is_deeply($clone,$deep,"deeper data structures");
+
+my $nullre = qr//;
+my $resul = qr/I once was a fishermans son!/;
+eval {
+ re_copy($nullre, $resul);
+};
+
+ok($resul eq '(?-xism:)',"copied null regex");
+
More information about the Pkg-perl-cvs-commits
mailing list