/[Frey]/trunk/lib/Frey/ClassCreator.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/lib/Frey/ClassCreator.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 703 - (hide annotations)
Wed Dec 3 21:24:09 2008 UTC (13 years, 8 months ago) by dpavlin
File size: 1936 byte(s)
rename
1 dpavlin 679 package Frey::ClassCreator;
2     use Moose;
3    
4     extends 'Frey';
5     with 'Frey::Web';
6     with 'Frey::Path';
7     #with 'Frey::Storage';
8    
9     use File::Slurp;
10    
11     has class => (
12     documentation => 'Name of class to create',
13     is => 'rw',
14     isa => 'Str',
15     required => 1,
16     default => 'Frey::Skeleton',
17     );
18    
19     has svk_add => (
20     documentation => 'Add created files to SVK',
21     is => 'rw',
22     isa => 'Bool',
23     required => 1,
24     default => 0,
25     );
26    
27 dpavlin 680 sub create_class_source_as_markup {
28 dpavlin 679 my ($self) = @_;
29    
30     my $class = $self->class;
31    
32     my $class_path = $class;
33     $class_path =~ s{::}{/}g;
34     $class_path = "lib/$class.pm";
35    
36     my $test_path = $class;
37     $test_path =~ s{::}{-};
38     $test_path = "t/30-$test_path.t";
39    
40 dpavlin 682 die qq|class "$class" exists as |, $self->path_size($class_path) if -e $class_path;
41     die qq|class "$class" test exists as |, $self->path_size($test_path) if -e $test_path;
42 dpavlin 679
43     warn "## path $class_path";
44     $self->mkbasepath( $class_path );
45    
46     my $skeleton = 'Frey::Skeleton';
47    
48     my $code = read_file( 'lib/Frey/Skeleton.pm' );
49     $code =~ s{$skeleton}{$class}g;
50     write_file( $class_path, $code );
51 dpavlin 682 warn "# created class $class at ", $self->path_size($class_path);
52 dpavlin 679 system "svk add $class_path" if $self->svk_add;
53    
54     $code = read_file( 't/30-frey-skeleton.t' );
55     $code =~ s{$skeleton}{$class}g;
56     write_file( $test_path, $code );
57 dpavlin 680 chmod 0755, $test_path;
58 dpavlin 682 warn "# created class $class at ", $self->path_size($test_path);
59 dpavlin 679 system "svk add $test_path" if $self->svk_add;
60    
61 dpavlin 680 my $html
62 dpavlin 682 = qq|Created class "$class" at |
63     . $self->path_size($class_path)
64     . qq| and test |
65     . $self->path_size($test_path)
66 dpavlin 680 ;
67    
68 dpavlin 703 $html = $self->html_links( $html );
69 dpavlin 680
70     return $html;
71 dpavlin 679 }
72    
73     =head1 DESCRIPTION
74    
75     Create Frey class based on L<Frey::Skeleton>.
76    
77     Blame this on my Smalltalk influence, because creating classes there is just
78     interface and message sends wrapped in GUI, but that makes Smalltalk books
79     much harder to read...
80    
81     On the other hand, having handy class creator within L<Frey> makes sense.
82    
83     =cut
84    
85     1;

  ViewVC Help
Powered by ViewVC 1.1.26