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