lib/Catalyst/Helper.pm

   1 package Catalyst::Helper;
   2
   3 use strict;
   4 use warnings;
   5 use base 'Class::Accessor::Fast';
   6 use Config;
   7 use File::Spec;
   8 use File::Path;
   9 use FindBin;
  10 use IO::File;
  11 use POSIX 'strftime';
  12 use Template;
  13 use Catalyst::Devel;
  14 use Catalyst::Utils;
  15 use Catalyst::Exception;
  16 use Path::Class qw/dir file/;
  17 use File::ShareDir qw/dist_dir/;
  18
  19 my %cache;
  20
  21 =head1 NAME
  22
  23 Catalyst::Helper - Bootstrap a Catalyst application
  24
  25 =head1 SYNOPSIS
  26
  27   catalyst.pl <myappname>
  28
  29 =cut
  30
  31 sub get_sharedir_file {
  32     my ($self, @filename) = @_;
  33     my $file = file( dist_dir('Catalyst-Devel'), @filename);
  34     warn $file;
  35     my $contents = $file->slurp;
  36     return $contents;
  37 }
  38
  39 sub get_file {
  40     my ( $self, $file ) = @_;
  41
  42     return $self->get_sharedir_file($file);
  43 }
  44
  45 sub mk_app {
  46     my ( $self, $name ) = @_;
  47
  48     # Needs to be here for PAR
  49     require Catalyst;
  50
  51     if ( $name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
  52         warn "Error: Invalid application name.\n";
  53         return 0;
  54     }
  55     $self->{name            } = $name;
  56     $self->{dir             } = $name;
  57     $self->{dir             } =~ s/\:\:/-/g;
  58     $self->{script          } = File::Spec->catdir( $self->{dir}, 'script' );
  59     $self->{appprefix       } = Catalyst::Utils::appprefix($name);
  60     $self->{appenv          } = Catalyst::Utils::class2env($name);
  61     $self->{startperl       } = -r '/usr/bin/env'
  62                                 ? '#!/usr/bin/env perl'
  63                                 : "#!$Config{perlpath} -w";
  64     $self->{scriptgen       } = $Catalyst::Devel::CATALYST_SCRIPT_GEN || 4;
  65     $self->{catalyst_version} = $Catalyst::VERSION;
  66     $self->{author          } = $self->{author} = $ENV{'AUTHOR'}
  67       || eval { @{ [ getpwuid($<) ] }[6] }
  68       || 'Catalyst developer';
  69
  70     my $gen_scripts  = ( $self->{makefile} ) ? 0 : 1;
  71     my $gen_makefile = ( $self->{scripts} )  ? 0 : 1;
  72     my $gen_app = ( $self->{scripts} || $self->{makefile} ) ? 0 : 1;
  73
  74     if ($gen_app) {
  75         $self->_mk_dirs;
  76         $self->_mk_config;
  77         $self->_mk_appclass;
  78         $self->_mk_rootclass;
  79         $self->_mk_readme;
  80         $self->_mk_changes;
  81         $self->_mk_apptest;
  82         $self->_mk_images;
  83         $self->_mk_favicon;
  84     }
  85     if ($gen_makefile) {
  86         $self->_mk_makefile;
  87     }
  88     if ($gen_scripts) {
  89         $self->_mk_cgi;
  90         $self->_mk_fastcgi;
  91         $self->_mk_server;
  92         $self->_mk_test;
  93         $self->_mk_create;
  94         $self->_mk_information;
  95     }
  96     return $self->{dir};
  97 }
  98
  99 sub mk_component {
 100     my $self = shift;
 101     my $app  = shift;
 102     $self->{app} = $app;
 103     $self->{author} = $self->{author} = $ENV{'AUTHOR'}
 104       || eval { @{ [ getpwuid($<) ] }[6] }
 105       || 'A clever guy';
 106     $self->{base} ||= File::Spec->catdir( $FindBin::Bin, '..' );
 107     unless ( $_[0] =~ /^(?:model|view|controller)$/i ) {
 108         my $helper = shift;
 109         my @args   = @_;
 110         my $class  = "Catalyst::Helper::$helper";
 111         eval "require $class";
 112
 113         if ($@) {
 114             Catalyst::Exception->throw(
 115                 message => qq/Couldn't load helper "$class", "$@"/ );
 116         }
 117
 118         if ( $class->can('mk_stuff') ) {
 119             return 1 unless $class->mk_stuff( $self, @args );
 120         }
 121     }
 122     else {
 123         my $type   = shift;
 124         my $name   = shift || "Missing name for model/view/controller";
 125         my $helper = shift;
 126         my @args   = @_;
 127        return 0 if $name =~ /[^\w\:]/;
 128         $type              = lc $type;
 129         $self->{long_type} = ucfirst $type;
 130         $type              = 'M' if $type =~ /model/i;
 131         $type              = 'V' if $type =~ /view/i;
 132         $type              = 'C' if $type =~ /controller/i;
 133         my $appdir = File::Spec->catdir( split /\:\:/, $app );
 134         my $test_path =
 135           File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, 'C' );
 136         $type = $self->{long_type} unless -d $test_path;
 137         $self->{type}  = $type;
 138         $self->{name}  = $name;
 139         $self->{class} = "$app\::$type\::$name";
 140
 141         # Class
 142         my $path =
 143           File::Spec->catdir( $FindBin::Bin, '..', 'lib', $appdir, $type );
 144         my $file = $name;
 145         if ( $name =~ /\:/ ) {
 146             my @path = split /\:\:/, $name;
 147             $file = pop @path;
 148             $path = File::Spec->catdir( $path, @path );
 149         }
 150         $self->mk_dir($path);
 151         $file = File::Spec->catfile( $path, "$file.pm" );
 152         $self->{file} = $file;
 153
 154         # Test
 155         $self->{test_dir} = File::Spec->catdir( $FindBin::Bin, '..', 't' );
 156         $self->{test}     = $self->next_test;
 157
 158         # Helper
 159         if ($helper) {
 160             my $comp  = $self->{long_type};
 161             my $class = "Catalyst::Helper::$comp\::$helper";
 162             eval "require $class";
 163
 164             if ($@) {
 165                 Catalyst::Exception->throw(
 166                     message => qq/Couldn't load helper "$class", "$@"/ );
 167             }
 168
 169             if ( $class->can('mk_compclass') ) {
 170                 return 1 unless $class->mk_compclass( $self, @args );
 171             }
 172             else { return 1 unless $self->_mk_compclass }
 173
 174             if ( $class->can('mk_comptest') ) {
 175                 $class->mk_comptest( $self, @args );
 176             }
 177             else { $self->_mk_comptest }
 178         }
 179
 180         # Fallback
 181         else {
 182             return 1 unless $self->_mk_compclass;
 183             $self->_mk_comptest;
 184         }
 185     }
 186     return 1;
 187 }
 188
 189 sub mk_dir {
 190     my ( $self, $dir ) = @_;
 191     if ( -d $dir ) {
 192         print qq/ exists "$dir"\n/;
 193         return 0;
 194     }
 195     if ( mkpath [$dir] ) {
 196         print qq/created "$dir"\n/;
 197         return 1;
 198     }
 199
 200     Catalyst::Exception->throw( message => qq/Couldn't create "$dir", "$!"/ );
 201 }
 202
 203 sub mk_file {
 204     my ( $self, $file, $content ) = @_;
 205     if ( -e $file ) {
 206         print qq/ exists "$file"\n/;
 207         return 0
 208           unless ( $self->{'.newfiles'}
 209             || $self->{scripts}
 210             || $self->{makefile} );
 211         if ( $self->{'.newfiles'} ) {
 212             if ( my $f = IO::File->new("< $file") ) {
 213                 my $oldcontent = join( '', (<$f>) );
 214                 return 0 if $content eq $oldcontent;
 215             }
 216             $file .= '.new';
 217         }
 218     }
 219     if ( my $f = IO::File->new("> $file") ) {
 220         binmode $f;
 221         print $f $content;
 222         print qq/created "$file"\n/;
 223         return 1;
 224     }
 225
 226     Catalyst::Exception->throw( message => qq/Couldn't create "$file", "$!"/ );
 227 }
 228
 229 sub next_test {
 230     my ( $self, $tname ) = @_;
 231     if ($tname) { $tname = "$tname.t" }
 232     else {
 233         my $name   = $self->{name};
 234         my $prefix = $name;
 235         $prefix =~ s/::/-/g;
 236         $prefix         = $prefix;
 237         $tname          = $prefix . '.t';
 238         $self->{prefix} = $prefix;
 239         $prefix         = lc $prefix;
 240         $prefix =~ s/-/\//g;
 241         $self->{uri} = "/$prefix";
 242     }
 243     my $dir  = $self->{test_dir};
 244     my $type = lc $self->{type};
 245     $self->mk_dir($dir);
 246     return File::Spec->catfile( $dir, "$type\_$tname" );
 247 }
 248
 249 sub render_file {
 250     my ( $self, $file, $path, $vars ) = @_;
 251     $vars ||= {};
 252     my $t = Template->new;
 253     my $template = $self->get_sharedir_file( 'root', $file );
 254     return 0 unless $template;
 255     my $output;
 256     $t->process( \$template, { %{$self}, %$vars }, \$output )
 257       || Catalyst::Exception->throw(
 258         message => qq/Couldn't process "$file", / . $t->error() );
 259     $self->mk_file( $path, $output );
 260 }
 261
 262 sub _mk_information {
 263     my $self = shift;
 264     print qq/Change to application directory and Run "perl Makefile.PL" to make sure your install is complete\n/;
 265 }
 266
 267 sub _mk_dirs {
 268     my $self = shift;
 269     $self->mk_dir( $self->{dir} );
 270     $self->mk_dir( $self->{script} );
 271     $self->{lib} = File::Spec->catdir( $self->{dir}, 'lib' );
 272     $self->mk_dir( $self->{lib} );
 273     $self->{root} = File::Spec->catdir( $self->{dir}, 'root' );
 274     $self->mk_dir( $self->{root} );
 275     $self->{static} = File::Spec->catdir( $self->{root}, 'static' );
 276     $self->mk_dir( $self->{static} );
 277     $self->{images} = File::Spec->catdir( $self->{static}, 'images' );
 278     $self->mk_dir( $self->{images} );
 279     $self->{t} = File::Spec->catdir( $self->{dir}, 't' );
 280     $self->mk_dir( $self->{t} );
 281
 282     $self->{class} = File::Spec->catdir( split( /\:\:/, $self->{name} ) );
 283     $self->{mod} = File::Spec->catdir( $self->{lib}, $self->{class} );
 284     $self->mk_dir( $self->{mod} );
 285
 286     if ( $self->{short} ) {
 287         $self->{m} = File::Spec->catdir( $self->{mod}, 'M' );
 288         $self->mk_dir( $self->{m} );
 289         $self->{v} = File::Spec->catdir( $self->{mod}, 'V' );
 290         $self->mk_dir( $self->{v} );
 291         $self->{c} = File::Spec->catdir( $self->{mod}, 'C' );
 292         $self->mk_dir( $self->{c} );
 293     }
 294     else {
 295         $self->{m} = File::Spec->catdir( $self->{mod}, 'Model' );
 296         $self->mk_dir( $self->{m} );
 297         $self->{v} = File::Spec->catdir( $self->{mod}, 'View' );
 298         $self->mk_dir( $self->{v} );
 299         $self->{c} = File::Spec->catdir( $self->{mod}, 'Controller' );
 300         $self->mk_dir( $self->{c} );
 301     }
 302     my $name = $self->{name};
 303     $self->{rootname} =
 304       $self->{short} ? "$name\::C::Root" : "$name\::Controller::Root";
 305     $self->{base} = File::Spec->rel2abs( $self->{dir} );
 306 }
 307
 308 sub _mk_appclass {
 309     my $self = shift;
 310     my $mod  = $self->{mod};
 311     $self->render_file( 'appclass.tt', "$mod.pm" );
 312 }
 313
 314 sub _mk_rootclass {
 315     my $self = shift;
 316     $self->render_file( 'rootclass.tt',
 317         File::Spec->catfile( $self->{c}, "Root.pm" ) );
 318 }
 319
 320 sub _mk_makefile {
 321     my $self = shift;
 322     $self->{path} = File::Spec->catfile( 'lib', split( '::', $self->{name} ) );
 323     $self->{path} .= '.pm';
 324     my $dir = $self->{dir};
 325     $self->render_file( 'makefile.tt', "$dir\/Makefile.PL" );
 326
 327     if ( $self->{makefile} ) {
 328
 329         # deprecate the old Build.PL file when regenerating Makefile.PL
 330         $self->_deprecate_file(
 331             File::Spec->catdir( $self->{dir}, 'Build.PL' ) );
 332     }
 333 }
 334
 335 sub _mk_config {
 336     my $self      = shift;
 337     my $dir       = $self->{dir};
 338     my $appprefix = $self->{appprefix};
 339     $self->render_file( 'config.tt',
 340         File::Spec->catfile( $dir, "$appprefix.conf" ) );
 341 }
 342
 343 sub _mk_readme {
 344     my $self = shift;
 345     my $dir  = $self->{dir};
 346     $self->render_file( 'readme.tt', "$dir\/README" );
 347 }
 348
 349 sub _mk_changes {
 350     my $self = shift;
 351     my $dir  = $self->{dir};
 352     my $time = strftime('%Y-%m-%d %H:%M:%S', localtime time);
 353     $self->render_file( 'changes.tt', "$dir\/Changes", { time => $time } );
 354 }
 355
 356 sub _mk_apptest {
 357     my $self = shift;
 358     my $t    = $self->{t};
 359     $self->render_file( 'apptest.tt',         "$t\/01app.t" );
 360     $self->render_file( 'podtest.tt',         "$t\/02pod.t" );
 361     $self->render_file( 'podcoveragetest.tt', "$t\/03podcoverage.t" );
 362 }
 363
 364 sub _mk_cgi {
 365     my $self      = shift;
 366     my $script    = $self->{script};
 367     my $appprefix = $self->{appprefix};
 368     $self->render_file( 'cgi.tt', "$script\/$appprefix\_cgi.pl" );
 369     chmod 0700, "$script/$appprefix\_cgi.pl";
 370 }
 371
 372 sub _mk_fastcgi {
 373     my $self      = shift;
 374     my $script    = $self->{script};
 375     my $appprefix = $self->{appprefix};
 376     $self->render_file( 'fastcgi.tt', "$script\/$appprefix\_fastcgi.pl" );
 377     chmod 0700, "$script/$appprefix\_fastcgi.pl";
 378 }
 379
 380 sub _mk_server {
 381     my $self      = shift;
 382     my $script    = $self->{script};
 383     my $appprefix = $self->{appprefix};
 384     $self->render_file( 'server.tt', "$script\/$appprefix\_server.pl" );
 385     chmod 0700, "$script/$appprefix\_server.pl";
 386 }
 387
 388 sub _mk_test {
 389     my $self      = shift;
 390     my $script    = $self->{script};
 391     my $appprefix = $self->{appprefix};
 392     $self->render_file( 'test.tt', "$script/$appprefix\_test.pl" );
 393     chmod 0700, "$script/$appprefix\_test.pl";
 394 }
 395
 396 sub _mk_create {
 397     my $self      = shift;
 398     my $script    = $self->{script};
 399     my $appprefix = $self->{appprefix};
 400     $self->render_file( 'create.tt', "$script\/$appprefix\_create.pl" );
 401     chmod 0700, "$script/$appprefix\_create.pl";
 402 }
 403
 404 sub _mk_compclass {
 405     my $self = shift;
 406     my $file = $self->{file};
 407     return $self->render_file( 'compclass.tt', "$file" );
 408 }
 409
 410 sub _mk_comptest {
 411     my $self = shift;
 412     my $test = $self->{test};
 413     $self->render_file( 'comptest.tt', "$test" );
 414 }
 415
 416 sub _mk_images {
 417     my $self   = shift;
 418     my $images = $self->{images};
 419     my @images =
 420       qw/catalyst_logo btn_120x50_built btn_120x50_built_shadow
 421       btn_120x50_powered btn_120x50_powered_shadow btn_88x31_built
 422       btn_88x31_built_shadow btn_88x31_powered btn_88x31_powered_shadow/;
 423     for my $name (@images) {
 424         my $image = $self->get_file("$name.png");
 425         $self->mk_file( File::Spec->catfile( $images, "$name.png" ), $image );
 426     }
 427 }
 428
 429 sub _mk_favicon {
 430     my $self    = shift;
 431     my $root    = $self->{root};
 432     my $favicon = $self->get_sharedir_file( 'root', 'favicon.ico' );
 433     my $dest = File::Spec->catfile( $root, "favicon.ico" );
 434     $self->mk_file( $dest, $favicon );
 435
 436 }
 437
 438 sub _deprecate_file {
 439     my ( $self, $file ) = @_;
 440     if ( -e $file ) {
 441         my $oldcontent;
 442         if ( my $f = IO::File->new("< $file") ) {
 443             $oldcontent = join( '', (<$f>) );
 444         }
 445         my $newfile = $file . '.deprecated';
 446         if ( my $f = IO::File->new("> $newfile") ) {
 447             binmode $f;
 448             print $f $oldcontent;
 449             print qq/created "$newfile"\n/;
 450             unlink $file;
 451             print qq/removed "$file"\n/;
 452             return 1;
 453         }
 454         Catalyst::Exception->throw(
 455             message => qq/Couldn't create "$file", "$!"/ );
 456     }
 457 }
 458
 459 =head1 DESCRIPTION
 460
 461 This module is used by B<catalyst.pl> to create a set of scripts for a
 462 new catalyst application. The scripts each contain documentation and
 463 will output help on how to use them if called incorrectly or in some
 464 cases, with no arguments.
 465
 466 It also provides some useful methods for a Helper module to call when
 467 creating a component. See L</METHODS>.
 468
 469 =head1 SCRIPTS
 470
 471 =head2 _create.pl
 472
 473 Used to create new components for a catalyst application at the
 474 development stage.
 475
 476 =head2 _server.pl
 477
 478 The catalyst test server, starts an HTTPD which outputs debugging to
 479 the terminal.
 480
 481 =head2 _test.pl
 482
 483 A script for running tests from the command-line.
 484
 485 =head2 _cgi.pl
 486
 487 Run your application as a CGI.
 488
 489 =head2 _fastcgi.pl
 490
 491 Run the application as a fastcgi app. Either by hand, or call this
 492 from FastCgiServer in your http server config.
 493
 494 =head1 HELPERS
 495
 496 The L</_create.pl> script creates application components using Helper
 497 modules. The Catalyst team provides a good number of Helper modules
 498 for you to use. You can also add your own.
 499
 500 Helpers are classes that provide two methods.
 501
 502     * mk_compclass - creates the Component class
 503     * mk_comptest  - creates the Component test
 504
 505 So when you call C<scripts/myapp_create.pl view MyView TT>, create
 506 will try to execute Catalyst::Helper::View::TT->mk_compclass and
 507 Catalyst::Helper::View::TT->mk_comptest.
 508
 509 See L<Catalyst::Helper::View::TT> and
 510 L<Catalyst::Helper::Model::DBIC::Schema> for examples.
 511
 512 All helper classes should be under one of the following namespaces.
 513
 514     Catalyst::Helper::Model::
 515     Catalyst::Helper::View::
 516     Catalyst::Helper::Controller::
 517
 518 =head2 COMMON HELPERS
 519
 520 =over
 521
 522 =item *
 523
 524 L<Catalyst::Helper::Model::DBIC::Schema> - DBIx::Class models
 525
 526 =item *
 527
 528 L<Catalyst::Helper::View::TT> - Template Toolkit view
 529
 530 =item *
 531
 532 L<Catalyst::Helper::Model::LDAP>
 533
 534 =item *
 535
 536 L<Catalyst::Helper::Model::Adaptor> - wrap any class into a Catalyst model
 537
 538 =back
 539
 540 =head3 NOTE
 541
 542 The helpers will read author name from /etc/passwd by default. + To override, please export the AUTHOR variable.
 543
 544 =head1 METHODS
 545
 546 =head2 mk_compclass
 547
 548 This method in your Helper module is called with C<$helper>
 549 which is a L<Catalyst::Helper> object, and whichever other arguments
 550 the user added to the command-line. You can use the $helper to call methods
 551 described below.
 552
 553 If the Helper module does not contain a C<mk_compclass> method, it
 554 will fall back to calling L</render_file>, with an argument of
 555 C<compclass>.
 556
 557 =head2 mk_comptest
 558
 559 This method in your Helper module is called with C<$helper>
 560 which is a L<Catalyst::Helper> object, and whichever other arguments
 561 the user added to the command-line. You can use the $helper to call methods
 562 described below.
 563
 564 If the Helper module does not contain a C<mk_compclass> method, it
 565 will fall back to calling L</render_file>, with an argument of
 566 C<comptest>.
 567
 568 =head2 mk_stuff
 569
 570 This method is called if the user does not supply any of the usual
 571 component types C<view>, C<controller>, C<model>. It is passed the
 572 C<$helper> object (an instance of L<Catalyst::Helper>), and any other
 573 arguments the user typed.
 574
 575 There is no fallback for this method.
 576
 577 =head1 INTERNAL METHODS
 578
 579 These are the methods that the Helper classes can call on the
 580 <$helper> object passed to them.
 581
 582 =head2 render_file ($file, $path, $vars)
 583
 584 Render and create a file from a template in DATA using Template
 585 Toolkit. $file is the relevent chunk of the __DATA__ section, $path is
 586 the path to the file and $vars is the hashref as expected by
 587 L<Template Toolkit|Template>.
 588
 589 =head2 get_file ($class, $file)
 590
 591 Fetch file contents from the DATA section. This is used internally by
 592 L</render_file>.  $class is the name of the class to get the DATA
 593 section from.  __PACKAGE__ or ( caller(0) )[0] might be sensible
 594 values for this.
 595
 596 =head2 mk_app
 597
 598 Create the main application skeleton. This is called by L<catalyst.pl>.
 599
 600 =head2 mk_component ($app)
 601
 602 This method is called by L<create.pl> to make new components
 603 for your application.
 604
 605 =head3 mk_dir ($path)
 606
 607 Surprisingly, this function makes a directory.
 608
 609 =head2 mk_file ($file, $content)
 610
 611 Writes content to a file. Called by L</render_file>.
 612
 613 =head2 next_test ($test_name)
 614
 615 Calculates the name of the next numbered test file and returns it.
 616 Don't give the number or the .t suffix for the test name.
 617
 618 =head1 NOTE
 619
 620 The helpers will read author name from /etc/passwd by default.
 621 To override, please export the AUTHOR variable.
 622
 623 =head1 SEE ALSO
 624
 625 L<Catalyst::Manual>, L<Catalyst::Test>, L<Catalyst::Request>,
 626 L<Catalyst::Response>, L<Catalyst>
 627
 628 =head1 AUTHORS
 629
 630 Catalyst Contributors, see Catalyst.pm
 631
 632 =head1 LICENSE
 633
 634 This library is free software. You can redistribute it and/or modify
 635 it under the same terms as Perl itself.
 636
 637 =begin pod_to_ignore
 638
 639 =cut
 640
 641 1;
 642