properly order the options returned by db_options()
[bse.git] / site / cgi-bin / modules / BSE / Variables.pm
CommitLineData
234312d8
TC
1package BSE::Variables;
2use strict;
3use Scalar::Util qw(blessed);
69dfe3a1 4use BSE::TB::Site;
464d00ea 5use BSE::Util::HTML;
234312d8 6
464d00ea 7our $VERSION = "1.002";
234312d8
TC
8
9sub variables {
10 my ($self, %opts) = @_;
11 my $site;
12 return
13 {
14 site => BSE::TB::Site->new,
15 url =>
16 ($opts{admin} || $opts{admin_links}
464d00ea
TC
17 ? sub { _url_common($_[0]->admin, $_[1]) }
18 : sub { _url_common($_[0]->link, $_[1]) }
234312d8
TC
19 ),
20 admin => $opts{admin},
21 admin_links => $opts{admin_links},
22 dumper => sub {
23 require Data::Dumper;
24 return escape_html(Data::Dumper::Dumper(shift));
25 },
26 categorize_tags => \&_categorize_tags,
27 };
28}
29
464d00ea
TC
30sub _url_common {
31 my ($base, $extras) = @_;
32
33 if ($extras && ref $extras) {
34 my @extras;
35 for my $key (keys %$extras) {
36 my $value = $extras->{$key};
37 if (ref $value) {
38 push @extras, map { "$key=" . escape_uri($_) } @$value;
39 }
40 else {
41 push @extras, "$key=" . escape_uri($value);
42 }
43 }
44
45 if (@extras) {
46 $base .= $base =~ /\?/ ? "&" : "?";
47 $base .= join("&", @extras);
48 }
49 }
50
51 return $base;
52}
53
234312d8
TC
54sub _categorize_tags {
55 my ($tags) = @_;
56
57 $DB::single = 1;
58 require BSE::TB::Tags;
59 my %cats;
60 for my $tag (@$tags) {
61 my $work = blessed $tag ? $tag->json_data : $tag;
62 my $cat = lc $tag->{cat};
63 unless ($cats{$cat}) {
64 $cats{$cat} =
65 {
66 name => $tag->{cat},
67 tags => [],
68 };
69 }
70 push @{$cats{$cat}{tags}}, $tag;
71 }
72
73 for my $cat (values %cats) {
74 @{$cat->{tags}} = sort { lc $a->{val} cmp lc $b->{val} } @{$cat->{tags}};
75 }
76
77 return [ sort { lc $a->{name} cmp $b->{name} } values %cats ];
78}
79
801;
81
82=head1 NAME
83
84BSE::Variables - commonly set variables
85
86=head1 SYNOPSIS
87
88 # in perl code
89 require BSE::Variables;
90 $foo->set_variable(bse => BSE::Variables->variables(%opts));
91
92 # in templates
93 <:.set level1 = bse.site.children :>
94 <:= url(article) | html :>
95 <:= tagcats = bse.categorize_tags(article.tag_objects) :>
96 <:.if bse.admin:>...
97 <:= dumper(somevar) :> lots of noise
98
99=head1 DESCRIPTION
100
101Common BSE functionality for use from the new template tags.
102
103=over
104
105=item bse.site
106
107a BSE::TB::Site object, behaves like an article in owning files and
108images, and having children.w
109
110=item bse.url(somearticle)
111
464d00ea
TC
112=item bse.url(somearticle, extraargs)
113
234312d8
TC
114Return the article admin link in admin (or admin_links) mode,
115otherwise the normal article link.
116
464d00ea
TC
117If supplied, C<extraargs> should be a hash containing extra arguments.
118
234312d8
TC
119=item bse.admin
120
121Return true in admin mode.
122
123=item bse.admin_links
124
125Return true in admin_links mode
126
127=item dumper(value)
128
129Dump the value in perl syntax using L<Data::Dumper>.
130
131=item categorize_keys(tags)
132
133Returns the given tags as a list of tag categories, each category has
134a name (of the category) and a list of tags in that category.
135
136=back
137
138=head1 AUTHOR
139
140Tony Cook <tony@develop-help.com>
141
142=cut