1package Sys::Info::Helper;
2$Sys::Info::Helper::VERSION = '0.7807';
3use strict;
4use warnings;
5use base qw(Exporter);
6use File::Spec::Functions qw( catdir catfile );
7use File::Path;
8use File::Basename;
9use Cwd;
10use Carp qw( croak );
11use Data::Dumper;
12use Text::Template::Simple;
13
14our @EXPORT  = qw( new_driver );
15
16sub new {
17    my($class, @args) = @_;
18    my $self  = {
19        @args % 2 ? () : @args,
20    };
21    bless $self, $class;
22    return $self;
23}
24
25sub new_driver {
26    my $os   = shift || croak 'OS name?';
27    my $you  = shift || 'Your Name';
28    my $self = __PACKAGE__->new( os => $os, you => $you );
29    my $mb   = catdir qw( lib Sys Info Driver );
30    my %file = (
31        catfile( $mb, "$os.pm"               ) => $self->_template( 'base'    ),
32        catfile( $mb, $os, 'OS.pm'           ) => $self->_template( 'os'      ),
33        catfile( $mb, $os, 'Device.pm'       ) => $self->_template( 'device'  ),
34        catfile( $mb, $os, 'Device', 'CPU.pm') => $self->_template( 'cpu'     ),
35        catfile( qw( t 01-basic.t )          ) => $self->_template( 't'       ),
36        'Changes'                              => $self->_template( 'changes' ),
37        'README'                               => $self->_template( 'readme'  ),
38    );
39    $file{MANIFEST} = $self->_manifest( \%file );
40    return print Dumper( \%file );
41}
42
43sub _write_files {}
44
45sub _manifest {
46    my($self, $file) = @_;
47    my @list = keys %{ $file };
48    return join "\n", map { s{\\}{/}xmsg; $_ } sort @list;
49}
50
51sub _template {
52    my($self, $target) = @_;
53    my $meth = '_template_' . $target;
54    croak "$target is not a valid target" if ! $self->can( $meth );
55    my $id = $self->{os};
56    my $you = $self->{you};
57    my $date = localtime time;
58    my $year = (localtime time)[5] + 1900;
59    my $perlv = $];
60    my $tmp = $self->$meth();
61    $tmp =~ s{<%ID%>}{$id}xmsg;
62    $tmp =~ s{<%DATE%>}{$date}xmsg;
63    $tmp =~ s{<%YEAR%>}{$year}xmsg;
64    $tmp =~ s{<%PERLV%>}{$perlv}xmsg;
65    $tmp =~ s{<%YOU%>}{$you}xmsg;
66    return $tmp;
67}
68
69sub _template_readme {
70    my $self = shift;
71    return <<'TEMPLATE';
72Sys::Info::Driver::<%ID%>
73========================
74
75<%ID%> driver for Sys::Info.
76
77Read the module's POD for documentation.
78See the tests for examples.
79
80INSTALLATION
81
82To install this module type the following:
83
84   perl Makefile.PL
85   make
86   make test
87   make install
88
89or under Windows:
90
91   perl Makefile.PL
92   nmake
93   nmake test
94   nmake install
95
96COPYRIGHT
97
98Copyright (c) <%YEAR%> <%YOU%>. All rights reserved.
99
100LICENSE
101
102This library is free software; you can redistribute it and/or modify
103it under the same terms as Perl itself, either Perl version <%PERLV%> or,
104at your option, any later version of Perl 5 you may have available.
105TEMPLATE
106}
107
108sub _template_changes {
109    my $self = shift;
110    return <<'TEMPLATE';
111Revision history for Perl extension Sys::Info::Driver::<%ID%>.
112
1130.10 <%DATE%>
114    => Initial release.
115
116TEMPLATE
117}
118
119sub _template_device {
120    my $self = shift;
121    return <<'TEMPLATE';
122package Sys::Info::Driver::<%ID%>::Device;
123use strict;
124use warnings;
125use vars qw( $VERSION );
126
127$VERSION = '0.10';
128
1291;
130
131__END__
132
133=head1 NAME
134
135Sys::Info::Driver::<%ID%>::Device - Base class for <%ID%> device drivers
136
137=head1 SYNOPSIS
138
139    use base qw( Sys::Info::Driver::<%ID%>::Device );
140
141=head1 DESCRIPTION
142
143Base class for <%ID%> device drivers.
144
145=cut
146
147TEMPLATE
148}
149
150sub _template_base {
151    my $self = shift;
152    return <<'TEMPLATE';
153package Sys::Info::Driver::<%ID%>;
154use strict;
155use warnings;
156use vars qw( $VERSION );
157
158$VERSION = '0.10';
159
1601;
161
162__END__
163
164=head1 NAME
165
166Sys::Info::Driver::<%ID%> - <%ID%> driver for Sys::Info
167
168=head1 SYNOPSIS
169
170    use Sys::Info::Driver::<%ID%>;
171
172=head1 DESCRIPTION
173
174This is the main module in the C<<%ID%>> driver collection.
175
176=cut
177TEMPLATE
178}
179
180sub _template_cpu {
181    my $self = shift;
182    return <<'TEMPLATE';
183package Sys::Info::Driver::<%ID%>::Device::CPU;
184use strict;
185use warnings;
186use vars qw($VERSION);
187use base qw(Sys::Info::Base);
188
189$VERSION = '0.10';
190
191sub identify { }
192
193sub bitness { }
194
195sub load { }
196
1971;
198
199__END__
200
201=head1 NAME
202
203Sys::Info::Driver::<%ID%>::Device::CPU - <%ID%> CPU Device Driver
204
205=head1 SYNOPSIS
206
207-
208
209=head1 DESCRIPTION
210
211Identifies the CPU.
212
213=head1 METHODS
214
215=head2 identify
216
217See identify in L<Sys::Info::Device::CPU>.
218
219=head2 load
220
221See load in L<Sys::Info::Device::CPU>.
222
223=head2 bitness
224
225See bitness in L<Sys::Info::Device::CPU>.
226
227=head1 SEE ALSO
228
229L<Sys::Info>, L<Sys::Info::Device::CPU>.
230
231=cut
232TEMPLATE
233}
234
235sub _template_t {
236    my $self = shift;
237    return <<'TEMPLATE';
238#!/usr/bin/env perl
239use strict;
240use warnings;
241use Test::Sys::Info;
242
243driver_ok('<%ID%>');
244TEMPLATE
245}
246
247sub _template_os {
248    my $self = shift;
249    return <<'TEMPLATE';
250package Sys::Info::Driver::<%ID%>::OS;
251use strict;
252use warnings;
253use vars qw( $VERSION );
254use base qw( Sys::Info::Base );
255
256$VERSION = '0.10';
257
258sub init {
259    my $self = shift;
260    # initialize here, if necessary
261    return;
262}
263
264sub logon_server {}
265
266sub edition { }
267
268sub tz { }
269
270sub meta { }
271
272sub tick_count { }
273
274sub name { }
275
276sub version { }
277
278sub build { }
279
280sub uptime { }
281
282sub is_root { }
283
284sub login_name { }
285
286sub node_name { }
287
288sub domain_name { }
289
290sub fs { }
291
292sub bitness { }
293
2941;
295
296__END__
297
298=pod
299
300=head1 NAME
301
302Sys::Info::Driver::<%ID%>::OS - <%ID%> backend
303
304=head1 SYNOPSIS
305
306-
307
308=head1 DESCRIPTION
309
310-
311
312=head1 METHODS
313
314Please see L<Sys::Info::OS> for definitions of these methods and more.
315
316=head2 build
317
318=head2 domain_name
319
320=head2 edition
321
322=head2 fs
323
324=head2 is_root
325
326=head2 login_name
327
328=head2 logon_server
329
330=head2 meta
331
332=head2 name
333
334=head2 node_name
335
336=head2 tick_count
337
338=head2 tz
339
340=head2 uptime
341
342=head2 version
343
344=head2 bitness
345
346=head1 SEE ALSO
347
348L<Sys::Info>, L<Sys::Info::OS>.
349=cut
350
351TEMPLATE
352}
353
3541;
355
356__END__
357
358=pod
359
360=encoding UTF-8
361
362=head1 NAME
363
364Sys::Info::Helper
365
366=head1 VERSION
367
368version 0.7807
369
370=head1 SYNOPSIS
371
372=head1 DESCRIPTION
373
374=head1 NAME
375
376Sys::Info::Helper - Helps to create new Sys::Info drivers.
377
378=head1 METHODS
379
380=head2 new
381
382=head1 FUNCTIONS
383
384=head2 new_driver
385
386=head1 SEE ALSO
387
388L<Sys::Info>.
389
390=head1 AUTHOR
391
392Burak Gursoy <burak@cpan.org>
393
394=head1 COPYRIGHT AND LICENSE
395
396This software is copyright (c) 2006 by Burak Gursoy.
397
398This is free software; you can redistribute it and/or modify it under
399the same terms as the Perl 5 programming language system itself.
400
401=cut
402