r34803 - in /branches/upstream/libclass-byos-perl: ./ current/ current/lib/ current/lib/Class/ current/t/ current/t/CrazyClass/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Tue May 5 16:56:54 UTC 2009


Author: jawnsy-guest
Date: Tue May  5 16:56:49 2009
New Revision: 34803

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34803
Log:
[svn-inject] Installing original source of libclass-byos-perl

Added:
    branches/upstream/libclass-byos-perl/
    branches/upstream/libclass-byos-perl/current/
    branches/upstream/libclass-byos-perl/current/Build.PL
    branches/upstream/libclass-byos-perl/current/MANIFEST
    branches/upstream/libclass-byos-perl/current/META.yml
    branches/upstream/libclass-byos-perl/current/Makefile.PL
    branches/upstream/libclass-byos-perl/current/lib/
    branches/upstream/libclass-byos-perl/current/lib/Class/
    branches/upstream/libclass-byos-perl/current/lib/Class/ByOS.pm
    branches/upstream/libclass-byos-perl/current/t/
    branches/upstream/libclass-byos-perl/current/t/00use.t
    branches/upstream/libclass-byos-perl/current/t/01stupid.t
    branches/upstream/libclass-byos-perl/current/t/02fancy.t
    branches/upstream/libclass-byos-perl/current/t/03required.t
    branches/upstream/libclass-byos-perl/current/t/CrazyClass/
    branches/upstream/libclass-byos-perl/current/t/CrazyClass.pm
    branches/upstream/libclass-byos-perl/current/t/CrazyClass/WeirdIX.pm

Added: branches/upstream/libclass-byos-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/Build.PL?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/Build.PL (added)
+++ branches/upstream/libclass-byos-perl/current/Build.PL Tue May  5 16:56:49 2009
@@ -1,0 +1,18 @@
+use strict;
+use warnings;
+
+use Module::Build;
+
+my $build = Module::Build->new
+  (
+   module_name => 'Class::ByOS',
+   requires => {
+               },
+   build_requires => {
+                 'Test::More' => 0,
+               },
+   license => 'perl',
+   create_makefile_pl => 'traditional',
+  );
+  
+$build->create_build_script;

Added: branches/upstream/libclass-byos-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/MANIFEST?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/MANIFEST (added)
+++ branches/upstream/libclass-byos-perl/current/MANIFEST Tue May  5 16:56:49 2009
@@ -1,0 +1,11 @@
+Build.PL
+lib/Class/ByOS.pm
+MANIFEST			This list of files
+t/00use.t
+t/01stupid.t
+t/02fancy.t
+t/03required.t
+t/CrazyClass.pm
+t/CrazyClass/WeirdIX.pm
+Makefile.PL
+META.yml

Added: branches/upstream/libclass-byos-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/META.yml?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/META.yml (added)
+++ branches/upstream/libclass-byos-perl/current/META.yml Tue May  5 16:56:49 2009
@@ -1,0 +1,19 @@
+---
+name: Class-ByOS
+version: 0.01
+author:
+  - 'Paul Evans E<lt>leonerd at leonerd.org.ukE<gt>'
+abstract: write object classes that load OS-specific subclasses at runtime
+license: perl
+resources:
+  license: http://dev.perl.org/licenses/
+build_requires:
+  Test::More: 0
+provides:
+  Class::ByOS:
+    file: lib/Class/ByOS.pm
+    version: 0.01
+generated_by: Module::Build version 0.3
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.2.html
+  version: 1.2

Added: branches/upstream/libclass-byos-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/Makefile.PL?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/Makefile.PL (added)
+++ branches/upstream/libclass-byos-perl/current/Makefile.PL Tue May  5 16:56:49 2009
@@ -1,0 +1,14 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.30
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+          'NAME' => 'Class::ByOS',
+          'VERSION_FROM' => 'lib/Class/ByOS.pm',
+          'PREREQ_PM' => {
+                           'Test::More' => 0
+                         },
+          'INSTALLDIRS' => 'site',
+          'EXE_FILES' => [],
+          'PL_FILES' => {}
+        )
+;

Added: branches/upstream/libclass-byos-perl/current/lib/Class/ByOS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/lib/Class/ByOS.pm?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/lib/Class/ByOS.pm (added)
+++ branches/upstream/libclass-byos-perl/current/lib/Class/ByOS.pm Tue May  5 16:56:49 2009
@@ -1,0 +1,169 @@
+#  You may distribute under the terms of either the GNU General Public License
+#  or the Artistic License (the same terms as Perl itself)
+#
+#  (C) Paul Evans, 2009 -- leonerd at leonerd.org.uk
+
+package Class::ByOS;
+
+use strict;
+use base qw( Exporter );
+
+our $VERSION = '0.01';
+
+our @EXPORT = qw( new );
+
+=head1 NAME
+
+C<Class::ByOS> - write object classes that load OS-specific subclasses at runtime
+
+=head1 SYNOPSIS
+
+This module is for authors of object classes. A class might be written as
+
+ package System::Wobble;
+
+ use Class::ByOS;
+
+ # NOT new()
+ sub __new
+ {
+    my $class = shift;
+    my @args = @_;
+    ...
+
+    return bless { internals => here }, $class;
+ }
+
+ sub wobble
+ {
+    # we'll just shell out to the 'wobble' binary
+    system( "wobble" );
+ }
+
+ 1;
+
+The user of this class doesn't need to know the details; it can be used like
+
+ use System::Wobble;
+
+ my $wobbler = System::Wobble->new();
+ $wobbler->wobble;
+
+An OS-specific implementation can be provided in a subclass
+
+ package System::Wobble::wobblyos;
+
+ use base qw( System::Wobble );
+
+ use WobblyOS::Wobble qw( sys_wobble );
+
+ sub wobble { sys_wobble() }
+
+ 1;
+
+=head1 DESCRIPTION
+
+Often a module will provide a general functionallity that in some way uses the
+host system's facilities, but in a way that can either benefit from, or
+requires an implementation specific to that host OS. Examples might be IO
+system calls, access to networking or hardware devices, kernel state, or other
+specific system internals.
+
+By implementing a base class using this module, a special constructor is
+formed that, at runtime, probes the available modules, constructing an
+instance of the most specific subclass that is appropriate. This allows the
+object's methods, including its actual constructor, to be overridden for
+particular OSes, in order to provide functionallity specifically to that OS,
+without sacrificing the general nature of the base class.
+
+The end-user program that uses such a module does not need to be aware of this
+magic. It simply constructs an object in the usual way by calling the class's
+C<new()> method and use the object reference returned.
+
+=cut
+
+=head1 EXPORTED CONSTRUCTOR
+
+=cut
+
+=head2 $obj = $class->new( @args )
+
+By default, this module exports a C<new()> function into its importer, which
+is the constructor actually called by the end-user code. This constructor will
+determine the best subclass to use (see C<find_best_subclass()>), then invoke
+the C<__new()> method on that class, passing in all its arguments.
+
+=cut
+
+# This is the EXPORTED new()
+sub new
+{
+   find_best_subclass( shift )->__new( @_ );
+}
+
+=head1 FUNCTIONS
+
+=cut
+
+=head2 $class = find_best_subclass( $baseclass )
+
+This function attempts to find suitable subclasses for the base class name
+given. Candidates for being chosen will be
+
+=over 4
+
+=item C<$class::$^O>
+
+=item C<$class>
+
+For each candidate, it will be picked if that package provides a method called
+C<__new>. If it does not exist yet, then an attempt will be made to load the
+package using C<require>. If this attempt succeeds and the C<__new> method now
+exists, then the candidate will be picked.
+
+=back
+
+=cut
+
+sub find_best_subclass
+{
+   my $class = shift;
+
+   eval { try_class( "${class}::$^O" ) } or
+   # TODO: try OS families here; e.g. linux -> POSIX
+   $class;
+}
+
+sub try_class
+{
+   my $class = shift;
+
+   $class->can( "__new" ) and return $class;
+
+   ( my $path = "$class.pm" ) =~ s{::}{/}g;
+   eval { require $path } and $class->can( "__new" ) and return $class;
+
+   return undef;
+}
+
+# Keep perl happy; keep Britain tidy
+1;
+
+__END__
+
+=head1 TODO
+
+=over 4
+
+=item *
+
+Get C<find_best_subclass()> to check OS family names too. E.g. "linux" would
+also try Unix, or POSIX, or something of that nature. Need a source of these
+names from somewhere. Tempted to try C<Devel::CheckOS> but that can't
+distinguish OS names from families, nor can it provide taxonomy ordering.
+
+=back
+
+=head1 AUTHOR
+
+Paul Evans E<lt>leonerd at leonerd.org.ukE<gt>

Added: branches/upstream/libclass-byos-perl/current/t/00use.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/t/00use.t?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/t/00use.t (added)
+++ branches/upstream/libclass-byos-perl/current/t/00use.t Tue May  5 16:56:49 2009
@@ -1,0 +1,6 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 1;
+
+use_ok( "Class::ByOS" );

Added: branches/upstream/libclass-byos-perl/current/t/01stupid.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/t/01stupid.t?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/t/01stupid.t (added)
+++ branches/upstream/libclass-byos-perl/current/t/01stupid.t Tue May  5 16:56:49 2009
@@ -1,0 +1,22 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 3;
+
+my $obj = t::StupidClass->new();
+
+ok( defined $obj, '$obj is defined' );
+isa_ok( $obj, "t::StupidClass", '$obj isa t::StupidClass' );
+is( ref $obj, "t::StupidClass", '$obj isa t::StupidClass exactly' );
+
+package t::StupidClass;
+
+use Class::ByOS;
+
+sub __new
+{
+   my $class = shift;
+   return bless {}, $class;
+}
+
+1;

Added: branches/upstream/libclass-byos-perl/current/t/02fancy.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/t/02fancy.t?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/t/02fancy.t (added)
+++ branches/upstream/libclass-byos-perl/current/t/02fancy.t Tue May  5 16:56:49 2009
@@ -1,0 +1,45 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 7;
+
+# Oh so much cheating it isn't funny....
+$^O = "WeirdIX";
+
+my $obj = t::FancyClass->new();
+
+ok( defined $obj, '$obj is defined' );
+isa_ok( $obj, "t::FancyClass", '$obj isa t::FancyClass' );
+isa_ok( $obj, "t::FancyClass::WeirdIX", '$obj isa t::FancyClass::WeirdIX' );
+
+is( $obj->mode, "fancy", '$obj->mode' );
+
+# More cheating
+$^O = "BoringOS";
+
+$obj = t::FancyClass->new();
+
+ok( defined $obj, '$obj is defined' );
+isa_ok( $obj, "t::FancyClass", '$obj isa t::FancyClass' );
+
+is( $obj->mode, "boring", '$obj->mode' );
+
+package t::FancyClass;
+
+use Class::ByOS;
+
+sub __new
+{
+   my $class = shift;
+   return bless {}, $class;
+}
+
+sub mode { "boring" }
+
+package t::FancyClass::WeirdIX;
+
+use base qw( t::FancyClass );
+
+sub mode { "fancy" }
+
+1;

Added: branches/upstream/libclass-byos-perl/current/t/03required.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/t/03required.t?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/t/03required.t (added)
+++ branches/upstream/libclass-byos-perl/current/t/03required.t Tue May  5 16:56:49 2009
@@ -1,0 +1,17 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 4;
+
+# Oh so much cheating it isn't funny....
+$^O = "WeirdIX";
+
+use t::CrazyClass;
+
+my $obj = t::CrazyClass->new();
+
+ok( defined $obj, '$obj is defined' );
+isa_ok( $obj, "t::CrazyClass", '$obj isa t::CrazyClass' );
+isa_ok( $obj, "t::CrazyClass::WeirdIX", '$obj isa t::CrazyClass::WeirdIX' );
+
+is( $obj->mode, "crazy", '$obj->mode' );

Added: branches/upstream/libclass-byos-perl/current/t/CrazyClass.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/t/CrazyClass.pm?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/t/CrazyClass.pm (added)
+++ branches/upstream/libclass-byos-perl/current/t/CrazyClass.pm Tue May  5 16:56:49 2009
@@ -1,0 +1,13 @@
+package t::CrazyClass;
+
+use Class::ByOS;
+
+sub __new
+{
+   my $class = shift;
+   return bless {}, $class;
+}
+
+sub mode { "sane" }
+
+1;

Added: branches/upstream/libclass-byos-perl/current/t/CrazyClass/WeirdIX.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-byos-perl/current/t/CrazyClass/WeirdIX.pm?rev=34803&op=file
==============================================================================
--- branches/upstream/libclass-byos-perl/current/t/CrazyClass/WeirdIX.pm (added)
+++ branches/upstream/libclass-byos-perl/current/t/CrazyClass/WeirdIX.pm Tue May  5 16:56:49 2009
@@ -1,0 +1,7 @@
+package t::CrazyClass::WeirdIX;
+
+use base qw( t::CrazyClass );
+
+sub mode { "crazy" }
+
+1;




More information about the Pkg-perl-cvs-commits mailing list