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