package Bric::Biz::OutputChannel; ############################################################################### =head1 NAME Bric::Biz::OutputChannel - Bricolage Output Channels. =head1 VERSION $LastChangedRevision$ =cut require Bric; our $VERSION = Bric->VERSION; =head1 DATE $LastChangedDate: 2006-05-12 16:54:43 +0200 (Fri, 12 May 2006) $ =head1 SYNOPSIS use Bric::Biz::OutputChannel; # Constructors. $oc = Bric::Biz::OutputChannel->new($init); $oc = Bric::Biz::OutputChannel->lookup({ id => $id}); my $ocs_aref = Bric::Biz::OutputChannel->list($params); my @ocs = Bric::Biz::OutputChannel->list($params); # Class Methods. my $id_aref = Bric::Biz::OutputChannel->list_ids($params); my @ids = Bric::Biz::OutputChannel->list_ids($params); # Instance Methods. $id = $oc->get_id; my $name = $oc->get_name; $oc = $oc->set_name( $name ); my $description = $oc->get_description; $oc = $oc->set_description($description); if ($oc->get_primary) { # do stuff } $oc = $oc->set_primary(1); # or pass undef. my $site_id = $oc->get_site_id; $site = $site->set_site_id($site_id); my $protocol = $oc->get_protocol; $site = $site->set_protocol($protocol); # URI Format instance methods. my $uri_format = $oc->get_uri_format; $oc->set_uri_format($uri_format); my $fixed_uri_format = $oc->get_fixed_uri_format; $oc->set_fixed_uri_format($uri_fixed_format); my $uri_case = $oc->get_uri_case; $oc->set_uri_case($uri_case); if ($oc->can_use_slug) { # do stuff } $oc->use_slug_on; $oc->use_slug_off; # Output Channel Includes instance methods. my @ocs = $oc->get_includes; $oc->set_includes(@ocs); $oc->add_includes(@ocs); $oc->del_includes(@ocs); # Active instance methods. $oc = $oc->activate; $oc = $oc->deactivate; $oc = $oc->is_active; # Persistence methods. $oc = $oc->save; =head1 DESCRIPTION Holds information about the output channels that will be associated with templates and elements. =cut #============================================================================== ## Dependencies # #======================================# #--------------------------------------# # Standard Dependencies. use strict; #--------------------------------------# # Programatic Dependencies. use Bric::Config qw(:oc); use Bric::Util::DBI qw(:all); use Bric::Util::Grp::OutputChannel; use Bric::Util::Coll::OCInclude; use Bric::Util::Fault qw(throw_gen throw_dp); use List::Util 'first'; #============================================================================== ## Inheritance # #======================================# use base qw(Bric Exporter); our %EXPORT_TAGS = ( case_constants => [qw(MIXEDCASE LOWERCASE UPPERCASE)], burners => [qw(BURNER_MASON BURNER_TEMPLATE BURNER_TT BURNER_PHP)], ); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; $EXPORT_TAGS{all} = \@EXPORT_OK; #============================================================================= ## Function Prototypes # #======================================# my ($get_inc, $parse_uri_format); my $tmpl_archs = []; #============================================================================== ## Constants # #======================================# use constant DEBUG => 0; use constant HAS_MULTISITE => 1; use constant INSTANCE_GROUP_ID => 23; use constant GROUP_PACKAGE => 'Bric::Util::Grp::OutputChannel'; # URI Case options. use constant MIXEDCASE => 1; use constant LOWERCASE => 2; use constant UPPERCASE => 3; # URI Defaults. use constant DEFAULT_URI_FORMAT => '/%{categories}/%Y/%m/%d/%{slug}/'; use constant DEFAULT_FIXED_URI_FORMAT => '/%{categories}/'; use constant DEFAULT_URI_CASE => MIXEDCASE; use constant DEFAULT_USE_SLUG => 0; # Possible values for burner. use constant BURNER_MASON => 1; use constant BURNER_TEMPLATE => 2; use constant BURNER_TT => 3; use constant BURNER_PHP => 4; #============================================================================== ## Fields # #======================================# #--------------------------------------# # Public Class Fields # None. #--------------------------------------# # Private Class Fields my $METHS; my $TABLE = 'output_channel'; my $SEL_TABLES = "$TABLE oc, member m, output_channel_member sm"; my $SEL_WHERES = 'oc.id = sm.object_id AND sm.member__id = m.id ' . "AND m.active = '1'"; my $SEL_ORDER = 'oc.name, oc.id'; my @COLS = qw(name description protocol site__id primary_ce filename file_ext uri_format fixed_uri_format uri_case use_slug burner active); my @PROPS = qw(name description protocol site_id primary filename file_ext uri_format fixed_uri_format uri_case _use_slug burner _active); my $SEL_COLS = 'oc.id, oc.name, oc.description, oc.protocol, oc.site__id, '. 'oc.primary_ce, oc.filename, oc.file_ext, oc.uri_format, ' . 'oc.fixed_uri_format, oc.uri_case, oc.use_slug, oc.burner, ' . 'oc.active, m.grp__id'; my @SEL_PROPS = ('id', @PROPS, 'grp_ids'); my @ORD = qw(name description site_id protocol filename file_ext uri_format fixed_uri_format uri_case use_slug burner active); my $GRP_ID_IDX = $#SEL_PROPS; # These are provided for the OutputChannel::Element subclass to take # advantage of. sub SEL_PROPS { @SEL_PROPS } sub SEL_COLS { $SEL_COLS } sub SEL_TABLES { $SEL_TABLES } sub SEL_WHERES { $SEL_WHERES } sub SEL_ORDER { $SEL_ORDER } sub GRP_ID_IDX { $GRP_ID_IDX } #--------------------------------------# # Instance Fields # This method of Bricolage will call 'use fields' for you and set some permissions. BEGIN { Bric::register_fields( { # Public Fields # The human readable name field 'name' => Bric::FIELD_RDWR, # The human readable description field 'description' => Bric::FIELD_RDWR, # What site this OC is part of 'site_id' => Bric::FIELD_RDWR, # What protocol to use for URLs (ie, http://, https://, ftp://) 'protocol' => Bric::FIELD_RDWR, # Path to insert at the beginning of URIs. Deprecated. 'pre_path' => Bric::FIELD_RDWR, # Path to insert at the end of URIs. Deprecated. 'post_path' => Bric::FIELD_RDWR, # These will be used to construct file names # for content files burned to the Output Channel. 'filename' => Bric::FIELD_RDWR, 'file_ext' => Bric::FIELD_RDWR, # URI formatting settings. uri_format => Bric::FIELD_RDWR, fixed_uri_format => Bric::FIELD_RDWR, uri_case => Bric::FIELD_RDWR, # What burner to use. burner => Bric::FIELD_RDWR, _use_slug => Bric::FIELD_NONE, # the flag as to wheather this is a primary # output channel 'primary' => Bric::FIELD_RDWR, # The data base id 'id' => Bric::FIELD_READ, # Group IDs. 'grp_ids' => Bric::FIELD_READ, # Private Fileds # The active flag '_active' => Bric::FIELD_NONE, # Storage for includes list of OCs. '_includes' => Bric::FIELD_NONE, '_include_id' => Bric::FIELD_NONE, }); } #============================================================================== ## Interface Methods # #======================================# =head1 PUBLIC INTERFACE =head2 Public Constructors =over 4 =item $oc = Bric::Biz::OutputChannel->new( $initial_state ) Instantiates a Bric::Biz::OutputChannel object. An anonymous hash of initial values may be passed. The supported initial value keys are: =over 4 =item * name =item * site_id =item * description =item * active (default is active, pass undef to make a new inactive Output Channel) =back B NONE. B NONE. B NONE. =cut sub new { my ($class, $init) = @_; # Set active attribute. $init->{_active} = exists $init->{active} ? delete $init->{active} : 1; # Set file naming attributes. $init->{filename} ||= DEFAULT_FILENAME; $init->{file_ext} ||= DEFAULT_FILE_EXT; # Set URI formatting attributes. $init->{uri_format} = $init->{uri_format} ? $parse_uri_format->($class->my_meths->{uri_format}{disp}, $init->{uri_format}) : DEFAULT_URI_FORMAT; $init->{fixed_uri_format} = $init->{fixed_uri_format} ? $parse_uri_format->($class->my_meths->{fixed_uri_format}{disp}, $init->{fixed_uri_format}) : DEFAULT_FIXED_URI_FORMAT; # Set URI case and use slug attributes. $init->{uri_case} ||= DEFAULT_URI_CASE; $init->{_use_slug} = exists $init->{use_slug} && $init->{use_slug} ? 1 : 0; # Set default burner. $init->{burner} ||= BURNER_MASON; # Construct this puppy! push @{$init->{grp_ids}}, INSTANCE_GROUP_ID; return $class->SUPER::new($init); } ############################################################################## =item $oc = Bric::Biz::OutputChannel->lookup({ id => $id }) =item $oc = Bric::Biz::OutputChannel->lookup({ name => $name, site_id => $id}) Looks up and instantiates a new Bric::Biz::OutputChannel object based on an Bric::Biz::OutputChannel object ID or name. If no output channelobject is found in the database, C returns C. B =over 4 =item * Missing required parameter 'id' or 'name'/'site_id'. =item * Unable to connect to database. =item * Unable to prepare SQL statement. =item * Unable to select column into arrayref. =item * Unable to execute SQL statement. =item * Unable to bind to columns to statement handle. =item * Unable to fetch row from statement handle. =back B NONE. B NONE. =cut sub lookup { my ($class, $params) = @_; throw_gen(error => "Missing required parameter 'id' or 'name'/'site_id'") unless $params->{id} or ($params->{name} and $params->{site_id}); my $oc = $class->cache_lookup($params); return $oc if $oc; $oc = $class->_do_list($params); # We want @$person to have only one value. throw_dp(error => 'Too many Bric::Biz::OutputChannel objects found.') if @$oc > 1; return @$oc ? $oc->[0] : undef; } =item ($ocs_aref || @ocs) = Bric::Biz::OutputChannel->list( $criteria ) Returns a list or anonymous array of Bric::Biz::OutputChannel objects based on the search parameters passed via an anonymous hash. The supported lookup keys are: =over 4 =item id Output channel ID. May use C for a list of possible values. =item name The name of the output channel. May use C for a list of possible values. =item description Description of the output channel. May use C for a list of possible values. =item site_id The ID of the Bric::Biz::Site object with which the output channel is associated. May use C for a list of possible values. =item protocol The protocol or scheme for files published to an output channel, such as "http://". May use C for a list of possible values. =item server_type_id The ID of a Bric::Dest::ServerType (destination) with which output channels may be associated. May use C for a list of possible values. =item include_parent_id The ID of an output channel that includes other output channels, to get a list of those includes. May use C for a list of possible values. =item story_instance_id The ID of a story with which output channels may be associated. May use C for a list of possible values. =item media_instance_id The ID of a media document with which output channels may be associated. May use C for a list of possible values. =item uri_format The URI format of an output channel. May use C for a list of possible values. =item fixed_uri_format The fixed URI format of an output channel. May use C for a list of possible values. =item uri_case The URI case of an output channel. May use C for a list of possible values. =item use_slug A boolean indicating whether story slugs should be used for file names in an output channel. =item burner A burner constant as exported by this class. May use C for a list of possible values. =item active A boolean indicating whether or not an output channel is active. =back B =over 4 =item * Unable to connect to database. =item * Unable to prepare SQL statement. =item * Unable to select column into arrayref. =item * Unable to execute SQL statement. =item * Unable to bind to columns to statement handle. =item * Unable to fetch row from statement handle. =back B NONE. B NONE. =cut sub list { my ($class, $params) = @_; _do_list($class, $params, undef); } =item $ocs_href = Bric::Biz::OutputChannel->href( $criteria ) Returns an anonymous hash of Output Channel objects, where each hash key is an Output Channel ID, and each value is Output Channel object that corresponds to that ID. Takes the same arguments as list(). B =over 4 =item * Unable to connect to database. =item * Unable to prepare SQL statement. =item * Unable to select column into arrayref. =item * Unable to execute SQL statement. =item * Unable to bind to columns to statement handle. =item * Unable to fetch row from statement handle. =back B NONE. B NONE. =cut sub href { my ($class, $params) = @_; _do_list($class, $params, undef, 1); } #--------------------------------------# =back =head2 Destructors =over 4 =item $self->DESTROY Dummy method to prevent wasting time trying to AUTOLOAD DESTROY. =cut sub DESTROY { # empty for now } #--------------------------------------# =back =head2 Public Class Methods =over 4 =item ($id_aref || @ids) = Bric::Biz::OutputChannel->list_ids( $criteria ) Returns a list or anonymous array of Bric::Biz::OutputChannel object IDs based on the search criteria passed via an anonymous hash. The supported lookup keys are the same as for list(). B =over 4 =item * Unable to prepare SQL statement. =item * Unable to connect to database. =item * Unable to select column into arrayref. =item * Unable to execute SQL statement. =item * Unable to bind to columns to statement handle. =item * Unable to fetch row from statement handle. =back B NONE. B NONE. =cut sub list_ids { my ($class, $params) = @_; _do_list($class, $params, 1); } ############################################################################## =item my $meths = Bric::Biz::OutputChannel->my_meths =item my (@meths || $meths_aref) = Bric::Biz::OutputChannel->my_meths(TRUE) =item my (@meths || $meths_aref) = Bric::Biz::OutputChannel->my_meths(0, TRUE) Returns an anonymous hash of introspection data for this object. If called with a true argument, it will return an ordered list or anonymous array of introspection data. If a second true argument is passed instead of a first, then a list or anonymous array of introspection data will be returned for properties that uniquely identify an object (excluding C, which is assumed). Each hash key is the name of a property or attribute of the object. The value for a hash key is another anonymous hash containing the following keys: =over 4 =item name The name of the property or attribute. Is the same as the hash key when an anonymous hash is returned. =item disp The display name of the property or attribute. =item get_meth A reference to the method that will retrieve the value of the property or attribute. =item get_args An anonymous array of arguments to pass to a call to get_meth in order to retrieve the value of the property or attribute. =item set_meth A reference to the method that will set the value of the property or attribute. =item set_args An anonymous array of arguments to pass to a call to set_meth in order to set the value of the property or attribute. =item type The type of value the property or attribute contains. There are only three types: =over 4 =item short =item date =item blob =back =item len If the value is a 'short' value, this hash key contains the length of the field. =item search The property is searchable via the list() and list_ids() methods. =item req The property or attribute is required. =item props An anonymous hash of properties used to display the property or attribute. Possible keys include: =over 4 =item type The display field type. Possible values are =over 4 =item text =item textarea =item password =item hidden =item radio =item checkbox =item select =back =item length The Length, in letters, to display a text or password field. =item maxlength The maximum length of the property or value - usually defined by the SQL DDL. =back =item rows The number of rows to format in a textarea field. =item cols The number of columns to format in a textarea field. =item vals An anonymous hash of key/value pairs reprsenting the values and display names to use in a select list. =back B NONE. B NONE. B NONE. =cut sub my_meths { my ($pkg, $ord, $ident) = @_; unless (@$tmpl_archs) { push @$tmpl_archs, [BURNER_MASON, 'Mason']; push @$tmpl_archs, [BURNER_TEMPLATE, 'HTML::Template'] if $Bric::Util::Burner::Template::VERSION; push @$tmpl_archs, [BURNER_TT,'Template::Toolkit'] if $Bric::Util::Burner::TemplateToolkit::VERSION; push @$tmpl_archs, [BURNER_PHP,'PHP'] if $Bric::Util::Burner::PHP::VERSION; } # Create 'em if we haven't got 'em. $METHS ||= { name => { name => 'name', get_meth => sub { shift->get_name(@_) }, get_args => [], set_meth => sub { shift->set_name(@_) }, set_args => [], disp => 'Name', search => 1, len => 64, req => 1, type => 'short', props => { type => 'text', length => 32, maxlength => 64 } }, description => { get_meth => sub { shift->get_description(@_) }, get_args => [], set_meth => sub { shift->set_description(@_) }, set_args => [], name => 'description', disp => 'Description', len => 256, req => 0, type => 'short', props => { type => 'textarea', cols => 40, rows => 4 } }, site_id => { get_meth => sub { shift->get_site_id(@_) }, get_args => [], set_meth => sub { shift->set_site_id(@_) }, set_args => [], name => 'site_id', disp => 'Site', len => 10, req => 1, type => 'short', props => {} }, site => { name => 'site', get_meth => sub { my $s = Bric::Biz::Site->lookup ({ id => shift->get_site_id }) or return; $s->get_name; }, disp => 'Site', type => 'short', req => 0, props => { type => 'text', length => 10, maxlength => 10 } }, protocol => { get_meth => sub { shift->get_protocol(@_) }, get_args => [], set_meth => sub { shift->set_protocol(@_) }, set_args => [], name => 'protocol', disp => 'Protocol', len => 16, req => 0, type => 'short', props => {type => 'text', size => 8, maxlength => 16} }, filename => { name => 'filename', get_meth => sub { shift->get_filename(@_) }, get_args => [], set_meth => sub { shift->set_filename(@_) }, set_args => [], disp => 'File Name', len => 32, req => 0, type => 'short', props => { type => 'text', length => 32, maxlength => 32 } }, file_ext => { name => 'file_ext', get_meth => sub { shift->get_file_ext(@_) }, get_args => [], set_meth => sub { shift->set_file_ext(@_) }, set_args => [], disp => 'File Extension', len => 32, req => 0, type => 'short', props => { type => 'text', length => 32, maxlength => 32 } }, uri_format => { name => 'uri_format', get_meth => sub { shift->get_uri_format(@_) }, get_args => [], set_meth => sub { shift->set_uri_format(@_) }, set_args => [], disp => 'URI Format', len => 64, req => 0, type => 'short', props => { type => 'text', length => 32, maxlength => 64 } }, fixed_uri_format => { name => 'fixed_uri_format', get_meth => sub { shift->get_fixed_uri_format(@_) }, get_args => [], set_meth => sub { shift->set_fixed_uri_format(@_) }, set_args => [], disp => 'Fixed URI Format', len => 64, req => 0, type => 'short', props => { type => 'text', length => 32, maxlength => 64 } }, uri_case => { name => 'uri_case', get_meth => sub { shift->get_uri_case(@_) }, get_args => [], set_meth => sub { shift->set_uri_case(@_) }, set_args => [], disp => 'URI Case', len => 1, req => 1, type => 'short', props => { type => 'select', vals => [[ &MIXEDCASE => 'Mixed Case'], [ &LOWERCASE => 'Lowercase'], [ &UPPERCASE => 'Uppercase'], ] } }, use_slug => { name => 'use_slug', get_meth => sub { shift->can_use_slug(@_) ? 1 : 0 }, get_args => [], set_meth => sub { $_[1] ? shift->use_slug_on(@_) : shift->use_slug_off(@_) }, set_args => [], disp => 'Use Slug for Filename', len => 1, req => 1, type => 'short', props => { type => 'checkbox' } }, burner => { get_meth => sub { shift->get_burner(@_) }, get_args => [], set_meth => sub { shift->set_burner(@_) }, set_args => [], name => 'burner', disp => 'Burner', len => 80, req => 1, type => 'short', props => { type => 'select', vals => $tmpl_archs, } }, burner_name => { get_meth => sub { my $burner = shift->get_burner; my $map = first { $_->[0] == $burner } @$tmpl_archs; return $map->[1]; }, get_args => [], name => 'burner_name', disp => 'Burner', props => { type => 'text' }, }, active => { name => 'active', get_meth => sub { shift->is_active(@_) ? 1 : 0 }, get_args => [], set_meth => sub { $_[1] ? shift->activate(@_) : shift->deactivate(@_) }, set_args => [], disp => 'Active', len => 1, req => 1, type => 'short', props => { type => 'checkbox' } }, }; if ($ord) { return wantarray ? @{$METHS}{@ORD} : [@{$METHS}{@ORD}]; } elsif ($ident) { return wantarray ? $METHS->{name} : [$METHS->{name}]; } else { return $METHS; } } #--------------------------------------# =back =head2 Public Instance Methods =over 4 =item $id = $oc->get_id Returns the OutputChannel's unique ID. B NONE. B NONE. B NONE. =item $oc = $oc->set_name( $name ) Sets the name of the Output Channel. B NONE. B NONE. B NONE. =item $name = $oc->get_name() Returns the name of the Output Channel. B NONE. B NONE. B NONE. =item $oc = $oc->set_description( $description ) Sets the description of the Output Channel. B NONE. B NONE. B NONE. =item $description = $oc->get_description() Returns the description of the Output Channel. B NONE. B NONE. B NONE. =item $id = $oc->get_site_id() Returns the ID of the site this OC is a part of B NONE. B NONE. B NONE. =item $id = $oc->set_site_id($id) Set the ID this OC should be a part of B NONE. B NONE. B NONE. =item $proto = $oc->get_protocol() Returns the protocol for this OC (http://, ftp://, etc) B NONE. B NONE. B NONE. =item $proto = $oc->set_protocol($proto) Set the protocol for this OC B NONE. B NONE. B NONE. =item $oc = $oc->set_filename($filename) Sets the filename that will be used in the names of files burned into this Output Channel. B NONE. B NONE. B NONE. =item $filename = $oc->get_filename =item $filename = $oc->get_filename($asset) Gets the filename that will be used in the names of files burned into this Output Channel. Defaults to the value of the DEFAULT_FILENAME configuration directive if unset. The value of the C property affects the case of the filename returned. If <$asset> is passed in, then C will return the proper filename for that asset based on the value of the C property and on the class of the asset object. B NONE. B NONE. B NONE. =cut sub get_filename { my ($self, $asset) = @_; my ($fn, $us, $case) = $self->_get(qw(filename _use_slug uri_case)); # Determine what filename to return. if ($us && UNIVERSAL::isa($asset, 'Bric::Biz::Asset::Business::Story')) { my $slug = $asset->get_slug; $fn = $slug if defined $slug && $slug ne ''; } elsif (UNIVERSAL::isa($asset, 'Bric::Biz::Asset::Business::Media')) { $fn = $asset->get_file_name; } # Return the filename with the proper case. return $case eq MIXEDCASE ? $fn : $case eq LOWERCASE ? lc $fn : uc $fn; } =item $oc = $oc->set_file_ext($file_ext) Sets the filename extension that will be used in the names of files burned into this Output Channel. B NONE. B NONE. B NONE. =item $file_ext = $oc->get_file_ext Gets the filename extension that will be used in the names of files burned into this Output Channel. Defaults to the value of the DEFAULT_FILE_EXT configuration directive if unset. The case of the file extension returned is affected by the value of the C property. B NONE. B NONE. B NONE. =cut sub get_file_ext { my ($ext, $case) = $_[0]->_get(qw(file_ext uri_case)); return $case eq MIXEDCASE ? $ext : $case eq LOWERCASE ? lc $ext : uc $ext; } =item $oc = $oc->set_primary( undef || 1) Set the flag that indicates whether or not this is the primary Output Channel. B NONE. B NONE. B NONE. =item (undef || 1 ) = $oc->get_primary Returns true if this is the primary Output Channel and false (undef) if it is not. B NONE. B NONE. B Only one Output channel can be the primary output channel. =item $oc = $oc->set_uri_format($uri_format) Sets the URI format for documents output in this Output Channel. URI formats are made up of a number of possible parts, that can be arranged in any combination and order of any of the following parts: =over =item %{categories} The category URI. This is the only part that is required in all formats. =item %{slug} The story slug. Not used for media URIs. =item %{uuid} The document UUID. =item %{base64_uuid} The base64-encoded document UUID. =item %{hex_uuid} The hex representation of the document UUID. =item * Arbitrary strings. You can even ignore the C and C attributes, if you like. =item %Y The four-digit cover date year. =item %m The two-digit cover date month. =item %d The two-digit cover date month. =item etc. Any other L-supproted C format. =back B =over 4 =item * No URI Format value specified. =item * Invalid URI Format tokens. =back B NONE. B NONE. =cut sub set_uri_format { $_[0]->_set(['uri_format'], [$parse_uri_format->($_[0]->my_meths->{uri_format}{disp}, $_[1])]) } ############################################################################## =item my $format = $oc->get_uri_format Returns the URI format for documents output in this Output Channel. B NONE. B NONE. B Only one Output channel can be the uri_format output channel. =item $oc = $oc->set_fixed_uri_format($uri_format) Sets the fixed URI format for documents output in this Output Channel. B =over 4 =item * No Fixed URI Format value specified. =item * Invalid Fixed URI Format tokens. =back B NONE. B NONE. =cut sub set_fixed_uri_format { $_[0]->_set( ['fixed_uri_format'], [$parse_uri_format->($_[0]->my_meths->{fixed_uri_format}{disp}, $_[1])] ) } ############################################################################## =item (undef || 1 ) = $oc->can_use_slug Returns true if this is Output Channel can use the C property of a story as the filename for files output for the story. B NONE. B NONE. B NONE. =cut sub can_use_slug { $_[0]->_get('_use_slug') ? $_[0] : undef } ############################################################################## =item $oc = $oc->use_slug_on Sets the C property to a true value. B NONE. B NONE. B NONE. =cut sub use_slug_on { $_[0]->_set(['_use_slug'], [1]) } ############################################################################## =item $oc = $oc->use_slug_off Sets the C property to a false value. B NONE. B NONE. B NONE. =cut sub use_slug_off { $_[0]->_set(['_use_slug'], [0]) } =item $burner = $oc->get_burner Returns the burner with which the output channel is associated. B NONE. B NONE. B NONE. =item $oc = $oc->set_burner($burner) Sets the value corresponding to the burner with which this output channel is associated. The value must correspond to one of the burner constants exportable by this class: =over =item BURNER_MASON =item BURNER_TEMPLATE =item BURNER_TT =item BURNER_PHP =back ############################################################################## =item my @inc = $oc->get_includes =item my $inc_aref = $oc->get_includes Returns a list or anonymous array of Bric::Biz::OutputChannel objects that constitute the include list for this OutputChannel. Templates not found in this OutputChannel will be sought in this list of OutputChannels, looking at each one in the order in which it was returned from this method. B =over 4 =item * Bric::_get() - Problems retrieving fields. =item * Incorrect number of args to Bric::_set(). =item * Bric::set() - Problems setting fields. =item * Unable to connect to database. =item * Unable to prepare SQL statement. =item * Unable to select column into arrayref. =item * Unable to execute SQL statement. =item * Unable to bind to columns to statement handle. =item * Unable to fetch row from statement handle. =back B NONE. B NONE. =cut sub get_includes { my $inc = $get_inc->(shift); return $inc->get_objs(@_); } ############################################################################## =item $job = $job->add_includes(@ocs) Adds Output Channels to this to the include list for this Output Channel. Output Channels added to the include list via this method will be appended to the end of the include list. The order can only be changed by resetting the entire include list via the set_includes() method. Call save() to save the relationship. B =over 4 =item * Bric::_get() - Problems retrieving fields. =item * Incorrect number of args to Bric::_set(). =item * Bric::set() - Problems setting fields. =back B NONE. B Uses Bric::Util::Coll::Server internally. =cut sub add_includes { my $self = shift; my $inc = &$get_inc($self); $inc->add_new_objs(@_); $self->_set__dirty(1); } ################################################################################ =item $self = $job->del_includes(@ocs) Deletes Output Channels from the include list. Call save() to save the deletes to the database. B =over 4 =item * Bric::_get() - Problems retrieving fields. =item * Incorrect number of args to Bric::_set(). =item * Bric::set() - Problems setting fields. =item * Unable to connect to database. =item * Unable to prepare SQL statement. =item * Unable to select column into arrayref. =item * Unable to execute SQL statement. =item * Unable to bind to columns to statement handle. =item * Unable to fetch row from statement handle. =back B NONE. B NONE. =cut ############################################################################## sub del_includes { my $self = shift; my $inc = &$get_inc($self); $inc->del_objs(@_); $self->_set__dirty(1); } =item $self = $self->set_includes(@ocs); Sets the list of Output channels to set as the include list for this Output Channel. Any existing Output Channels in the includes list will be removed from the list. To add Output Channels to the include list without deleting the existing ones, use add_includes(). B =over 4 =item * Output Channel cannot include itself. =back B NONE. B NONE. =cut sub set_includes { my $self = shift; my $inc = &$get_inc($self); $inc->del_objs($inc->get_objs); $inc->add_new_objs(@_); $self->_set__dirty(1); } ############################################################################## =item $self = $oc->activate Activates the Bric::Biz::OutputChannel object. Call $oc->save to make the change persistent. Bric::Biz::OutputChannel objects instantiated by new() are active by default. B NONE. B NONE. B NONE. =cut sub activate { $_[0]->_set({_active => 1 }) } ############################################################################## =item $self = $oc->deactivate Deactivates (deletes) the Bric::Biz::OutputChannel object. Call $oc->save to make the change persistent. B NONE. B NONE. B NONE. =cut sub deactivate { $_[0]->_set({_active => 0 }) } ############################################################################## =item $self = $oc->is_active Returns $self (true) if the Bric::Biz::OutputChannel object is active, and undef (false) if it is not. B NONE. B NONE. B NONE. =cut sub is_active { $_[0]->_get('_active') ? $_[0] : undef } ############################################################################## =item $self = $oc->save Saves any changes to the Bric::Biz::OutputChannel object. Returns $self on success and undef on failure. B =over 4 =item * Bric::_get() - Problems retrieving fields. =item * Unable to connect to database. =item * Unable to prepare SQL statement. =item * Unable to execute SQL statement. =item * Unable to select row. =item * Incorrect number of args to _set. =item * Bric::_set() - Problems setting fields. =back B NONE. B NONE. =cut sub save { my ($self) = @_; return $self unless $self->_get__dirty; my ($id, $inc) = $self->_get('id', '_includes'); if ($id) { $self->_do_update($id); } else { $self->_do_insert; $id = $self->_get('id'); } $inc->save($id) if $inc; $self->SUPER::save(); } ############################################################################## =back =head1 PRIVATE =head2 Private Class Methods =over 4 =item _do_list Called by list and list ids this does the brunt of their work. B =over 4 =item * Unable to connect to database. =item * Unable to prepare SQL statement. =item * Unable to select column into arrayref. =item * Unable to execute SQL statement. =item * Unable to bind to columns to statement handle. =item * Unable to fetch row from statement handle. =back B NONE. B NONE. =cut sub _do_list { my ($pkg, $params, $ids, $href) = @_; my $tables = $pkg->SEL_TABLES; my $wheres = $pkg->SEL_WHERES; my @params; while (my ($k, $v) = each %$params) { if ($k eq 'id' or $k eq 'uri_case') { # Simple numeric comparison. $wheres .= ' AND ' . any_where $v, "oc.$k = ?", \@params; } elsif ($k eq 'primary') { # Simple boolean comparison. $wheres .= " AND oc.primary_ce = ?"; push @params, $v ? 1 : 0; } elsif ($k eq 'active' or $k eq 'use_slug') { # Simple boolean comparison. $wheres .= " AND oc.$k = ?"; push @params, $v ? 1 : 0; } elsif ($k eq 'grp_id') { # Add in the group tables a second time and join to them. $tables .= ", member m2, output_channel_member c2"; $wheres .= " AND oc.id = c2.object_id AND c2.member__id = m2.id" . " AND m2.active = '1' AND " . any_where $v, 'm2.grp__id = ?', \@params; } elsif ($k eq 'include_parent_id') { # Include the parent ID. $tables .= ', output_channel_include inc'; $wheres .= ' AND oc.id = inc.include_oc_id AND ' . any_where $v, 'inc.output_channel__id = ?', \@params; } elsif ($k eq 'server_type_id') { # Join in the server_type__output_channel table. $tables .= ', server_type__output_channel stoc'; $wheres .= ' AND oc.id = stoc.output_channel__id AND ' . any_where $v, 'stoc.server_type__id = ?', \@params; } elsif ($k eq 'story_instance_id') { # Join in the story__output_channel table. $tables .= ', story__output_channel soc'; $wheres .= ' AND oc.id = soc.output_channel__id AND ' . any_where $v, 'soc.story_instance__id = ?', \@params; } elsif ($k eq 'media_instance_id') { # Join in the media__output_channel table. $tables .= ', media__output_channel moc'; $wheres .= ' AND oc.id = moc.output_channel__id AND ' . any_where $v, 'moc.media_instance__id = ?', \@params; } elsif ($k eq 'site_id') { $wheres .= ' AND ' . any_where $v, 'oc.site__id = ?', \@params; } elsif ($k eq 'burner') { $wheres .= ' AND ' . any_where $v, 'oc.burner = ?', \@params; } else { # Simple string comparison! $wheres .= ' AND ' . any_where $v, "LOWER(oc.$k) LIKE LOWER(?)", \@params; } } my @sel_props = $pkg->SEL_PROPS; my $sel_cols = $pkg->SEL_COLS; my $sel_order = $pkg->SEL_ORDER; my ($order, $props, $qry_cols) = ($sel_order, \@sel_props, \$sel_cols); if ($ids) { $qry_cols = \'DISTINCT oc.id'; $order = 'oc.id'; } elsif ($params->{include_parent_id}) { $qry_cols = \"$sel_cols, inc.id"; $props = [@sel_props, '_include_id']; } # Else nothing! # Assemble and prepare the query. my $sel = prepare_c(qq{ SELECT $$qry_cols FROM $tables WHERE $wheres ORDER BY $order }, undef); # Just return the IDs, if they're what's wanted. return wantarray ? @{ col_aref($sel, @params) } : col_aref($sel, @params) if $ids; # Grab all the records. execute($sel, @params); my (@d, @ocs, %ocs, $grp_ids); bind_columns($sel, \@d[0..$#$props]); my $last = -1; $pkg = ref $pkg || $pkg; my $grp_id_idx = $pkg->GRP_ID_IDX; while (fetch($sel)) { if ($d[0] != $last) { $last = $d[0]; # Create a new server type object. my $self = bless {}, $pkg; $self->SUPER::new; # Get a reference to the array of group IDs. $grp_ids = $d[$GRP_ID_IDX] = [$d[$GRP_ID_IDX]]; $self->_set($props, \@d); $self->_set__dirty; # Disables dirty flag. $href ? $ocs{$d[0]} = $self->cache_me : push @ocs, $self->cache_me; } else { push @$grp_ids, $d[$GRP_ID_IDX]; } } # Return the objects. return $href ? \%ocs : wantarray ? @ocs : \@ocs; } ############################################################################## =back =head2 Private Instance Methods =over 4 =item _do_update() Will perform the update to the database after being called from save. B =over 4 =item * Bric::_get() - Problems retrieving fields. =item * Unable to connect to database. =item * Unable to prepare SQL statement. =item * Unable to execute SQL statement. =item * Unable to select row. =item * Incorrect number of args to _set. =item * Bric::_set() - Problems setting fields. =back B NONE. B NONE. =cut sub _do_update { my ($self, $id) = @_; local $" = ' = ?, '; # Simple way to create placeholders with an array. my $upd = prepare_c(qq{ UPDATE $TABLE SET @COLS = ? WHERE id = ? }, undef); execute($upd, $self->_get(@PROPS), $id); return $self; } ############################################################################## =item _do_insert Will do the insert to the database after being called by save B =over 4 =item * Bric::_get() - Problems retrieving fields. =item * Unable to connect to database. =item * Unable to prepare SQL statement. =item * Unable to execute SQL statement. =item * Unable to select row. =item * Incorrect number of args to _set. =item * Bric::_set() - Problems setting fields. =back B NONE. B NONE. =cut sub _do_insert { my ($self) = @_; local $" = ', '; my $fields = join ', ', next_key('output_channel'), ('?') x @COLS; my $ins = prepare_c(qq{ INSERT INTO output_channel (id, @COLS) VALUES ($fields) }, undef); execute($ins, $self->_get( @PROPS ) ); $self->_set( { 'id' => last_key($TABLE) } ); $self->register_instance(INSTANCE_GROUP_ID, GROUP_PACKAGE); return $self; } ############################################################################## =back =head2 Private Functions =over 4 =item my $inc_coll = &$get_inc($self) Returns the collection of Output Channels that costitute the includes. The collection a Bric::Util::Coll::OCInclude object. See Bric::Util::Coll for interface details. B =over 4 =item * Bric::_get() - Problems retrieving fields. =item * Unable to prepare SQL statement. =item * Unable to connect to database. =item * Unable to select column into arrayref. =item * Unable to execute SQL statement. =item * Unable to bind to columns to statement handle. =item * Unable to fetch row from statement handle. =item * Incorrect number of args to Bric::_set(). =item * Bric::set() - Problems setting fields. =back B NONE. B NONE. =cut $get_inc = sub { my $self = shift; my ($id, $inc) = $self->_get('id', '_includes'); unless ($inc) { $inc = Bric::Util::Coll::OCInclude->new (defined $id ? { include_parent_id => $id } : undef); my $dirty = $self->_get__dirty; $self->_set(['_includes'], [$inc]); $self->_set__dirty($dirty); } return $inc; }; ############################################################################## =item my $uri_format = $parse_uri_format->($name, $format) Parses a URI format as passed to C or C and returns it if it parses properly. If it doesn't, it throws an exception. The C<$name> attribute is used in the exceptions. B =over 4 =item * No URI Format value specified. =item * Invalid URI Format tokens. =back B NONE. B NONE. =cut $parse_uri_format = sub { my ($name, $format) = @_; # Throw an exception for an empty or bogus format. throw_dp(error => "No $name value specified") if not $format or $format =~ /^\s*$/; # Make sure that the URI format has %{categories} unless set otherwise unless (ALLOW_URIS_WITHOUT_CATEGORIES) { throw_dp "Missing the %{categories} token from $name" unless $format =~ /%{categories}/; } # Make sure there's a closing slash. $format .= '/' unless $format =~ m|/$|; return $format; }; 1; __END__ =back =head1 NOTES NONE. =head1 AUTHORS Michael Soderstrom David Wheeler =head1 SEE ALSO L, L, L, L, L. =cut