libsys-info-base-perl 0.7804-1 / usr / share / perl5 / Sys / Info / Helper.pm

package Sys::Info::Helper;
use 5.006;
use strict;
use warnings;
use vars qw( $VERSION @EXPORT );
use base qw(Exporter);
use File::Spec::Functions qw( catdir catfile );
use File::Path;
use File::Basename;
use Cwd;
use Carp qw( croak );
use Data::Dumper;
use Text::Template::Simple;

$VERSION = '0.7804';
@EXPORT  = qw( new_driver );

sub new {
    my($class, @args) = @_;
    my $self  = {
        @args % 2 ? () : @args,
    };
    bless $self, $class;
    return $self;
}

sub new_driver {
    my $os   = shift || croak 'OS name?';
    my $you  = shift || 'Your Name';
    my $self = __PACKAGE__->new( os => $os, you => $you );
    my $mb   = catdir qw( lib Sys Info Driver );
    my %file = (
        catfile( $mb, "$os.pm"               ) => $self->_template( 'base'    ),
        catfile( $mb, $os, 'OS.pm'           ) => $self->_template( 'os'      ),
        catfile( $mb, $os, 'Device.pm'       ) => $self->_template( 'device'  ),
        catfile( $mb, $os, 'Device', 'CPU.pm') => $self->_template( 'cpu'     ),
        catfile( qw( t 01-basic.t )          ) => $self->_template( 't'       ),
        'Changes'                              => $self->_template( 'changes' ),
        'README'                               => $self->_template( 'readme'  ),
    );
    $file{MANIFEST} = $self->_manifest( \%file );
    return print Dumper( \%file );
}

sub _write_files {}

sub _manifest {
    my($self, $file) = @_;
    my @list = keys %{ $file };
    return join "\n", map { s{\\}{/}xmsg; $_ } sort @list;
}

sub _template {
    my($self, $target) = @_;
    my $meth = '_template_' . $target;
    croak "$target is not a valid target" if ! $self->can( $meth );
    my $id = $self->{os};
    my $you = $self->{you};
    my $date = localtime time;
    my $year = (localtime time)[5] + 1900;
    my $perlv = $];
    my $tmp = $self->$meth();
    $tmp =~ s{<%ID%>}{$id}xmsg;
    $tmp =~ s{<%DATE%>}{$date}xmsg;
    $tmp =~ s{<%YEAR%>}{$year}xmsg;
    $tmp =~ s{<%PERLV%>}{$perlv}xmsg;
    $tmp =~ s{<%YOU%>}{$you}xmsg;
    return $tmp;
}

sub _template_readme {
    my $self = shift;
    return <<'TEMPLATE';
Sys::Info::Driver::<%ID%>
========================

<%ID%> driver for Sys::Info.

Read the module's POD for documentation.
See the tests for examples.

INSTALLATION

To install this module type the following:

   perl Makefile.PL
   make
   make test
   make install

or under Windows:

   perl Makefile.PL
   nmake
   nmake test
   nmake install

COPYRIGHT

Copyright (c) <%YEAR%> <%YOU%>. All rights reserved.

LICENSE

This library is free software; you can redistribute it and/or modify 
it under the same terms as Perl itself, either Perl version <%PERLV%> or, 
at your option, any later version of Perl 5 you may have available.
TEMPLATE
}

sub _template_changes {
    my $self = shift;
    return <<'TEMPLATE';
Revision history for Perl extension Sys::Info::Driver::<%ID%>.

0.10 <%DATE%>
    => Initial release.

TEMPLATE
}

sub _template_device {
    my $self = shift;
    return <<'TEMPLATE';
package Sys::Info::Driver::<%ID%>::Device;
use strict;
use warnings;
use vars qw( $VERSION );

$VERSION = '0.10';

1;

__END__

=head1 NAME

Sys::Info::Driver::<%ID%>::Device - Base class for <%ID%> device drivers

=head1 SYNOPSIS

    use base qw( Sys::Info::Driver::<%ID%>::Device );

=head1 DESCRIPTION

This document describes version C<0.7804> of C<Sys::Info::Helper>
released on C<21 January 2015>.

Base class for <%ID%> device drivers.

=head1 AUTHOR

Burak Gursoy <burak@cpan.org>.

=head1 COPYRIGHT

Copyright 2006 - 2015 Burak Gursoy. All rights reserved.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.16.2 or,
at your option, any later version of Perl 5 you may have available.
=cut

TEMPLATE
}

sub _template_base {
    my $self = shift;
    return <<'TEMPLATE';
package Sys::Info::Driver::<%ID%>;
use strict;
use warnings;
use vars qw( $VERSION );

$VERSION = '0.10';

1;

__END__

=head1 NAME

Sys::Info::Driver::<%ID%> - <%ID%> driver for Sys::Info

=head1 SYNOPSIS

    use Sys::Info::Driver::<%ID%>;

=head1 DESCRIPTION

This is the main module in the C<<%ID%>> driver collection.

=cut
TEMPLATE
}

sub _template_cpu {
    my $self = shift;
    return <<'TEMPLATE';
package Sys::Info::Driver::<%ID%>::Device::CPU;
use strict;
use warnings;
use vars qw($VERSION);
use base qw(Sys::Info::Base);

$VERSION = '0.10';

sub identify { }

sub bitness { }

sub load { }

1;

__END__

=head1 NAME

Sys::Info::Driver::<%ID%>::Device::CPU - <%ID%> CPU Device Driver

=head1 SYNOPSIS

-

=head1 DESCRIPTION

Identifies the CPU.

=head1 METHODS

=head2 identify

See identify in L<Sys::Info::Device::CPU>.

=head2 load

See load in L<Sys::Info::Device::CPU>.

=head2 bitness

See bitness in L<Sys::Info::Device::CPU>.

=head1 SEE ALSO

L<Sys::Info>, L<Sys::Info::Device::CPU>.

=cut
TEMPLATE
}

sub _template_t {
    my $self = shift;
    return <<'TEMPLATE';
#!/usr/bin/env perl
use strict;
use warnings;
use Test::Sys::Info;

driver_ok('<%ID%>');
TEMPLATE
}

sub _template_os {
    my $self = shift;
    return <<'TEMPLATE';
package Sys::Info::Driver::<%ID%>::OS;
use strict;
use warnings;
use vars qw( $VERSION );
use base qw( Sys::Info::Base );

$VERSION = '0.10';

sub init {
    my $self = shift;
    # initialize here, if necessary
    return;
}

sub logon_server {}

sub edition { }

sub tz { }

sub meta { }

sub tick_count { }

sub name { }

sub version { }

sub build { }

sub uptime { }

sub is_root { }

sub login_name { }

sub node_name { }

sub domain_name { }

sub fs { }

sub bitness { }

1;

__END__

=pod

=head1 NAME

Sys::Info::Driver::<%ID%>::OS - <%ID%> backend

=head1 SYNOPSIS

-

=head1 DESCRIPTION

-

=head1 METHODS

Please see L<Sys::Info::OS> for definitions of these methods and more.

=head2 build

=head2 domain_name

=head2 edition

=head2 fs

=head2 is_root

=head2 login_name

=head2 logon_server

=head2 meta

=head2 name

=head2 node_name

=head2 tick_count

=head2 tz

=head2 uptime

=head2 version

=head2 bitness

=head1 SEE ALSO

L<Sys::Info>, L<Sys::Info::OS>.
=cut

TEMPLATE
}

1;

__END__

=pod

=head1 NAME 

Sys::Info::Helper - Helps to create new Sys::Info drivers.

=head1 SYNOPSIS

=head1 DESCRIPTION

=head1 METHODS

=head2 new

=head1 FUNCTIONS

=head2 new_driver

=head1 SEE ALSO

L<Sys::Info>.

=cut