Frey/Class/Browser.pm

package Frey::Class::Browser;
use Moose;

use lib 'lib';

extends 'Frey::Class::Loader';
with 'Frey::Web', 'Frey::Session', 'Frey::Web::CombineImages', 'Frey::Class::Icon';

use Data::Dump qw/dump/;

has 'usage_sort' => (
        is => 'rw',
        isa => 'Bool',
        default => 0,
        documentation => 'Sort by class usage',
);

has 'usage_on_top' => (
        is => 'rw',
        isa => 'Bool',
        default => 1,
        documentation => 'Show usage on top of list',
);

sub as_markup {
        my $self = shift;
        my $row;
        my @icons;

        my $usage = $self->usage;
        warn "# usage ",dump( $usage );

        my $runnable = $self->load('var/Frey/Class/Browser/runnable.yaml');

        foreach my $class ( $self->classes ) {

                my $icon = $self->icon_path( $class );

                if ($icon) {
                        push @icons, $icon;
                        $icon = qq|<!-- icon:$icon -->|;
                } else {
                        $icon = '';
                }

                my $html
                        = qq|<tr><td>$icon</td><td><a target="$class" href="/$class" title="|
                        . $self->class_path( $class )
                        . qq|">$class</a>
                        <a target="Frey::Class::Graph" title="show class graph" href="/Frey::Class::Graph/as_markup?filter=$class&filter_class=1&filter_extends=0&filter_includes=0&filter_roles=0&show_extends=1&show_includes=1&show_roles=1&layout=dot" class="graph">&#x260D;</a>
                        </td><td>|
                        ;
                if ( $class->can('meta') ) {
                        if ( $class->meta->isa('Moose::Meta::Role') ) {
                                $html .= qq|role|;
                        } else {
                                $html .= qq|<a target="$class" href="/Frey-ObjectDesigner?class=$class">design</a>| if $class->can('collection');
                        }
                }

                my @runnable = ();
                @runnable = @{ $runnable->{ $class } } if defined $runnable->{ $class }; # FIXME needs review
                @runnable = $self->class_runnable( $class ) unless @runnable;

                my @run = map {
                        my $invoke = $_;
                        s{^as_}{};
                        s{_as_\w+}{};
                        qq|<a target="$class" href="/$class/$invoke" title="$class->$invoke">$_</a>|;
                } @runnable;
                push @run, qq|<a target="$class" href="/Frey-ObjectBrowser?class=$class">collection</a>| if $class->can('collection_table');

                my @inputs = $self->class_inputs( $class );

                $usage->{$class} ||= 0;
                $html
                        .= qq|</td><td>|
                        . join(' ', @run)
                        . qq|</td><td>|
                        . ( @inputs ? '&larr; ' . join(' ', @inputs) : '' )
                        . qq|</td><td>|
                        . ( $usage->{$class} || '' )
                        . qq|</td></tr>|
                        ;
                $row->{$class} = $html;
        }

        my $icons_html = $self->combine_images( @icons );
        sub icon {
                my ($icons_html,$path) = @_;
                $icons_html->{ $path } || die "can't find $path in ",dump($icons_html);
        };

        eval {

        $self->title('Frey');

        $self->add_css(qq|
                a.graph {
                        color: #888;
                        text-decoration: none;
                }
        |);

        };
        warn "FIXME: $@" if $@;

        return 
                qq|<table>| . join("\n",
                        map {
                                my $html = $row->{$_};
                                $html =~ s{<!-- icon:(\S+) -->}{icon($icons_html,$1)}gse;
                                $html;
                        }
                        sort {
                                if ( $self->usage_sort && ( $usage->{$a} || $usage->{$b} ) ) {
                                        $self->usage_on_top ? $usage->{$b} <=> $usage->{$a} : $usage->{$a} <=> $usage->{$b};
                                } else {
                                        $self->usage_on_top ? $a cmp $b : $b cmp $a;
                                }
                        }
                        keys %$row
                ) . qq|</table>|;
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;
1	dpavlin	793	package Frey::Class::Browser;
2	dpavlin	119	use Moose;
3
4	dpavlin	1109	use lib 'lib';
5
6	dpavlin	797	extends 'Frey::Class::Loader';
7	dpavlin	1133	with 'Frey::Web', 'Frey::Session', 'Frey::Web::CombineImages', 'Frey::Class::Icon';
8	dpavlin	119
9	dpavlin	434	use Data::Dump qw/dump/;
10	dpavlin	119
11	dpavlin	795	has 'usage_sort' => (
12			is => 'rw',
13			isa => 'Bool',
14			default => 0,
15			documentation => 'Sort by class usage',
16			);
17
18	dpavlin	434	has 'usage_on_top' => (
19			is => 'rw',
20			isa => 'Bool',
21			default => 1,
22			documentation => 'Show usage on top of list',
23			);
24
25	dpavlin	455	sub as_markup {
26	dpavlin	308	my $self = shift;
27	dpavlin	434	my $row;
28	dpavlin	555	my @icons;
29	dpavlin	434
30	dpavlin	1144	my $usage = $self->usage;
31			warn "# usage ",dump( $usage );
32	dpavlin	653
33	dpavlin	821	my $runnable = $self->load('var/Frey/Class/Browser/runnable.yaml');
34
35	dpavlin	308	foreach my $class ( $self->classes ) {
36	dpavlin	531
37	dpavlin	653	my $icon = $self->icon_path( $class );
38	dpavlin	1109
39	dpavlin	555	if ($icon) {
40			push @icons, $icon;
41			$icon = qq\|<!-- icon:$icon -->\|;
42	dpavlin	570	} else {
43			$icon = '';
44	dpavlin	555	}
45	dpavlin	531
46	dpavlin	427	my $html
47	dpavlin	531	= qq\|<tr><td>$icon</td><td><a target="$class" href="/$class" title="\|
48	dpavlin	427	. $self->class_path( $class )
49	dpavlin	1094	. qq\|">$class</a>
50	dpavlin	1100	<a target="Frey::Class::Graph" title="show class graph" href="/Frey::Class::Graph/as_markup?filter=$class&filter_class=1&filter_extends=0&filter_includes=0&filter_roles=0&show_extends=1&show_includes=1&show_roles=1&layout=dot" class="graph">☍</a>
51	dpavlin	1094	</td><td>\|
52	dpavlin	427	;
53	dpavlin	308	if ( $class->can('meta') ) {
54			if ( $class->meta->isa('Moose::Meta::Role') ) {
55	dpavlin	144	$html .= qq\|role\|;
56			} else {
57	dpavlin	531	$html .= qq\|<a target="$class" href="/Frey-ObjectDesigner?class=$class">design</a>\| if $class->can('collection');
58	dpavlin	144	}
59			}
60	dpavlin	459
61	dpavlin	854	my @runnable = ();
62	dpavlin	925	@runnable = @{ $runnable->{ $class } } if defined $runnable->{ $class }; # FIXME needs review
63	dpavlin	821	@runnable = $self->class_runnable( $class ) unless @runnable;
64
65	dpavlin	459	my @run = map {
66	dpavlin	582	my $invoke = $_;
67	dpavlin	459	s{^as_}{};
68	dpavlin	582	s{_as_\w+}{};
69			qq\|<a target="$class" href="/$class/$invoke" title="$class->$invoke">$_</a>\|;
70	dpavlin	821	} @runnable;
71	dpavlin	531	push @run, qq\|<a target="$class" href="/Frey-ObjectBrowser?class=$class">collection</a>\| if $class->can('collection_table');
72	dpavlin	455
73	dpavlin	459	my @inputs = $self->class_inputs( $class );
74
75	dpavlin	434	$usage->{$class} \|\|= 0;
76	dpavlin	427	$html
77			.= qq\|</td><td>\|
78			. join(' ', @run)
79			. qq\|</td><td>\|
80	dpavlin	459	. ( @inputs ? '← ' . join(' ', @inputs) : '' )
81	dpavlin	434	. qq\|</td><td>\|
82			. ( $usage->{$class} \|\| '' )
83	dpavlin	427	. qq\|</td></tr>\|
84			;
85	dpavlin	434	$row->{$class} = $html;
86	dpavlin	144	}
87	dpavlin	434
88	dpavlin	555	my $icons_html = $self->combine_images( @icons );
89			sub icon {
90	dpavlin	570	my ($icons_html,$path) = @_;
91	dpavlin	555	$icons_html->{ $path } \|\| die "can't find $path in ",dump($icons_html);
92			};
93
94	dpavlin	1127	eval {
95	dpavlin	607
96	dpavlin	1127	$self->title('Frey');
97
98	dpavlin	1100	$self->add_css(qq\|
99			a.graph {
100			color: #888;
101			text-decoration: none;
102			}
103			\|);
104
105	dpavlin	1127	};
106			warn "FIXME: $@" if $@;
107
108	dpavlin	434	return
109			qq\|<table>\| . join("\n",
110	dpavlin	555	map {
111			my $html = $row->{$_};
112	dpavlin	570	$html =~ s{<!-- icon:(\S+) -->}{icon($icons_html,$1)}gse;
113	dpavlin	555	$html;
114			}
115	dpavlin	434	sort {
116	dpavlin	795	if ( $self->usage_sort && ( $usage->{$a} \|\| $usage->{$b} ) ) {
117	dpavlin	545	$self->usage_on_top ? $usage->{$b} <=> $usage->{$a} : $usage->{$a} <=> $usage->{$b};
118	dpavlin	434	} else {
119	dpavlin	545	$self->usage_on_top ? $a cmp $b : $b cmp $a;
120	dpavlin	434	}
121			}
122			keys %$row
123			) . qq\|</table>\|;
124	dpavlin	119	}
125
126	dpavlin	1133	__PACKAGE__->meta->make_immutable;
127			no Moose;
128
129	dpavlin	119	1;