dist/lib/UI/ContentEditor.pm

   1 # UI::ContentEditor - Interchange page/component edit
   2 #
   3 # $Id: ContentEditor.pm,v 2.23 2008-07-09 12:38:22 thunder Exp $
   4 #
   5 # Copyright (C) 2002-2007 Interchange Development Group
   6 # Copyright (C) 1996-2002 Red Hat, Inc.
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public
  19 # License along with this program; if not, write to the Free
  20 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  21 # MA  02110-1301  USA.
  22
  23 package UI::ContentEditor;
  24
  25 $VERSION = substr(q$Revision: 2.23 $, 10);
  26 $DEBUG = 0;
  27
  28 use POSIX qw/strftime/;
  29 use Exporter;
  30 use Vend::Util;
  31 use Vend::Interpolate;
  32 use HTML::Entities;
  33
  34 use vars qw!
  35         @EXPORT
  36         @EXPORT_OK
  37         $VERSION
  38         $DEBUG
  39         !;
  40
  41 use strict;
  42
  43 @EXPORT = qw( ) ;
  44
  45 @EXPORT_OK = qw( ) ;
  46
  47 =head1 NAME
  48
  49 Vend/ContentEditor.pm -- Interchange Page/component edit
  50
  51 =head1 SYNOPSIS
  52
  53 [component-editor component=search_box ...]
  54 [page-editor page=index ...]
  55
  56 =head1 DESCRIPTION
  57
  58 The Interchange Component and Page editor provides HTML editing support
  59 for Interchange pages, components, and templatees.
  60
  61 =cut
  62
  63 my %New = (
  64                 page => {
  65                                 },
  66                 template => {
  67                 },
  68                 component => {
  69                 },
  70                 );
  71 my %Extra_options = (
  72                 standard => {
  73                                 name => 'standard_page_editor',
  74                                 control_fields
  75                                         => [ qw/page_title page_banner display_class members_only /],
  76                                 control_fields_meta => {
  77                                         page_title => {
  78                                                 width => 30,
  79                                                 label => errmsg('Page Title'),
  80                                         },
  81                                         page_banner => {
  82                                                 width => 30,
  83                                                 label => errmsg('Page Banner'),
  84                                         },
  85                                         display_class => {
  86                                                 label => errmsg('Display class'),
  87                                                 help => errmsg('This overrides the template type with a different display'),
  88                                         },
  89                                         members_only => {
  90                                                 label => errmsg('Members only'),
  91                                                 help => errmsg('Allows only logged-in users to display the page'),
  92                                                 type => 'yesno',
  93                                         },
  94                                 },
  95                                 component_fields => [qw/ output /],
  96                                 component_fields_meta => {
  97                                         output => {
  98                                                 label => errmsg('Output location'),
  99                                                 help => errmsg('Which section of the page the component should go to'),
 100                                                 type => 'select',
 101                                                 passed => qq[
 102                                                         =default,
 103                                                         left=Left,
 104                                                         right=Right,
 105                                                         top=Top,
 106                                                         Bottom=Bottom
 107                                                 ],
 108                                         },
 109                                 },
 110                 },
 111         );
 112 my %Template;  # Initialized at bottom of file
 113 my @All_templates;
 114 my @All_components;
 115 my @All_pages;
 116
 117 my %CompCache;
 118
 119 sub death {
 120         my $name = shift;
 121 #::logDebug("called death for $name: " . errmsg(@_));
 122         Vend::Tags->error( { set => errmsg(@_), name => $name } );
 123         return undef;
 124 }
 125
 126 sub pain {
 127         my ($tag, $msg, @args) = @_;
 128 #::logDebug("called pain for $tag: " . errmsg($msg,@args));
 129         $msg = "$tag: $msg";
 130         Vend::Tags->warnings(errmsg($msg,@args));
 131         return;
 132 }
 133
 134 sub assert {
 135         my ($name, $thing, $type) = @_;
 136         my $status;
 137         $status = ref($thing) eq $type
 138                 and return $status;
 139         my $caller = caller;
 140         death($caller, "%s (%s) not a(n) %s", $name, $thing, $type);
 141         return undef;
 142 }
 143
 144 sub delete_store {
 145         my $type = shift;
 146         my $name = shift;
 147         die("Must have type and name for delete_store, args were: " . join(" ", @_))
 148                 unless $type and $name;
 149         my $store = $Vend::Session->{content_edit} ||= {};
 150         $store->{$type} ||= {};
 151         delete $store->{$type}{$name};
 152 }
 153
 154 sub save_store {
 155         my $type = shift;
 156         my $name = shift;
 157         my $value = shift;
 158         die("Must have type and name for save_store, args were: " . join(" ", @_))
 159                 unless $type and $name;
 160         my $store = $Vend::Session->{content_edit} ||= {};
 161         $store->{$type} ||= {};
 162         $store->{$type}{$name} = $value;
 163 }
 164
 165 sub get_store {
 166         my $type = shift;
 167         my $name = shift;
 168         my $store = $Vend::Session->{content_edit} ||= {};
 169         return $store unless $type;
 170         $store->{$type} ||= {};
 171         return $store->{$type} unless $name;
 172         return $store->{$type}{$name};
 173 }
 174
 175 sub get_cdb {
 176         my $opt = shift;
 177         return $opt->{component_db} if defined $opt->{component_db};
 178         my $tab = $opt->{component_table};
 179         $tab  ||= $::Variable->{UI_COMPONENT_TABLE};
 180         $tab  ||= 'component';
 181         $opt->{component_db} = ::database_exists_ref($tab) || '';
 182 }
 183
 184 sub get_tdb {
 185         my $opt = shift;
 186         return $opt->{template_db} if defined $opt->{template_db};
 187         my $tab = $opt->{template_table};
 188         $tab  ||= $::Variable->{UI_TEMPLATE_TABLE};
 189         $tab  ||= 'template';
 190         $opt->{template_db} = ::database_exists_ref($tab) || '';
 191 }
 192
 193 sub get_pdb {
 194         my $opt = shift;
 195         return $opt->{page_db} if defined $opt->{page_db};
 196         my $tab = $opt->{page_table};
 197         $tab  ||= $::Variable->{UI_PAGE_TABLE};
 198         $tab  ||= 'page';
 199         $opt->{page_db} = ::database_exists_ref($tab) || '';
 200 }
 201
 202 sub _setref {
 203         my ($ref, $key, $val) = @_;
 204         $key = lc $key;
 205         $key =~ tr/-/_/;
 206         $ref->{$key} = $val;
 207 }
 208
 209 ## This must be non-destructive of $opt, may add keys with component_
 210 sub parse_components {
 211         my ($wanted, $opt, $components) = @_;
 212 }
 213
 214 sub extract_template {
 215         my $sref = shift;
 216         my $opt = shift || {};
 217         my $tname;
 218
 219         if ($sref =~ /\nui_(page_template|template_name):\s*(\w+)/) {
 220                 $tname = $2;
 221         } elsif ($sref =~ /\@_(\w+)_TOP_\@/) {
 222                 $tname = lc $1;
 223         } else {
 224                 $tname = $opt->{ui_page_template};
 225         }
 226
 227 #::logDebug("extract_template read template name='$tname'");
 228         my $tdef;
 229         my $tref;
 230
 231         my $allt = $opt->{_templates} ||= available_templates($opt);
 232 #::logDebug("extract_template got all_templates=" . uneval($allt));
 233
 234         for my $ref (@$allt) {
 235                 if($tname and $tname eq $ref->[0]) {
 236                         $tref = $ref;
 237                         last;
 238                 }
 239                 next unless is_yes($ref->[3]);
 240                 $tdef = $ref;
 241                 last;
 242         }
 243
 244         $tref ||= $tdef || $allt->[0];
 245 #::logDebug("extract_template derived template name=$tref->[0]");
 246         my $o = {%$opt};
 247         $o->{type} = 'template';
 248         return read_template($tref->[0], $o);
 249 }
 250
 251 ## This must be non-destructive of $opt, may add keys with component_
 252 sub parse_template {
 253         my ($tref, $opt) = @_;
 254         $opt ||= {};
 255
 256
 257         my $type = $tref->{ui_type};
 258
 259         my $tdb = get_tdb();
 260
 261         my $things;
 262         my @int;
 263         my @out;
 264         my @comp;
 265
 266 #::logDebug("ui_template_layout=$tref->{ui_template_layout}");
 267         if(! ref $tref->{ui_template_layout}) {
 268                 $tref->{ui_template_layout} = [split /\s*,\s*/, $tref->{ui_template_layout}];
 269         }
 270 #::logDebug("ui_template_layout=$tref->{ui_template_layout}");
 271         $things = $tref->{ui_template_layout} || [];
 272
 273         for(@$things) {
 274 #::logDebug("looking at thing=$_");
 275                 if($tref->{$_}) {
 276                         push @int, $tref->{$_};
 277                 }
 278                 elsif($_ eq 'UI_CONTENT') {
 279 #::logDebug("thing=$_ is UI_CONTENT");
 280                         push @int, '';
 281                 }
 282                 elsif(defined $::Variable->{$_}) {
 283 #::logDebug("thing=$_ is Variable");
 284                         push @int, Vend::Tags->var($_);
 285                 }
 286                 elsif($tdb and my $row = $tdb->row_hash($_)) {
 287 #::logDebug("thing=$_ is Data");
 288                         push @int, $row->{comp_text};
 289                 }
 290                 elsif(/^[A-Z][A-Z_0-9]+$/) {
 291 #::logDebug("parse_template: thing=$_ is unknown, creating new thing");
 292                         push @int, qq{<!-- BEGIN $_ -->\n<!-- END $_ -->};
 293                 }
 294         }
 295
 296         my %allow = (qw/
 297                                         PAGE_PICTURE ui_page_picture
 298                                 /);
 299
 300         while ( $tref->{ui_body} =~ s{
 301                         (<!--+\s+BEGIN\s+(\w+)\s+--+>
 302                                 (.*)
 303                         <!--+\s+END\s+\2\s+--+>)
 304                                 }
 305                         { $allow{uc $2} ? '' : $1 }eixs
 306                 )
 307         {
 308                 my $name = uc $2;
 309                 my $value = $3;
 310                 next unless $allow{$name};
 311                 $tref->{$allow{$name}} = $value;
 312         }
 313
 314         my $i = -1;
 315         for(@int) {
 316                 $i++;
 317                 next unless defined $_;
 318                 push (@out, {}), next unless $_;
 319                 $tref->{$things->[$i]} = $_;
 320                 my $done_one;
 321                 while( m{
 322                                  [ \t]*
 323                                  (?:
 324                                         <!--+ \s+ begin \s+ component \s+ (\w+) \s+ (\w*) \s* --+>
 325                                         (.*?)
 326                                         <!--+ \s+ end \s+ component \s+ \1 \s+ --+>
 327                                  |
 328                                         \[ include \s+ (.*?) file \s*=\s*["'][^"]*/
 329                                                 (?:\[control \s+ component \s* )?
 330                                                         (\w*)
 331                                                 \]? ['"]
 332                                         (.*?)
 333                                         \]  \s*  \[control\]
 334                                  |
 335                                         \[ component
 336                                         (
 337                                           (?:
 338                                                 \s+
 339                                                 \w[-\w]+\w
 340
 341                                                         \s*=\s*
 342
 343                                                 (["'\|]?)
 344                                                         \[?
 345                                                                 [^\n]*?
 346                                                         \]?
 347                                                 \8
 348                                            )+
 349                                         )?
 350                                         \s*
 351                                         \]
 352                                  )
 353                         }gsix)
 354                 {
 355                         my $compname = $1 || $5;
 356                         my $comptype = $2;
 357                         my $all = $7;
 358 #::logDebug("all=$all");
 359                         if($all) {
 360                                 if($all =~ m{(?:comp[-_]name|default|component)\s*=\s*(['"|])(.*?)\1}is) {
 361                                         $compname = $2;
 362                                         $compname =~ s/^\s*\[control\s+component\s+//i;
 363                                         $compname =~ s/\]\s*$//;
 364                                 }
 365                                 if($all =~ m{\bgroup\s*=\s*['"\|]?([-\w]+)}) {
 366                                         $comptype = $1;
 367                                 }
 368                                 $compname ||= '';
 369                                 $comptype ||= '';
 370                         }
 371                         elsif(! $comptype) {
 372                                 my @stuff = ($4, $6, $7, $9);
 373 #::logDebug("no comptype, stuff is: " . uneval(\@stuff));
 374                                 @stuff = grep $_, @stuff;
 375                                 my $stuff = join "", @stuff;
 376                                 $stuff =~ /\s+(?:class|group)\s*=[\s'"]*(\w+)/i
 377                                         and $comptype = $1;
 378                         }
 379 #::logDebug("comptype=$comptype");
 380                         push @out, { code => $compname, class => $comptype, where => $things->[$i] };
 381                         push @comp, $compname;
 382                         $done_one = 1;
 383                 }
 384         }
 385
 386         $tref->{ui_slots} = \@out;
 387         $tref->{ui_display_order} ||= [];
 388 #::logDebug("parsed tref=" . uneval($tref));
 389         return $tref;
 390 }
 391
 392 sub match_slots {
 393         my ($pref, $tref) = @_;
 394
 395         my $p = $pref->{ui_slots} || [];
 396         my $t = $tref->{ui_slots} || [];
 397
 398 #::logDebug("page slots in=" . uneval($p));
 399 #::logDebug("tpl  slots in=" . uneval($t));
 400         $p ||= [];
 401         $t ||= [];
 402         #### Temporarily remove content slot
 403         my $content;
 404         my $idx;
 405
 406         unless (@$p) {
 407                 @$p = @$t;
 408         }
 409
 410         for($idx = 0; $idx <= $#$p; $idx++) {
 411                 next if defined $p and $p->[$idx] and $p->[$idx]{where};
 412                 last;
 413         }
 414
 415         if($idx > $#$p and $#$p > 0) {
 416                 pain (  'parse_page',
 417                                 "No content slot found in page %s",
 418                                 $pref->{ui_page_template},
 419                         );
 420         }
 421         else {
 422                 $content = splice @$p, $idx, 1;
 423         }
 424
 425         #### Find content slot in template
 426         for($idx = 0; $idx <= $#$t; $idx++) {
 427                 next if defined $t and $t->[$idx] and $t->[$idx]{where};
 428                 last;
 429         }
 430
 431         while ($#$p > $#$t) {
 432                 pop @$p;
 433         }
 434
 435 #::logDebug("splice index=$idx");
 436         splice @$p, $idx, 0, $content;
 437 #::logDebug("page slots now=" . uneval($p));
 438
 439         if($idx > $#$t and $#$t > 0) {
 440                 pain (  'parse_page',
 441                                 "No content slot found in template %s",
 442                                 $pref->{ui_page_template},
 443                         );
 444         }
 445
 446         for(my $i = 0; $i < @$t; $i++) {
 447 #::logDebug("Matching slot $i");
 448                 if (! defined $p->[$i]) {
 449 #::logDebug("slot $i not defined?");
 450                         $p->[$i] = { %{$t->[$i]} };
 451                 }
 452                 elsif ($p->[$i]) {
 453                         if($p->[$i]{class} ne $t->[$i]{class}) {
 454                                 $p->[$i] =  { %{$t->[$i]} };
 455                         }
 456                         else {
 457                                 $p->[$i]{where} = $t->[$i]{where};
 458                         }
 459                 }
 460         }
 461
 462         $#$p = $#$t;
 463 #::logDebug("page slots out=" . uneval($p));
 464 #::logDebug("tpl  slots out=" . uneval($t));
 465
 466 }
 467
 468 sub parse_page {
 469         my ($pref, $opt) = @_;
 470         $opt ||= {};
 471
 472 #::logDebug("pref ui_body=" . uneval($pref->{ui_body}));
 473         my $tmpref = { %$pref };
 474         $tmpref->{ui_body} = substr($tmpref->{ui_body},0,50);
 475 #::logDebug("begin page ref=" . uneval($tmpref));
 476
 477         if(my $otname = $pref->{ui_template_name}) {
 478                 $pref->{ui_page_template} ||= $otname;
 479         }
 480         my $tpl   = $pref->{ui_page_template} || 'none';
 481 #::logDebug("parse page $pref->{ui_name}, template=$tpl");
 482
 483         ## Get template info
 484         my $tref = get_store('template', $tpl);
 485
 486         if(! $tref) {
 487 #::logDebug("no tref first try...");
 488                 my $topt = { %$opt };
 489                 undef $topt->{dir};
 490                 undef $topt->{new};
 491                 $topt->{type} = 'template';
 492                 $tref = read_template($tpl, $topt);
 493         }
 494
 495 #::logDebug("parse page looking for template, got " . uneval($tref));
 496
 497         assert('template_reference', $tref, 'HASH')
 498                 or undef $tref;
 499
 500         if (! $tref) {
 501 #::logDebug("no tref second try...");
 502                 pain('read_template', '%s %s not found', 'template', $tpl);
 503                 $tref = read_template('', { new => 1, type => 'template'});
 504         }
 505 #::logDebug("tref ready to parse: " . uneval($tref));
 506         parse_template($tref, $opt);
 507         ## Xfer needed template info
 508         my $order = $pref->{ui_display_order}   = [ @{ $tref->{ui_display_order} } ];
 509 #::logDebug("tref order was: " . uneval($order));
 510
 511         $pref->{ui_template_layout} = [ @{ $tref->{ui_template_layout} } ];
 512         $pref->{ui_page_picture}    = $tref->{ui_page_picture};
 513         for(@$order) {
 514                 $pref->{$_} = { %{$tref->{$_}} };
 515         }
 516
 517         my $body = delete $pref->{ui_body};
 518
 519 #::logDebug("page body=" . uneval($body));
 520         unless(defined $body) {
 521                 ### Already parsed, match slots and leave if not new page
 522                 match_slots($pref, $tref);
 523 #::logDebug("pref now=" . uneval($pref));
 524                 return unless $opt->{new};
 525         }
 526
 527         my @slots = @{ $pref->{ui_slots} || $tref->{ui_slots} || [] };
 528
 529         #$body =~ s/\r\n/\n/g;
 530
 531         my %allow = (qw/
 532                                         CONTROLS 1
 533                                         PREAMBLE 1
 534                                         CONTENT 1
 535                                         POSTAMBLE 1
 536                                 /);
 537         my $found;
 538         while ( $body =~ s{
 539                         (<!--+\s+BEGIN\s+(\w+)\s+(?:(\w+)\s+)?--+>
 540                                 (.*)
 541                         <!--+\s+END\s+\2\s+.*?--+>)
 542                                 }
 543                         { $allow{uc $2} ? '' : $1 }eixs
 544                 )
 545         {
 546                 my $name = uc $2;
 547                 my $index = $3;
 548                 my $value = $4;
 549                 next unless $allow{$name};
 550                 $found++;
 551 #::logDebug("matched name=$name index=$index");
 552                 if(! $index) {
 553                         $pref->{$name} = $value;
 554                 }
 555                 elsif($index =~ /\D/) {
 556                         if(! $pref->{$name}) {
 557                                 $pref->{$name} = { $index => $value };
 558                         }
 559                         elsif (! ref $pref->{$name}) {
 560                                 my $tmp = $pref->{$name};
 561                                 $pref->{$name} = {
 562                                         '' => $tmp,
 563                                         $index => $value,
 564                                 };
 565                         }
 566                         elsif (ref ($pref->{$name}) eq 'HASH') {
 567                                 $pref->{$name}{$index} = $value;
 568                         }
 569                         else {
 570                                 die errmsg(
 571                                         "bad content pointer reference %s %s %s",
 572                                         'BEGIN/END',
 573                                         $name,
 574                                         $index,
 575                                 );
 576                         }
 577                 }
 578                 elsif ($index) {
 579                         if(! $pref->{$name}) {
 580                                 $pref->{$name} = [];
 581                                 $pref->{$name}[$index] = $value;
 582                         }
 583                         elsif (! ref $pref->{$name}) {
 584                                 my $tmp = $pref->{$name};
 585                                 $pref->{$name} = [];
 586                                 $pref->{$name}[0] = $tmp;
 587                                 $pref->{$name}[$index] = $value;
 588                         }
 589                         elsif (ref ($pref->{$name}) eq 'ARRAY') {
 590                                 $pref->{$name}[$index] = $value;
 591                         }
 592                         else {
 593                                 die errmsg(
 594                                         "bad content pointer reference %s %s %s",
 595                                         'BEGIN/END',
 596                                         $name,
 597                                         $index,
 598                                 );
 599                         }
 600                 }
 601         }
 602
 603         $pref->{CONTENT} = $body unless $found;
 604
 605         my $controls;
 606         if($pref->{CONTROLS}) {
 607                 $controls = $pref->{CONTROLS};
 608                 $pref->{COMMENTS} = $body;
 609                 undef $body;
 610         }
 611         else {
 612                 $controls = $body;
 613         }
 614
 615 #::logDebug("controls is $controls");
 616         ## All that should be left now is [control] and [set]
 617
 618         my @comp;
 619         my @compnames;
 620         my $comphash = {};
 621         while($controls =~ s{\[control-set\](.*?)\[/control-set\]}{}is ) {
 622             my $sets = $1;
 623             my $r = {};
 624             $sets =~ s{\[([-\w]+)\](.*?)\[/\1\]}{ _setref($r, $1, $2) }eisg;
 625             push @comp, $r;
 626             push @compnames, $r->{component};
 627         }
 628
 629         my $vals                = {};
 630         my $scratches   = {};
 631
 632 #::logDebug("controls is $controls");
 633     while($controls =~ s{
 634                                                 (?:
 635                                                         \[
 636                                                                 (seti?|tmpn?)
 637                                                         \s+
 638                                                                 ([^\]]+)
 639                                                         \]
 640                                                                 (.*?)
 641                                                         \[/\1\])}{}isx
 642                         )
 643         {
 644         $scratches->{$2} = $1;
 645         $vals->{$2}      = $3;
 646     }
 647
 648         if($scratches->{not_editable} and $vals->{not_editable}) {
 649                 return death('controls', "Not editable page");
 650         }
 651
 652         my $idx;
 653         for($idx = 0; $idx <= $#slots; $idx++) {
 654                 next if $slots[$idx] and $slots[$idx]{where};
 655                 last;
 656         }
 657
 658         if($idx > $#slots) {
 659                 pain (  'parse_page',
 660                                 "No content slot found in template %s",
 661                                 $pref->{ui_page_template},
 662                         );
 663         }
 664         else {
 665                 splice @comp, $idx, 0, '';
 666         }
 667
 668 #::logDebug("#slots=" . scalar(@slots) . "#comp=" . scalar(@comp));
 669         for( my $i = 0; $i < @comp; $i++) {
 670                 my $r =  $comp[$i]
 671                         or next;
 672                 my $s = $slots[$i]
 673                         or pain('parse_page', "no slot number %s", $i), next;
 674                 $s->{code} = $r->{component};
 675                 while( my ($k, $v) = each %$r) {
 676                         $s->{$k} = $v;
 677                 }
 678         }
 679
 680         $pref->{ui_slots}               = \@slots;
 681         $pref->{ui_values}              = $vals;
 682         $pref->{ui_scratchtype} = $scratches;
 683
 684         $tmpref = { %$pref };
 685         $tmpref->{CONTENT} = substr($tmpref->{CONTENT},0,50);
 686 #::logDebug("Parsed pref=" . ::uneval($tmpref));
 687         return @compnames;
 688
 689 }
 690
 691 my %leg_remap = qw/
 692         ui_component              ui_name
 693         ui_component_type         ui_class
 694         ui_template_name          ui_name
 695         ui_template_description   ui_label
 696         ui_component_group        ui_group
 697         ui_component_help         ui_help
 698         ui_component_label        ui_label
 699 /;
 700
 701 sub legacy_components {
 702         my ($ref, $type) = @_;
 703
 704         return if $ref->{ui_name} and $ref->{ui_type} and $ref->{ui_label};
 705         while( my($old, $new) = each %leg_remap) {
 706                 my $tmp = delete $ref->{$old};
 707                 next if defined $ref->{$new} and length($ref->{$new});
 708                 $ref->{$new} = $tmp;
 709         }
 710         $ref->{ui_type} = $type;
 711         delete $ref->{ui_template};
 712         return;
 713 }
 714
 715 sub read_template {
 716         my ($spec, $opt) = @_;
 717
 718         ## For syntax check
 719         #use vars qw/%CompCache/;
 720
 721         $opt ||= {};
 722
 723         my $o = { %$opt };
 724
 725         my $type = $o->{type} = 'template';
 726
 727         my $class = $opt->{class};
 728
 729         my $db;
 730         $db = database_exists_ref($opt->{table}) if $opt->{table};
 731
 732         my @data;
 733
 734         if($spec eq 'none') {
 735                 return {
 736             ui_name                             => 'none',
 737             ui_type                             => 'template',
 738             ui_label                    => 'No template',
 739             ui_template_version => $::VERSION,
 740             ui_template_layout  => 'UI_CONTENT',
 741                 };
 742         }
 743
 744         if($opt->{new}) {
 745                 # do nothing
 746         }
 747         elsif($spec) {
 748                 if(! $db) {
 749                         @data = get_content_data($spec,$o);
 750                 }
 751                 else {
 752                         my @atoms;
 753                         my $tname = $db->name();
 754                         push @atoms, "select * from $tname";
 755                         push @atoms, "where code = '$spec'";
 756                         my $q = join " ", @atoms;
 757                         my $ary = $db->query({ sql => $q, hashref => 1 });
 758                         for(@$ary) {
 759                                 push @data, [ $_->{comp_text}, "$table::$spec" ];
 760                         }
 761                 }
 762         }
 763
 764         if(@data > 1) {
 765                 logError(
 766                         "ambiguous %s spec, %s selected. Remaining:\n%s",
 767                         errmsg($type),
 768                         $data[0][1],
 769                         join(",", map { $_->[1] } @data[1 .. $#data]),
 770                         );
 771         }
 772
 773         my $ref;
 774         my $dref;
 775
 776         if(not $dref = $data[0]) {
 777 #::logDebug("no data, and new");
 778                 $opt->{type} ||= 'page';
 779                 my $prefix = "ui_$type";
 780                 $ref = {
 781             ui_name                             => $spec,
 782             ui_type                             => $type,
 783             ui_source                   => '',
 784             ui_label                    => '',
 785             "${prefix}_version" => Vend::Tags->version(),
 786                 };
 787                 my $name = uc $spec;
 788                 $name =~ s/\W/_/g;
 789                 $name =~ s/__+/_/g;
 790                 $ref->{ui_template_layout} = "${name}_TOP, UI_CONTENT, ${name}_BOTTOM";
 791         }
 792         else {
 793           READCOMP: {
 794                 assert("$type reference", $dref, 'ARRAY')
 795                         or return death("read_$type", "Component read error for %s", $spec);
 796                 my ($data, $source) = @$dref;
 797 #::logDebug("template data is $data");
 798                 $ref = {};
 799
 800                 unless (length($data)) {
 801                         return death("read_$type", "empty %s: %s", errmsg($type), $source);
 802                 }
 803
 804                 if($data =~ m{^\s*<\?xml version=.*?>}) {
 805                         $ref = read_xml_component($data, $source);
 806 #::logDebug("Got this from read_xml_component: " . ::uneval($ref));
 807                         last READCOMP;
 808                 }
 809
 810                 $ref = {};
 811
 812                 $data =~ m{\[comment\]\s*(ui_.*?)\[/comment\]\s*(.*)}s;
 813                 my $structure = $1 || '';
 814                 $ref->{ui_body} = $2;
 815                 unless ($structure) {
 816                         return death("read_$type", "bad %s: %s", errmsg($type), $source);
 817                 }
 818
 819                 my @lines = get_lines($structure);
 820 #::logDebug("Got lines from get_lines: " . ::uneval(\@lines));
 821
 822                 parse_line($_, $ref) for @lines;
 823 #::logDebug("Parsed lines: " . ::uneval(\@lines));
 824
 825                 delete $ref->{_current};
 826
 827                 if(my $order = $ref->{ui_display_order}) {
 828                         for (@$order) {
 829                                 remap_opts($ref->{$_});
 830                         }
 831                 }
 832
 833                 $ref->{ui_type}   = $type;
 834                 $ref->{ui_source} = $source;
 835
 836 #::logDebug("read tref=" . uneval($ref));
 837                 legacy_components($ref, $type);
 838 #::logDebug("tref after legacy remap=" . uneval($ref));
 839
 840                 if(! $ref->{ui_name}) {
 841                         # Compatibility with old templates
 842                         unless ($ref->{ui_name} = delete $ref->{"ui_${type}_name"}) {
 843                                 return death("read_$type", "%s (%s) must have a name", $type, $source);
 844                         }
 845                 }
 846                 if($ref->{"ui_$type"} eq 'Yes') {
 847                         delete $ref->{"ui_$type"};
 848                 }
 849           }
 850         }
 851
 852         return $ref;
 853
 854 }
 855
 856
 857 sub read_component {
 858
 859         my ($spec, $opt) = @_;
 860         $opt ||= {};
 861
 862         my $o = { %$opt };
 863         my $type = $o->{type} = 'component';
 864
 865         my $class = $opt->{class};
 866
 867         my $db;
 868         $db = database_exists_ref($opt->{table}) if $opt->{table};
 869
 870         my @data;
 871
 872         if($opt->{new}) {
 873                 # do nothing
 874         }
 875         elsif($spec) {
 876                 if(! $db) {
 877                         @data = get_content_data($spec, $o);
 878                 }
 879                 else {
 880                         my $tname = $db->name();
 881                         my @atoms;
 882                         push @atoms, "select * from $tname";
 883                         push @atoms, "where code = '$spec'";
 884                         my $q = join " ", @atoms;
 885                         my $ary = $db->query({ sql => $q, hashref => 1 });
 886                         for(@$ary) {
 887                                 push @data, [ $_->{comp_text}, "$table::$spec" ];
 888                         }
 889                 }
 890         }
 891         else {
 892                 $opt->{new} = 1;
 893         }
 894
 895         if(@data > 1) {
 896                 logError(
 897                         "ambiguous %s spec, %s selected. Remaining:\n%s",
 898                         errmsg('component'),
 899                         $data[0][1],
 900                         join(",", map { $_->[1] } @data[1 .. $#data]),
 901                         );
 902         }
 903
 904         my $ref;
 905         my $dref;
 906
 907         if(not $dref = $data[0]) {
 908 #::logDebug("no data, and new");
 909                 $opt->{type} ||= 'page';
 910                 my $prefix = "ui_$opt->{type}";
 911                 $ref = {
 912             ui_name               => $spec,
 913             ui_label              => '',
 914             ui_class              => '',
 915             ui_group              => '',
 916             ui_type               => $opt->{type},
 917             ui_source             => '',
 918             "${prefix}_version"   => Vend::Tags->version(),
 919                 };
 920                 if($opt->{type} eq 'page') {
 921                         $ref->{ui_page_template} = $opt->{template};
 922                 }
 923                 elsif($opt->{type} eq 'template') {
 924                         my $name = uc $spec;
 925                         $name =~ s/\W/_/g;
 926                         $name =~ s/__+/_/g;
 927                         $ref->{ui_template_layout} = "${name}_TOP, UI_CONTENT, ${name}_BOTTOM";
 928                 }
 929         }
 930         else {
 931           READCOMP: {
 932                 assert("$type reference", $dref, 'ARRAY')
 933                         or return death("read_$type", "Component read error for %s", $spec);
 934                 my ($data, $source) = @$dref;
 935 #::logDebug("component data is $data");
 936                 $ref = {};
 937
 938                 unless (length($data)) {
 939                         return death("read_$type", "empty %s: %s", errmsg($type), $source);
 940                 }
 941
 942                 if($data =~ m{^\s*<\?xml version=.*?>}) {
 943                         $ref = read_xml_component($data, $source);
 944 #::logDebug("Got this from read_xml_component: " . ::uneval($ref));
 945                         last READCOMP;
 946                 }
 947
 948                 $ref = {};
 949
 950                 $data =~ m{\[comment\]\s*(ui_.*?)\[/comment\]\s*(.*)}s;
 951                 my $structure = $1 || '';
 952                 $ref->{ui_body} = $2;
 953                 unless ($structure) {
 954                         return death("read_$type", "bad %s: %s", errmsg($type), $source);
 955                 }
 956
 957                 my @lines = get_lines($structure);
 958
 959                 parse_line($_, $ref) for @lines;
 960
 961                 delete $ref->{_current};
 962
 963                 if(my $order = $ref->{ui_display_order}) {
 964                         for (@$order) {
 965                                 remap_opts($ref->{$_});
 966                         }
 967                 }
 968
 969                 $ref->{ui_type}   = $type;
 970                 $ref->{ui_source} = $source;
 971
 972 #::logDebug("read cref=" . uneval($ref));
 973                 legacy_components($ref, $type);
 974 #::logDebug("cref after legacy remap=" . uneval($ref));
 975
 976                 if(! $ref->{ui_name}) {
 977                         return death(
 978                                                 "read_$type",
 979                                                 "%s (%s) must have a name",
 980                                                 errmsg($type),
 981                                                 $source,
 982                                         );
 983                 }
 984           }
 985         }
 986
 987         return $ref;
 988
 989 }
 990
 991 sub get_content_dirs {
 992         my $opt = shift;
 993         $opt ||= {};
 994         my $dir;
 995
 996         if($dir = $opt->{dir}) {
 997                 # look no farther
 998         }
 999         elsif($opt->{type} eq 'page') {
1000                 $dir = $Vend::Cfg->{PageDir};
1001         }
1002         else {
1003                 my $tdir        =  $opt->{template_dir}
1004                                         || $::Variable->{UI_TEMPLATE_DIR} || 'templates';
1005                 if($opt->{type} eq 'component') {
1006                         $dir = $opt->{component_dir}
1007                                  || $::Variable->{UI_COMPONENT_DIR} || "$tdir/components";
1008                 }
1009                 else {
1010                         $dir = $tdir;
1011                 }
1012         }
1013         my $tmpdir  = $Vend::Cfg->{ScratchDir} || 'tmp';
1014         for(\$tmpdir, \$dir) {
1015                 $$_ =~ s!^$Vend::Cfg->{VendRoot}/!!;
1016         }
1017         $tmpdir .= "/components/$Vend::Session->{id}";
1018         return($dir, $tmpdir) if wantarray;
1019         return $dir;
1020 }
1021
1022 sub get_content_filenames {
1023         my $spec = shift;
1024         my $opt = shift;
1025
1026         $spec ||= '*';
1027         my $dir = get_content_dirs($opt);
1028 #::logDebug("got a dir=$dir for $opt->{type}");
1029         return grep -f $_, glob("$dir/$spec");
1030 }
1031
1032 sub get_content_data {
1033         my $spec = shift;
1034         my $opt = shift;
1035
1036         my @data;
1037         for(get_content_filenames($spec, $opt)) {
1038 #::logDebug("Looking at filename $_");
1039                 push @data, [ Vend::Util::readfile($_, undef, 0), $_ ];
1040         }
1041
1042         return @data if wantarray;
1043         return \@data;
1044 }
1045
1046 sub content_info {
1047         my ($dir, $opt) = @_;
1048
1049         $opt ||= {};
1050
1051         $opt->{dir} = $dir if $dir;
1052
1053         my $delim = $opt->{delimiter} || ',';
1054         my $type;
1055         if( $opt->{templates} ) {
1056                 $type = 'templates';
1057         }
1058         else {
1059                 $type = 'components';
1060         }
1061
1062         my $tpls;
1063         my $comps;
1064         my $things;
1065         my $labels;
1066         my $classes;
1067
1068         my $o = { %$opt };
1069
1070         if($Vend::caCompCache{$type}) {
1071                 $things = $Vend::caCompCache{$type};
1072                 $labels = $Vend::clCompCache{$type};
1073                 $classes = $Vend::ccCompCache{$type};
1074         }
1075         else {
1076                 if($opt->{templates}) {
1077                         $things = available_templates($o);
1078                 }
1079                 else {
1080                         $things = available_components($o);
1081                 }
1082                 $Vend::caCompCache{$type} = $things;
1083                 $labels = $Vend::clCompCache{$type} = {};
1084                 $classes = $Vend::ccCompCache{$type} = {};
1085                 for(@$things) {
1086                         $Vend::clCompCache->{$_->[0]} = $_->[1];
1087                         $Vend::ccCompCache->{$_->[0]} = $_->[2];
1088                 }
1089         }
1090
1091         if($opt->{label}) {
1092                 return $Vend::clCompCache->{$opt->{code}};
1093         }
1094
1095         if($opt->{structure}) {
1096                 $opt->{type} = $opt->{ui_type} = 'component';
1097                 return read_component($opt->{code}, $opt);
1098         }
1099
1100         if ($opt->{show_class}) {
1101                 return $Vend::ccCompCache->{$opt->{code}};
1102         }
1103
1104         ## Default is to return options
1105
1106         my @out;
1107         if(my $class = $opt->{class}) {
1108                 my $re = qr{\b(?:$class|ALL)\b};
1109                 my @comps = grep $_->[2] =~ $re, @$things;
1110                 $things = \@comps;
1111         }
1112
1113         unless ($opt->{no_sort}) {
1114                 @$things = sort { $a->[1] cmp $b->[1] } @$things;
1115         }
1116
1117         for(@$things) {
1118                 $_->[1] =~ s/($delim)/'&#' . ord($1) . ';'/ge;
1119                 my $def = is_yes($_->[3]) ? '*' : '';
1120                 push @out, join "=", $_->[0], "$_->[1]$def";
1121         }
1122         unshift @out, ($opt->{templates} ? "none=No template" : "=No component")
1123                 unless $opt->{no_none};
1124         return join $delim, @out;
1125 }
1126
1127 sub available_components {
1128         my ($opt) = @_;
1129         $opt ||= {};
1130         my $db;
1131         my $o = { %$opt };
1132         $o->{type} = 'component';
1133         $db = ::database_exists_ref($opt->{table}) if $opt->{table};
1134
1135         my @data;
1136         if(! $db) {
1137                 @data = get_content_data(undef,$o);
1138 #::logDebug(sprintf("got %d items from get_content_data", scalar(@data)));
1139         }
1140         else {
1141                 my @atoms;
1142                 my $tname = $db->name();
1143                 push @atoms, "select code,comp_text from $tname";
1144                 push @atoms, "where comp_type = '$opt->{type}'" if $opt->{type};
1145                 push @atoms, "where comp_class = '$opt->{class}'" if $opt->{class};
1146                 my $q = join " ", @atoms;
1147                 my $ary = $db->query({ sql => $q, hashref => 1 });
1148                 for(@$ary) {
1149                         push @data, [ $_->{comp_text}, "$table::$_->{code}" ];
1150                 }
1151         }
1152         my @out;
1153
1154         for my $dref (@data) {
1155                 my $data = \$dref->[0];
1156                 my ($name, $label, $class);
1157                 (
1158                 $$data =~ /\nui_name:\s*(.+)/
1159                         or $$data =~ /\nui_component_name:\s*(.+)/
1160                         or $$data =~ /\nui_component:\s*(.+)/
1161                         or logDebug("name not found in data: $$data")
1162                 )
1163                 and $name = $1;
1164                 (
1165                 $$data =~ /\nui_label:\s*(.+)/
1166                         or $$data =~ /\nui_component_label:\s*(.+)/
1167                         or $$data =~ /\nui_component_description:\s*(.+)/
1168                 )
1169                 and $label = $1;
1170                 (
1171                 $$data =~ /\nui_class:\s*(.+)/
1172                         or $$data =~ /\nui_component_type:\s*(.+)/
1173                         or $$data =~ /\nui_component_group:\s*(.+)/
1174                 )
1175                 and $class = $1;
1176                 push @out, [$name, $label, $class];
1177         }
1178
1179         return @out if wantarray;
1180         return \@out;
1181 }
1182
1183 sub available_templates {
1184         my ($opt) = @_;
1185         $opt ||= {};
1186         my $db;
1187         my $o = { %$opt };
1188         $o->{type} = 'template';
1189         $db = ::database_exists_ref($opt->{table}) if $opt->{table};
1190
1191         my @data;
1192         if(! $db) {
1193                 @data = get_content_data(undef,$o);
1194         }
1195         else {
1196                 my @atoms;
1197                 my $tname = $db->name();
1198                 push @atoms, "select code,comp_text from $tname";
1199                 push @atoms, "where comp_type = '$opt->{type}'" if $opt->{type};
1200                 push @atoms, "where comp_class = '$opt->{class}'" if $opt->{class};
1201                 my $q = join " ", @atoms;
1202                 my $ary = $db->query({ sql => $q, hashref => 1 });
1203                 for(@$ary) {
1204                         push @data, [ $_->{comp_text}, "$table::$_->{code}" ];
1205                 }
1206         }
1207         my @out;
1208
1209         for my $dref (@data) {
1210                 my $data = \$dref->[0];
1211                 my ($name, $label, $class, $default);
1212                 (
1213                 $$data =~ /\nui_name:\s*(.+)/
1214                         or $$data =~ /\nui_template_name:\s*(.+)/
1215                         or $$data =~ /\nui_template:\s*(.+)/
1216                         or logDebug("name not found in data: $$data")
1217                 )
1218                 and $name = $1;
1219                 (
1220                 $$data =~ /\nui_label:\s*(.+)/
1221                         or $$data =~ /\nui_template_label:\s*(.+)/
1222                         or $$data =~ /\nui_template_description:\s*(.+)/
1223                 )
1224                 and $label = $1;
1225                 (
1226                 $$data =~ /\nui_class:\s*(.+)/
1227                         or $$data =~ /\nui_template_type:\s*(.+)/
1228                         or $$data =~ /\nui_template_group:\s*(.+)/
1229                 )
1230                 and $class = $1;
1231                 (
1232                 $$data =~ /\nui_default:\s*(.+)/
1233                         or $$data =~ /\nui_template_default:\s*(.+)/
1234                 )
1235                 and $default = $1;
1236                 push @out, [$name, $label, $class, $default];
1237         }
1238         return @out if wantarray;
1239         return \@out;
1240 }
1241
1242 sub get_lines {
1243         my ($structure, $opt) = @_;
1244         $opt ||= $_;
1245         $structure =~ s/\s+$//;
1246         my @lines = split /\r?\n/, $structure;
1247         my $found;
1248         for(;;) {
1249                 my $i = -1;
1250                 for(@lines) {
1251                         $i++;
1252                         next unless s/\\$//;
1253                         $found = $i;
1254                         last;
1255                 }
1256                 last unless defined $found;
1257                 if (defined $found) {
1258                         my $add = splice @lines, $found + 1, 1;
1259 #::logDebug("Add is '$add', found index=$found");
1260                         $lines[$found] .= "\n$add";
1261 #::logDebug("Complete line now is '$lines[$found]'");
1262                         undef $found;
1263                 }
1264         }
1265         return @lines;
1266 }
1267
1268 sub parse_line {
1269         my ($line, $ref) = @_;
1270         $line =~ s/\s+$//;
1271         my $type;
1272         if($line =~ /^\s*ui_/) {
1273                 my ($el, $el_item, $el_data);
1274                 if($line =~ /\n/) {
1275                         ($el, $el_item) = split /\s*:\s*/, $_, 2;
1276                 }
1277                 else {
1278                         ($el, $el_item, $el_data) = split /\s*:\s*/, $_, 3;
1279                 }
1280 #::logDebug("found el=$el el_item=$el_item el_data=$el_data");
1281                 if(! defined $el_data) {
1282                         $ref->{$el} = $el_item;
1283                 }
1284                 else {
1285                         if($el_item eq 'ARRAY') {
1286                                 $ref->{$el} ||= [];
1287                                 assert($el, $ref->{$el}, 'ARRAY')
1288                                         or return undef;
1289                                 push @{$ref->{$el}}, [ split /[\s,\0]+/, $el_data ];
1290                         }
1291                         if($el_item eq 'HASH') {
1292                                 $ref->{$el} ||= {};
1293                                 assert($el, $ref->{$el}, 'HASH')
1294                                         or return undef;
1295                                 my %hash = get_option_hash($el_data);
1296                                 @{$ref->{$el}}{keys %hash} = values %hash;
1297                         }
1298                 }
1299         }
1300         elsif ( $line =~ /^(\w+)\s*:\s*(.*)/) {
1301                 $ref->{_current} = $1;
1302                 my $lab = $2;
1303                 $ref->{ui_display_order} ||= [];
1304                 push @{$ref->{ui_display_order}}, $ref->{_current};
1305         }
1306         elsif( $line =~ /^\s+(\w+)\s*:\s*(.*)/s ) {
1307                 my ($fn, $fv) = ( lc($1), $2 );
1308                 $ref->{$ref->{_current}}{$fn} = $fv;
1309         }
1310         return;
1311 }
1312
1313 sub read_page {
1314         my ($spec, $opt) = @_;
1315
1316         my $db;
1317         $db = database_exists_ref($opt->{table}) if $opt->{table};
1318
1319         my @data;
1320         my $type = 'page';
1321
1322         if($opt->{new}) {
1323                 # do nothing
1324         }
1325         elsif($spec and ! $db) {
1326                 @data = get_content_data($spec, $opt);
1327         }
1328         elsif($spec) {
1329                 my $tname = $db->name();
1330                 my @atoms;
1331                 push @atoms, "select * from $tname";
1332                 push @atoms, "where code = '$spec'";
1333                 my $q = join " ", @atoms;
1334                 my $ary = $db->query({ sql => $q, hashref => 1 });
1335                 for(@$ary) {
1336                         push @data, [ $_->{comp_text}, "$table::$spec" ];
1337                 }
1338         }
1339         else {
1340                 $opt->{new} = 1;
1341         }
1342
1343         if(@data > 1) {
1344                 logError(
1345                         "ambiguous page spec, %s selected. Remaining:\n%s",
1346                         $data[0][1],
1347                         join(",", map { $_->[1] } @data[1 .. $#data]),
1348                         );
1349         }
1350
1351         my $dref = $data[0];
1352
1353         my $ref;
1354
1355         if(! $dref) {
1356 #::logDebug("no data");
1357                 my $prefix = "ui_$type";
1358                 $ref = {
1359             ui_name               => $spec,
1360             ui_type               => $opt->{type},
1361             ui_source             => '',
1362                         ui_body                           => '',
1363             "${prefix}_version"   => Vend::Tags->version(),
1364                 };
1365
1366                 my $tref = extract_template('', $opt);
1367                 assert('template', $tref, 'HASH')
1368                         or return death('Not even a default template!');
1369                 $ref->{ui_page_template} = $tref->{ui_name};
1370         }
1371         else {
1372       READCOMP: {
1373                 my ($data, $source) = @{$dref || []};
1374 #::logDebug("read page from source=$source");
1375
1376                 $ref = {};
1377
1378                 my $tref = extract_template($data, $opt);
1379                 assert('read_page', $tref, 'HASH')
1380                   or return death('read_page', "%s has no %s", $source, errmsg('template'));
1381                 $ref->{ui_page_template} = $tref->{ui_name};
1382 #::logDebug("page=$spec template=$ref->{ui_page_template}");
1383
1384                 if($data =~ m{^\s*<\?xml version=.*?>}) {
1385                         $ref = read_xml_component($data, $source);
1386 #::logDebug("Got this from read_xml_component: " . ::uneval($ref));
1387                         last READCOMP;
1388                 }
1389
1390                 $data =~ m{\[comment\]\s*(ui_.*?)\[/comment\]\s*(.*)}s;
1391                 my $structure = $1 || '';
1392                 $ref->{ui_body} = $2;
1393                 if(! $structure) {
1394                         $structure = <<EOF;
1395 ui_name: $spec
1396 ui_type: page
1397 ui_page_template: none
1398 EOF
1399                         $ref->{ui_body} = $data;
1400                 }
1401
1402                 my @lines = get_lines($structure);
1403                 parse_line($_, $ref) for @lines;
1404
1405 #::logDebug("page=$spec ui_name=$ref->{ui_name} after structure parse");
1406
1407                 delete $ref->{_current};
1408
1409                 if(my $order = $ref->{ui_display_order}) {
1410                         for (@$order) {
1411                                 remap_opts($ref->{$_});
1412                         }
1413                 }
1414
1415 #::logDebug("page=$spec ui_name=$ref->{ui_name} after remap_opts");
1416
1417                 $ref->{ui_name}   ||= $spec;
1418                 $ref->{ui_type}   = $type;
1419                 $ref->{ui_source} = $source;
1420
1421           }
1422         }
1423 #::logDebug("page=$spec ui_name=$ref->{ui_name}");
1424 #::logDebug("page read returning: " . uneval($ref));
1425         return $ref;
1426 }
1427
1428 sub page_component_editor {
1429         my ($name, $pos, $comp, $pref, $opt) = @_;
1430
1431         assert('page reference', $pref, 'HASH')
1432                 or return undef;
1433
1434         assert('component reference', $comp, 'HASH')
1435                 or return undef;
1436
1437         $name ||= $comp->{code};
1438
1439 #::logDebug("called page_component_editor, name=$name comp=" . ::uneval($comp));
1440         my $hidden = {
1441                         ui_name   => $pref->{ui_name},
1442                         ui_source => $pref->{ui_source},
1443                         ui_page_template => $pref->{ui_page_template},
1444                         ui_type   => $pref->{ui_type},
1445                         ui_content_op => 'modify_component',
1446                         ui_content_pos => $pos,
1447         };
1448
1449         my @fields = 'code';
1450
1451         my $topt = { %$opt };
1452         delete $topt->{dir};
1453         delete $topt->{new};
1454         $topt->{type} = 'component';
1455         my $cref = get_store('component', $name) || read_component($name, $topt);
1456
1457         ref($cref) eq 'HASH'
1458                 or $cref = {};
1459
1460         my $action = Vend::Tags->area($Global::Variable->{MV_PAGE});
1461         $action =~ s/\?.*//;
1462         my $extra = qq{ onChange="
1463                                         if(check_change() == true) {
1464                                                 this.form.action='$action';
1465                                                 this.form.submit();
1466                                         }"
1467                                 };
1468         $extra =~ s/\s+/ /g;
1469         my $meta = {
1470                 code => {
1471                         type => 'select',
1472                         passed => Vend::Tags->content_info(),
1473                         label => 'Component',
1474                 },
1475         };
1476         my $label = "$name - " . Vend::Tags->content_info( { code => $name, label => 1});
1477         $label = "<H3 align=center>$label</h3>";
1478         my $value = { code => $name };
1479
1480         my $js = {
1481                                         code => $extra,
1482                         };
1483
1484         my $order = $cref->{ui_display_order} || [];
1485         #return undef unless @$order;
1486
1487         if( my $extra_opt = $Extra_options{$opt->{editor_style}} ) {
1488                 my $name = $extra_opt->{name} || 'page_editor';
1489                 my $dbopt = $Tag->meta_record('ui_component', $name);
1490                 my $ef = $dbopt->{component_fields} || $extra_opt->{component_fields};
1491                 unless (ref $ef eq 'ARRAY') {
1492                         my @f = grep /\w/, split /[\s,\0]+/, $ef;
1493                         $ef = \@f;
1494                 }
1495                 if($ef) {
1496                         my $eo = $extra_opt->{component_fields_meta} || {};
1497                         my %seen;
1498                         for(@$order) {
1499                                 $seen{$_} = 1;
1500                         }
1501                         for(@$ef) {
1502                                 next if $seen{$_};
1503                                 push @$order, $_;
1504                                 $cref->{$_} = $Tag->meta_record("ui_component::$_",  $name)
1505                                         or
1506                                 $cref->{$_} = $eo->{$_} ? { %{ $eo->{$_} } } : {};
1507                         }
1508                         if($Tag->if_mm('super')) {
1509                                 for(@$order) {
1510                                         my $url = $Tag->area({
1511                                                 href => 'admin/meta_editor',
1512                                                 form => qq{
1513                                                         item_id=${name}::ui_component::$_
1514                                                         ui_return_to=$Global::Variable->{MV_PAGE}
1515                                                         ui_return_to=ui_name=$cref->{ui_name}
1516                                                 },
1517                                         });
1518                                         my $anchor = errmsg('meta');
1519                                         my $title = errmsg('Edit meta');
1520                                         $cref->{$_}{label} ||= $_;
1521                                         $cref->{$_}{label} = qq{<a href="$url" title="$title" style="float: right">$anchor</a>$cref->{$_}{label}};
1522                                 }
1523                         }
1524                 }
1525         }
1526
1527         for my $f (@$order) {
1528 #::logDebug("building field $f");
1529                 $meta->{$f} = { %{ $cref->{$f} || {} } };
1530                 my $lab = $meta->{$f}{label} || $f;
1531                 push @fields, "";
1532                 push @fields, "=$lab";
1533                 push @fields, "";
1534                 push @fields, $f;
1535                 $meta->{$f}{label} = 'value';
1536                 $value->{$f} = defined $comp->{$f} ? $comp->{$f} : $meta->{$f}{default};
1537
1538                 next if $meta->{$f}{type} and $meta->{$f}{type} !~ /text/i;
1539                 my $st = "_scratchtype_$f";
1540                 push @fields, $st;
1541                 $meta->{$st} = {
1542                         label => 'how to set',
1543                         type => 'select',
1544                         passed => qq{tmpn=Unparsed and temporary,
1545                                         set=Unparsed and persistent,
1546                                         tmp=Parsed and temporary,
1547                                         seti=Parsed and persistent},
1548                 };
1549                 $value->{$st} = $comp->{$st};
1550         }
1551
1552         my $fields = join "\n", @fields;
1553
1554         my $tw = $opt->{table_width} || '100%';
1555         # Have to increment position by one to get the slot number
1556         my $p = $pos;
1557         $p++;
1558         my %options = (
1559                 action => 'return',
1560                 defaults => 1,
1561                 extra => $js,
1562                 force_defaults => 1,
1563                 form_extra => qq{onSubmit="submitted('slot$p'); silent_submit(this.form)" onReset="submitted('slot$p')"},
1564                 hidden => $hidden,
1565                 href   => 'silent/ce_modify',
1566                 js_changed => qq{ onChange="changed('slot$p')"},
1567                 meta   => $meta,
1568                 next_text => 'Save',
1569                 no_meta => 1,
1570                 nocancel => 1,
1571                 noexport => 1,
1572                 notable => 1,
1573                 show_reset => 1,
1574                 table_width => $tw,
1575                 ui_data_fields => $fields,
1576                 view => 'ui_component',
1577         );
1578         $options{default_ref} = $value;
1579         $options{item_id} = $name;
1580         return Vend::Tags->table_editor( \%options );
1581 }
1582
1583 sub page_control_editor {
1584         my ($pref, $opt) = @_;
1585 #::logDebug("called page_control_editor");
1586         assert('page reference', $pref, 'HASH')
1587                 or return undef;
1588
1589         my $hidden = {
1590                         ui_name   => $pref->{ui_name},
1591                         ui_source => $pref->{ui_source},
1592                         ui_type   => $pref->{ui_type},
1593                         ui_content_op => 'modify_control',
1594         };
1595
1596         my $order;
1597         assert('page display order', $order = $pref->{ui_display_order}, 'ARRAY')
1598                 or return undef;
1599
1600         my $meta = { };
1601         my @fields = 'code';
1602
1603         if( my $extra_opt = $Extra_options{$opt->{editor_style}} ) {
1604                 my $name = $extra_opt->{name} || 'page_editor';
1605                 my $dbopt = $Tag->meta_record('ui_control', $name);
1606                 my $ef = $dbopt->{control_fields} || $extra_opt->{control_fields};
1607                 unless (ref $ef eq 'ARRAY') {
1608                         my @f = grep /\w/, split /[\s,\0]+/, $ef;
1609                         $ef = \@f;
1610                 }
1611                 if($ef) {
1612                         my $eo = $extra_opt->{control_fields_meta} || {};
1613                         my %seen;
1614                         for(@$order) {
1615                                 $seen{$_} = 1;
1616                         }
1617                         for(@$ef) {
1618                                 next if $seen{$_};
1619                                 push @$order, $_;
1620                                 $pref->{$_} = $Tag->meta_record("ui_control::$_",  $name)
1621                                         or
1622                                 $pref->{$_} = $eo->{$_} ? { %{ $eo->{$_} } } : {};
1623                         }
1624                         if($Tag->if_mm('super')) {
1625                                 for(@$order) {
1626                                         my $url = $Tag->area({
1627                                                 href => 'admin/meta_editor',
1628                                                 form => qq{
1629                                                         item_id=${name}::ui_control::$_
1630                                                         ui_return_to=$Global::Variable->{MV_PAGE}
1631                                                         ui_return_to=ui_name=$pref->{ui_name}
1632                                                 },
1633                                         });
1634                                         my $anchor = errmsg('meta');
1635                                         my $title = errmsg('Edit meta');
1636                                         $pref->{$_}{label} ||= $_;
1637                                         $pref->{$_}{label} = qq{<a href="$url" title="$title" style="float: right">$anchor</a>$pref->{$_}{label}};
1638                                 }
1639                         }
1640                 }
1641         }
1642
1643         for my $f (@$order) {
1644                 $meta->{$f} = { %{ $pref->{$f} } };
1645                 my $lab = $meta->{$f}{label} || $f;
1646                 push @fields, "";
1647                 push @fields, "=$lab";
1648                 push @fields, "";
1649                 push @fields, $f;
1650                 $meta->{$f}{label} = 'value';
1651
1652                 next if $meta->{$f}{type} and $meta->{$f}{type} !~ /text/i;
1653                 my $st = "_scratchtype_$f";
1654                 push @fields, $st;
1655                 $meta->{$st} = {
1656                         label => 'how to set',
1657                         type => 'select',
1658                         passed => qq{tmpn=Unparsed and temporary,
1659                                         set=Unparsed and persistent,
1660                                         tmp=Parsed and temporary,
1661                                         seti=Parsed and persistent,
1662                         },
1663                         value => $pref->{ui_scratchtype}{$f},
1664                 };
1665         }
1666
1667         my $fields = join "\n", @fields;
1668
1669         my $tw = $opt->{table_width} || '100%';
1670         my $p = $pref->{ui_name};
1671         my %options = (
1672                 action => 'return',
1673                 defaults => 1,
1674                 force_defaults => 1,
1675                 form_extra => qq{onSubmit="submitted('$p'); silent_submit(this.form)" onReset="submitted('$p')" height="100%"},
1676                 hidden => $hidden,
1677                 href   => 'silent/ce_modify',
1678                 js_changed => qq{onChange="changed('$p')"},
1679                 meta   => $meta,
1680                 next_text => 'Save',
1681                 no_meta => 1,
1682                 nocancel => 1,
1683                 noexport => 1,
1684                 notable => 1,
1685                 show_reset => 1,
1686                 table_width => $tw,
1687                 ui_data_fields => $fields,
1688                 ui_hide_key => 1,
1689                 view => 'ui_component',
1690         );
1691         $options{default_ref} = $pref->{ui_values};
1692         $options{item_id} = $p;
1693         return Vend::Tags->table_editor( \%options );
1694 }
1695
1696 sub make_control_editor {
1697         my ($w, $r, $overall) = @_;
1698         $overall ||= {};
1699         my $type = $overall->{ui_type} || 'component';
1700
1701         my $widopt;
1702         my $hidden = {
1703                         ui_name   => $overall->{ui_name},
1704                         ui_source => $overall->{ui_source},
1705                         ui_type   => $overall->{ui_type},
1706         };
1707
1708         my $extra;
1709         my $href;
1710         if($w) {
1711                 $widopt = {code =>'hiddentext'};
1712                 $href   = 'silent/ce_modify';
1713                 $extra  = qq{onSubmit="submitted('$w'); silent_submit(this.form)" onReset="submitted('$w')"};
1714                 $hidden->{ui_content_op} = 'modify';
1715         }
1716         else {
1717                 $href   = $Global::Variable->{MV_PAGE};
1718                 $hidden->{ui_content_op} = 'add';
1719         }
1720
1721         my %options = (
1722                 action => 'return',
1723                 defaults => 1,
1724                 force_defaults => 1,
1725                 form_extra => $extra,
1726                 href   => $href,
1727                 js_changed => 'changed',
1728                 nocancel => 1,
1729                 noexport => 1,
1730                 no_meta => 1,
1731                 show_reset => 1,
1732                 table => $::Variable->{UI_META_TABLE} || 'mv_metadata',
1733                 view => 'ui_component',
1734                 widget => $widopt,
1735                 hidden => $hidden,
1736         );
1737
1738         $options{default_ref} = $r;
1739         $options{item_id} = $w;
1740         return Vend::Tags->table_editor( \%options );
1741 }
1742
1743 sub page_region {
1744         my($pref, $opt) = @_;
1745
1746         my @keys = keys %$pref;
1747         my @ui_keys = grep /^ui_/, @keys;
1748
1749         my %ignore;
1750         my %done;
1751
1752         my $comp = $pref->{ui_slots};
1753
1754         $ignore{ui_slots} = 1;
1755         $ignore{ui_display_order} = 1;
1756         $ignore{ui_values} = 1;
1757         $ignore{ui_scratchtype} = 1;
1758
1759         my $overall = {};
1760         $overall->{safe_data} = 1;  # Allow ITL introduction
1761         for(qw/ PREAMBLE CONTENT POSTAMBLE /) {
1762                 $overall->{$_} = $pref->{$_};
1763         }
1764
1765         for(@ui_keys) {
1766                 next if $ignore{$_};
1767                 $ignore{$_} = 1;
1768                 $overall->{$_} = $pref->{$_};
1769         }
1770
1771         if($pref->{ui_display_order}) {
1772                 $overall->{ui_display_order} = join " ", @{$pref->{ui_display_order}};
1773         }
1774
1775         my $vals      = $pref->{ui_values} || {};
1776         my $scratches = $pref->{ui_scratches};
1777         while ( my($k,$v) = each %$vals) {
1778                 $overall->{$k} = $v;
1779                 $overall->{"_scratchtype_$k"} = $scratches->{$k};
1780         }
1781
1782         $overall->{_editor_table} = page_control_editor($pref, $opt);
1783         my @tables;
1784
1785         # This is destructive, but slots are rebuilt every time
1786         my $slots = $pref->{ui_slots} || [];
1787
1788         # Need position in case two components are the same
1789         my $pos = -1;
1790         for my $c (@$slots) {
1791                 $pos++;
1792                 my $r = { %$c };
1793                 $r->{component} ||= $r->{code};
1794 #::logDebug("slot pos=$pos, slot=" . ::uneval($c));
1795                 delete $r->{_editor_table};
1796                 if($r->{where}) {
1797                         my $cname = $r->{component} || '';
1798                         remap_opts($r);
1799                         if($opt->{page_edit}) {
1800                                 $r->{_editor_table} = page_component_editor(
1801                                                                                 $cname,
1802                                                                                 $pos,
1803                                                                                 $c,
1804                                                                                 $pref,
1805                                                                                 $opt,
1806                                                                          );
1807                         }
1808                 }
1809                 push @tables, $r;
1810         }
1811
1812         ## Allow add of new component
1813         if ($opt->{template_edit}) {
1814                 push @tables, { _editor_table => make_control_editor('', {}, $overall) };
1815         }
1816 #::logDebug("returning overall=" . uneval($overall));
1817         return ($overall, \@tables);
1818 }
1819
1820 sub template_region {
1821         my($tref, $opt) = @_;
1822
1823         my @keys = keys %$tref;
1824         my @ui_keys = grep /^ui_/, @keys;
1825
1826         my %ignore;
1827         my %done;
1828
1829         my $comp = $tref->{ui_slots};
1830         $ignore{ui_slots} = 1;
1831
1832         my @regions;
1833         my $snum = 1;
1834         for my $reg ( @{$tref->{ui_template_layout}} ) {
1835                 my $r = { name => $reg, code => $reg };
1836                 if($reg eq 'UI_CONTENT') {
1837                         $r->{contents} = "Slot $snum: Page content";
1838                         $snum++;
1839                 }
1840                 else {
1841                         my @things;
1842                         $r->{where} = $reg;
1843                         for(@$comp) {
1844                                 next unless $_->{where} eq $reg;
1845                                 my $code = $_->{code};
1846                                 my $lab = '';
1847                                 if($code) {
1848                                         $lab = content_info(undef, { label => 1, code => $code} );
1849                                         $lab = " default=$lab ($code)";
1850                                 }
1851                                 push @things, "Slot $snum: class=$_->{class}$lab";
1852                                 $snum++;
1853                         }
1854                         $r->{contents} = join "<br>", @things;
1855                         $r->{slots} = \@things;
1856                 }
1857                 push @regions, $r;
1858         }
1859
1860         $ignore{ui_display_order} = 1;
1861
1862         my $overall = {%{$opt}};
1863         $overall->{safe_data} = 1;  # Allow ITL introduction
1864
1865         for(@ui_keys) {
1866                 next if $ignore{$_};
1867                 $ignore{$_} = 1;
1868                 $overall->{$_} = $tref->{$_};
1869         }
1870
1871         my %wattr;
1872
1873         for my $w (@keys) {
1874                 my $ref = $tref->{$w} or next;
1875                 next if $ignore{$w};
1876                 if( ref($ref) eq 'HASH' ) {
1877                         for(keys %$ref) {
1878                                 $wattr{$w} ||= {};
1879                                 $wattr{$w}{$_} = $ref->{$_};
1880                         }
1881                 }
1882                 else {
1883                         $overall->{$w} = $ref;
1884                 }
1885         }
1886
1887         my $order = $tref->{ui_display_order} || [];
1888         my @tables;
1889
1890         for my $w (@$order) {
1891                 my $r = $wattr{$w};
1892                 $r->{code} = $w;
1893                 remap_opts($r);
1894                 if($opt->{template_edit}) {
1895                         $r->{_editor_table} = make_control_editor($w, $r, $overall);
1896                 }
1897                 push @tables, $r;
1898         }
1899
1900         $::Scratch->{ce_modify} = '[content-modify]';
1901         ## Allow add of new component
1902         if ($opt->{template_edit}) {
1903                 push @tables, { _editor_table => make_control_editor('', {}, $overall) };
1904         }
1905         return ($overall, \@regions, $comp, \@tables);
1906 }
1907
1908 sub component_region {
1909         my ($cref, $opt) = @_;
1910
1911         my @keys = keys %$cref;
1912         my @ui_keys = grep /^ui_/, @keys;
1913
1914         my %ignore;
1915         my %done;
1916
1917         my $overall = {%{$opt}};
1918         $overall->{safe_data} = 1;  # Allow ITL introduction
1919         $overall->{ui_body} = $cref->{ui_body};
1920         for(@ui_keys) {
1921                 $ignore{$_} = 1;
1922                 $overall->{$_} = $cref->{$_};
1923         }
1924
1925         my %wattr;
1926
1927         for my $w (@keys) {
1928                 my $ref = $cref->{$w} or next;
1929                 next if $ignore{$w};
1930                 if( ref($ref) eq 'HASH' ) {
1931                         for(keys %$ref) {
1932                                 $wattr{$w} ||= {};
1933                                 $wattr{$w}{$_} = $ref->{$_};
1934                         }
1935                 }
1936                 else {
1937                         # Is it ever right to have a scalar or array? I don't think so.
1938                         next;
1939                 }
1940         }
1941
1942         my $count = 0;
1943
1944         my $order = $cref->{ui_display_order} || [];
1945         my @tables;
1946
1947         for my $w (@$order) {
1948                 my $r = $wattr{$w};
1949                 $r->{code} = $w;
1950                 remap_opts($r);
1951 #::logDebug("table-editor options: " . uneval(\%options));
1952                 if($opt->{component_edit}) {
1953                         $r->{_editor_table} = make_control_editor($w, $r, $overall);
1954                 }
1955                 push @tables, $r;
1956         }
1957
1958         $::Scratch->{ce_modify} = '[content-modify]';
1959         ## Allow add of new component
1960         if ($opt->{component_edit}) {
1961                 push @tables, { _editor_table => make_control_editor('', {}, $overall) };
1962         }
1963
1964         return($overall, \@tables);
1965 }
1966
1967 my @valid_attr = qw/
1968         code
1969         type
1970         width
1971         height
1972         field
1973         db
1974         name
1975         outboard
1976         options
1977         attribute
1978         label
1979         help
1980         lookup
1981         filter
1982         help_url
1983         pre_filter
1984         lookup_exclude
1985         prepend
1986         append
1987         display_filter
1988         extended
1989 /;
1990
1991 my %valid_attr;
1992 @valid_attr{@valid_attr} = @valid_attr;
1993
1994 sub _trim {
1995         my $v = shift;
1996         $v =~ s/^\s+$//;
1997         $v =~ s/\s+$//;
1998         $v =~ s/\r\n/\n/g;
1999         $v =~ s/\r/\n/g;
2000         return $v;
2001 }
2002
2003 sub trim_format {
2004         my $v = _trim(shift);
2005         $v =~ s/\n/\\\n/g;
2006         $v =~ s/\\$//;
2007         return $v;
2008 }
2009
2010 sub format_page {
2011         my ($ref, $opt) = @_;
2012         $opt ||= {};
2013         my $type = 'page';
2014         $ref->{ui_type} eq $type
2015                 or death("publish_$type", "Type must be %s to publish %s", $type, $type);
2016         my $name = $ref->{ui_name}
2017                 or death("publish_$type", "Must have name to publish %s", $type);
2018
2019         my $found_something = 0;
2020
2021         my @sets;
2022         if($ref->{PREAMBLE} =~ /\S/) {
2023                 push @sets, "<!-- BEGIN PREAMBLE -->";
2024                 $ref->{PREAMBLE} =~ s/^\s*\n//;
2025                 $ref->{PREAMBLE} =~ s/\n\s*$//;
2026                 $ref->{PREAMBLE} =~ s/\r\n|\r/\n/g;
2027                 push @sets, $ref->{PREAMBLE};
2028                 push @sets, "<!-- END PREAMBLE -->";
2029         }
2030         delete $ref->{PREAMBLE};
2031
2032         my $vals      = delete $ref->{ui_values};
2033         my $scratches = delete $ref->{ui_scratchtype};
2034         my $order = delete $ref->{ui_display_order} || [];
2035
2036         # Do this first to get these things out of reference
2037         # n=name k=key v=value
2038         for my $n (@$order) {
2039                 my $r;
2040                 my $stype = $scratches->{$n} || 'tmpn';
2041                 my $val = $vals->{$n};
2042                 if($opt->{preview} and $n eq $opt->{preview}) {
2043                         $val = ($opt->{preview_tag} || '**** PREVIEW ****') . " $val";
2044                 }
2045                 push @sets, "[$stype $n]" . $val . "[/$stype]";
2046         }
2047
2048         $found_something += scalar(@sets);
2049
2050 #::logDebug("publish_page ref=" . ::uneval($ref));
2051
2052         # Things we want every time
2053         my $layout = delete $ref->{ui_template_layout} || [];
2054
2055 #::logDebug("layout=" . ::uneval($layout));
2056         my @header;
2057
2058         my $slots = delete $ref->{ui_slots} || [];
2059         push @header, "ui_$type: $name";
2060         push @header, "ui_type: $type";
2061         push @header, "ui_name: $name";
2062         push @header, "ui_page_template: $ref->{ui_page_template}";
2063         push @header, "ui_version: " . Vend::Tags->version();
2064         delete $ref->{ui_name};
2065         delete $ref->{ui_type};
2066         delete $ref->{"ui_$type"};
2067         delete $ref->{ui_slots};
2068         delete $ref->{ui_version};
2069         delete $ref->{ui_page_template};
2070         delete $ref->{ui_page_picture};
2071         my $body = delete $ref->{CONTENT};
2072         $body =~ s/\r\n/\n/g;
2073         $body =~ s/\r/\n/g;
2074
2075         my @controls = '[control reset=1]';
2076
2077         for my $r (@$slots) {
2078                 next unless $r->{where};
2079                 $found_something++;
2080                 push @controls, '[control-set]';
2081                 my @order = 'component';
2082                 my %seen = qw/ code 1 mv_ip 1 where 1 class 1 component 1 /;
2083                 push @order, grep !$seen{$_}++, sort keys %$r;
2084                 for(@order) {
2085                         next if /^_/;
2086                         push @controls, "\t[" . "$_]$r->{$_}" . "[/$_]";
2087                 }
2088                 push @controls, '[/control-set]';
2089         }
2090         push @controls, '[control reset=1]';
2091
2092         my @bods;
2093         for my $var (@$layout) {
2094                 if ($var eq 'UI_CONTENT') {
2095                         push @bods, "<!-- BEGIN CONTENT -->";
2096                         $body =~ s/^\s*\n//;
2097                         $body =~ s/\n\s*$//;
2098                         push @bods, $body;
2099                         push @bods, "<!-- END CONTENT -->";
2100                 }
2101                 elsif ($var =~ /^[A-Z]/) {
2102                         $found_something++;
2103                         push @bods, '@_' . $var . '_@';
2104                 }
2105                 else {
2106 #::logDebug("bad bod: $var");
2107                 }
2108         }
2109
2110         if($ref->{POSTAMBLE} =~ /\S/) {
2111                 $found_something++;
2112                 push @bods, "<!-- BEGIN POSTAMBLE -->";
2113                 $ref->{POSTAMBLE} =~ s/^\s*\n//;
2114                 $ref->{POSTAMBLE} =~ s/\n\s*$//;
2115                 $ref->{POSTAMBLE} =~ s/\r\n|\r/\n/g;
2116                 push @bods, $ref->{POSTAMBLE};
2117                 push @bods, "<!-- END POSTAMBLE -->";
2118         }
2119         delete $ref->{POSTAMBLE};
2120
2121         return $body unless $found_something;
2122
2123         for(sort keys %$ref) {
2124                 next unless /^ui_/;
2125                 my $val = delete $ref->{$_};
2126                 next unless length($val);
2127                 push @header, "$_: " . trim_format($val);
2128         }
2129
2130         # Anything left?
2131         for(sort keys %$ref) {
2132                 # We don't do anything here, don't want junk
2133                 delete $ref->{$_};
2134         }
2135
2136         my $out = "[comment]\n";
2137         $out .= join "\n", @header;
2138         $out .= "\n[/comment]\n";
2139         $out .= "\n";
2140         $out .= join "\n", @sets;
2141         $out .= "\n\n";
2142         $out .= join "\n", @controls;
2143         $out .= "\n\n";
2144         $out .= join "\n", @bods;
2145         $out .= "\n";
2146 }
2147
2148 sub format_template {
2149         my ($ref) = @_;
2150         my $type = 'template';
2151 #::logDebug("called format_template name=$ref->{ui_name} type=$ref->{ui_type}");
2152         $ref->{ui_type} eq $type
2153                 or death("publish_$type", "Type must be %s to publish %s", $type, $type);
2154         my $name = $ref->{ui_name}
2155                 or death("publish_$type", "Must have name to publish %s", $type);
2156
2157         my @header;
2158         my @controls;
2159         my @sets;
2160         my $order = delete $ref->{ui_display_order} || [];
2161
2162         # Do this first to get these things out of reference
2163         # n=name k=key v=value
2164         for my $n (@$order) {
2165                 my $r = delete $ref->{$n};
2166                 next unless $r;
2167                 my $default = defined $r->{default} ? $r->{default} : '';
2168                 my $out = "$n:\n";
2169                 for my $k (sort keys %$r) {
2170                         my $v = trim_format($r->{$k});
2171                         $out .= "\t$k: $v\n";
2172                 }
2173                 push @controls, $out;
2174                 push @sets, "[set $n]" . $default . '[/set]';
2175
2176         }
2177
2178         # Things we want every time
2179
2180         push @header, "ui_$type: $name";
2181         push @header, "ui_type: $type";
2182         push @header, "ui_name: $name";
2183         push @header, "ui_version: " . Vend::Tags->version();
2184         delete $ref->{ui_name};
2185         delete $ref->{ui_type};
2186         delete $ref->{"ui_$type"};
2187         delete $ref->{ui_slots};
2188         delete $ref->{ui_version};
2189         my $body = delete $ref->{ui_body};
2190         $body =~ s/\r\n/\n/g;
2191         $body =~ s/\r/\n/g;
2192
2193         my $dir = $::Variable->{UI_REGION_DIR} || 'templates/regions';
2194
2195         my $layout = delete $ref->{ui_template_layout} || [];
2196         my $regdir;
2197         for my $var (@$layout) {
2198                 next if $var eq 'UI_CONTENT';
2199                 my $thing = delete($ref->{$var});
2200                 my $r;
2201                 my $v;
2202                 $r = $Vend::Cfg->{DirConfig}
2203                         and $r = $r->{Variable}
2204                                 and $v = $r->{$var}
2205                                         and Vend::Tags->write_relative_file($v, $thing)
2206                                                 and next;
2207                 if(! $regdir and ref($r) eq 'HASH') {
2208                         my ($k, $v);
2209                         while( ($k, $v) = each %$r) {
2210                                 last if $k =~ /_(TOP|BOTTOM)$/;
2211                         }
2212                         $regdir = $v;
2213                         $regdir =~ s:/[^/]+$::;
2214                 }
2215                 if(! $regdir) {
2216                         pain('format_template',
2217                                  "unable to write dynamic variable, saving %s to $dir",
2218                                  $var);
2219                         $regdir = $dir;
2220                 }
2221                 Vend::Tags->write_relative_file("$regdir/$var", $thing)
2222                         or
2223                         death('format_template', "unable to write any dynamic variable, help!");
2224                 pain('publish_template', "Must apply changes for access to this template.");
2225         }
2226
2227         $ref->{ui_template_layout} = join ", ", @$layout;
2228
2229         if(my $pp = delete $ref->{ui_page_picture}) {
2230                 $pp =~ s/^\s+//;
2231                 $pp =~ s/\s+$//;
2232                 $pp =~ s{^\s*<!--+\s*BEGIN PAGE_PICTURE\s*--+>\s*}{};
2233                 $pp =~ s{\s*<!--+\s*END PAGE_PICTURE\s*--+>\s*$}{};
2234                 $pp = qq{<!-- BEGIN PAGE_PICTURE -->\n$pp\n<!-- END PAGE_PICTURE -->\n};
2235                 push @sets, $pp;
2236         }
2237
2238         for(sort keys %$ref) {
2239                 next unless /^ui_/;
2240                 my $val = delete $ref->{$_};
2241                 next unless length($val);
2242                 push @header, "$_: " . trim_format($val);
2243         }
2244
2245         # Anything left?
2246         for(sort keys %$ref) {
2247                 # We don't do anything here, don't want junk
2248                 delete $ref->{$_};
2249         }
2250
2251         my $out = "[comment]\n";
2252         $out .= join "\n", @header;
2253         $out .= "\n\n";
2254         $out .= join "\n", @controls;
2255         $out .= "\n[/comment]\n";
2256         $out .= join "\n", @sets;
2257         $out .= "\n";
2258 }
2259
2260 sub format_component {
2261         my ($ref) = @_;
2262         my $type = 'component';
2263 #::logDebug("format component=" . ::uneval($ref));
2264         $ref->{ui_type} eq $type
2265                 or death("publish_$type", "Type must be %s to publish %s", $type, $type);
2266         my $name = $ref->{ui_name}
2267                 or death("publish_$type", "Must have name to publish %s", $type);
2268
2269         my @header;
2270         my @controls;
2271         my $order = delete $ref->{ui_display_order} || [];
2272
2273         # Do this first to get these things out of reference
2274         # n=name k=key v=value
2275         for my $n (@$order) {
2276                 my $r;
2277                 next unless $r = delete $ref->{$n};
2278                 my $out = "$n:\n";
2279                 for my $k (sort keys %$r) {
2280                         my $v = trim_format($r->{$k});
2281                         $out .= "\t$k: $v\n";
2282                 }
2283                 push @controls, $out;
2284         }
2285
2286         # Things we want every time
2287
2288         push @header, "ui_$type: $name";
2289         push @header, "ui_type: $type";
2290         push @header, "ui_name: $name";
2291         delete $ref->{ui_name};
2292         delete $ref->{ui_type};
2293         delete $ref->{"ui_$type"};
2294         my $body = delete $ref->{ui_body};
2295         $body =~ s/\r\n/\n/g;
2296         $body =~ s/\r/\n/g;
2297
2298         for(sort keys %$ref) {
2299                 next unless /^ui_/;
2300                 my $val = delete $ref->{$_};
2301                 next unless length($val);
2302                 push @header, "$_: " . trim_format($val);
2303         }
2304
2305         # Anything left?
2306         for(sort keys %$ref) {
2307                 push @header, "$_: " . trim_format(delete $ref->{$_});
2308         }
2309         my $out = "[comment]\n";
2310         $out .= join "\n", @header;
2311         $out .= "\n\n";
2312         $out .= join "\n", @controls;
2313         $out .= "\n[/comment]\n";
2314         $out .= $body;
2315 }
2316
2317 sub write_page {
2318         my ($record, $dest) = @_;
2319         my $dir = $::Variable->{UI_PAGE_DIR} || 'pages';
2320         $dest ||= "$dir/$record->{code}";
2321         Vend::Tags->write_relative_file($dest, $record->{page_text});
2322 }
2323
2324 sub write_template {
2325         my ($record, $dest) = @_;
2326         my $dir = $::Variable->{UI_TEMPLATE_DIR} || 'templates';
2327         $dest ||= "$dir/$record->{code}";
2328         Vend::Tags->write_relative_file($dest, $record->{temp_text});
2329 }
2330
2331 sub write_component {
2332         my ($record, $dest) = @_;
2333         my $dir = $::Variable->{UI_COMPONENT_DIR} || 'templates/components';
2334         $dest ||= "$dir/$record->{code}";
2335         Vend::Tags->write_relative_file($dest, $record->{comp_text});
2336 }
2337
2338 sub ref_page {
2339         my ($ref, $opt) = @_;
2340         my $vref = $opt->{values_ref} || \%CGI::values;
2341         my $curtime = strftime("%Y%m%d%H%M%S", gmtime() );
2342         my $showdate = Vend::Tags->filter('date_change', $vref->{ui_show_date});
2343         my $expdate  = Vend::Tags->filter('date_change', $vref->{ui_expiration_date});
2344         my $r = {
2345                 content_class => $ref->{ui_class},
2346                 mod_time => strftime("%Y%m%d%H%M%S", gmtime()),
2347                 expiration_date => $expdate,
2348                 show_date => $showdate,
2349                 came_from => $ref->{ui_source},
2350                 base_code => $ref->{ui_name},
2351                 ### comp_settings => uneval_it($ref),
2352                 hostname => $Vend::remote_addr,
2353                 mod_user => $Vend::username,
2354         };
2355         if($curtime lt $showdate or $expdate && $curtime gt $expdate) {
2356                 $r->{code} = $r->{base_code} . ".$curtime";
2357         }
2358         else {
2359                 $r->{code} = $r->{base_code};
2360         }
2361         return $r;
2362 }
2363
2364 sub ref_content {
2365         my ($ref, $opt) = @_;
2366         my $vref = $opt->{values_ref} || \%CGI::values;
2367         my $curtime = strftime("%Y%m%d%H%M%S", gmtime() );
2368         my $showdate = Vend::Tags->filter('date_change', $vref->{ui_show_date});
2369         my $expdate  = Vend::Tags->filter('date_change', $vref->{ui_expiration_date});
2370         my $r = {
2371                 reftype => $ref->{ui_type},
2372                 content_class => $ref->{ui_class},
2373                 mod_time => strftime("%Y%m%d%H%M%S", gmtime()),
2374                 expiration_date => $expdate,
2375                 show_date => $showdate,
2376                 came_from => $ref->{ui_source},
2377                 base_code => $ref->{ui_name},
2378                 ### comp_settings => uneval_it($ref),
2379                 hostname => $Vend::remote_addr,
2380                 mod_user => $Vend::username,
2381         };
2382         if($curtime lt $showdate or $expdate && $curtime gt $expdate) {
2383                 $r->{code} = $r->{base_code} . ".$curtime";
2384         }
2385         else {
2386                 $r->{code} = $r->{base_code};
2387         }
2388         return $r;
2389 }
2390
2391 sub preview_dir {
2392         my $dir = $Vend::Cfg->{ScratchDir};
2393         $dir =~ s,^$Vend::Cfg->{VendRoot}/,,;
2394         $dir .= "/previews/$Vend::Session->{id}";
2395         return $dir;
2396 }
2397
2398 sub preview_page {
2399         my ($ref, $opt) = @_;
2400         my $dest = preview_dir();
2401         $dest .= "/$ref->{ui_name}";
2402         $::Scratch->{tmp_tmpfile} = $dest;
2403         my $tmp = { %$ref };
2404         my $record = ref_content($tmp)
2405                 or return death("preview_template", "bad news");
2406         my $text = format_page(
2407                                         $tmp,
2408                                         {
2409                                                 preview => $::Variable->{PAGE_TITLE_NAME} || 'page_title',
2410                                                 preview_tag => errmsg('****PREVIEW****'),
2411                                         },
2412                                 );
2413         $record->{page_text} = $text;
2414 #::logDebug("header record: " . uneval($record));
2415         write_page($record, $dest);
2416 }
2417
2418 sub publish_page {
2419         my ($ref, $opt) = @_;
2420         my $vref = $opt->{values_ref} || \%CGI::values;
2421         my $dest = $vref->{ui_destination};
2422         $dest =~ s/\s+$//;
2423         $dest =~ s/^\s+$//;
2424         my $record = ref_content($ref, $opt)
2425                 or return death("publish_page", "bad news");
2426         delete_preview_page($ref, $opt);
2427         my $text = format_page($ref);
2428         $record->{page_text} = $text;
2429         write_page($record);
2430 }
2431
2432 sub publish_template {
2433         my ($ref, $opt) = @_;
2434         my $vref = $opt->{values_ref} || \%CGI::values;
2435         my $dest = $vref->{ui_destination};
2436         $dest =~ s/\s+$//;
2437         $dest =~ s/^\s+$//;
2438         my $record = ref_content($ref)
2439                 or return death("publish_template", "bad news");
2440 #::logDebug("Got publish_template ref=" . uneval($ref));
2441         my $text = format_template($ref);
2442         $record->{temp_text} = $text;
2443 #::logDebug("header record: " . uneval($record));
2444         delete_store('template', $record->{code});
2445         write_template($record);
2446 }
2447
2448 sub publish_component {
2449         my ($ref, $opt) = @_;
2450         my $vref = $opt->{values_ref} || \%CGI::values;
2451         my $dest = $vref->{ui_destination};
2452         $dest =~ s/\s+$//;
2453         $dest =~ s/^\s+$//;
2454         my $record = ref_content($ref)
2455                 or return death("publish_component", "bad news");
2456         my $text = format_component($ref);
2457         $record->{comp_text} = $text;
2458 #::logDebug("publish_component header record: " . uneval($record));
2459         write_component($record);
2460 }
2461
2462 sub delete_preview_page {
2463         my ($ref, $opt) = @_;
2464         my $dir = preview_dir();
2465         if($ref->{ui_name} and -f "$dir/$ref->{ui_name}") {
2466                 unlink "$dir/$ref->{ui_name}";
2467         }
2468 }
2469
2470 sub cancel_edit {
2471         my ($ref, $opt) = @_;
2472         delete_preview_page($ref, $opt);
2473         my $store = $Vend::Session->{content_edit}
2474                 or return death('cancel', 'content store not found');
2475         $store = $store->{$ref->{ui_type}}
2476                 or return death('cancel', 'content store not found');
2477         delete $store->{$ref->{ui_name}};
2478 }
2479
2480 my %illegal = (
2481         code  => 1,
2482         where => 1,
2483         class => 1,
2484 );
2485
2486 sub add_attribute {
2487         my ($ref, $opt) = @_;
2488         my $vref = $opt->{values_ref} || \%CGI::values;
2489
2490         my $name = $vref->{code}
2491                 or return death('code', 'BLANK');
2492
2493         if($illegal{$name}) {
2494                 return death('code', 'reserved attribute name: %s', $name);
2495         }
2496
2497         my @found = grep length($vref->{$_}), @valid_attr;
2498         my %hash = map { $_ => $vref->{$_} } @found;
2499 #::logDebug("add attribute hash: " . uneval(\%hash));
2500         push @{$ref->{ui_display_order} ||= []}, $name;
2501         $ref->{$name} = \%hash;
2502 }
2503
2504 sub modify_slots {
2505         my ($ref, $opt) = @_;
2506         my $vref = $opt->{values_ref} || \%CGI::values;
2507
2508         my $slots = $ref->{ui_slots};
2509         assert('ui_slots', $slots, 'ARRAY')
2510                 or return undef;
2511
2512         my $slots_in = {};
2513         for(grep /^slot\d+$/, keys %$vref) {
2514                 /(\d+)/;
2515                 my $snum = $1;
2516                 $snum--;
2517                 $slots_in->{$snum} = $vref->{$_};
2518         }
2519
2520 #::logDebug("slots in=" . ::uneval($slots_in));
2521
2522         for(my $i = 0; $i < @$slots; $i++) {
2523                 my $s = $slots->[$i];
2524 #::logDebug("looking at slot $i, slot_in=$slots_in->{$i}, slot code=$s->{component}, slot=" . ::uneval($slots->[$i]) );
2525                 next if $s->{component} eq $slots_in->{$i};
2526 #::logDebug("SLOTS ARE DIFFERENT, $s->{code} ne $slots_in->{$i}");
2527                 my $new = {
2528                         code      => $slots_in->{$i},
2529                         component => $slots_in->{$i},
2530                         class     => $s->{class},
2531                         where     => $s->{where},
2532                 };
2533                 $slots->[$i] = $new;
2534         }
2535
2536         return 1;
2537 }
2538
2539 sub modify_component {
2540         my ($ref, $opt) = @_;
2541         my $vref = $opt->{values_ref} || \%CGI::values;
2542
2543         my $pos = $vref->{ui_content_pos};
2544         defined $pos
2545                 or return death('ui_content_pos', '%s is BLANK', 'position');
2546
2547         assert('ui_slots', $ref->{ui_slots}, 'ARRAY')
2548                 or return undef;
2549         my $comp = $ref->{ui_slots}[$pos]
2550                 or return death("Component change", "No component at position %s", $pos);
2551 #::logDebug("changing slot position $pos, comp=" . ::uneval($comp));
2552
2553         my $name           = $comp->{component};
2554         my $submitted_name = $vref->{code};
2555
2556         if($name ne $submitted_name) {
2557                 my $class = $comp->{class};
2558                 my $where = $comp->{where};
2559                 $comp = {
2560                         code      => $submitted_name,
2561                         component => $submitted_name,
2562                         class     => $class,
2563                         where     => $where,
2564                 };
2565                 my $cref = read_component($submitted_name,
2566                                                                         {
2567                                                                                 type => 'component',
2568                                                                                 component_dir => $opt->{component_dir},
2569                                                                                 single => 1,
2570                                                                         });
2571                 assert("component $submitted_name", $cref, 'HASH')
2572                         or return undef;
2573 #::logDebug("cref=" . uneval($cref));
2574                 my $order = $cref->{ui_display_order} || [];
2575                 for(@$order) {
2576                         $comp->{$_} = $cref->{$_}{default}
2577                                                         if defined $cref->{$_}{default};
2578
2579                 }
2580                 $ref->{ui_slots}[$pos] = $comp;
2581                 return 1;
2582         }
2583
2584         my @fields = split /[\0,\s]+/, $vref->{mv_data_fields};
2585         my @found = grep defined($vref->{$_}), @fields;
2586
2587         for(@found) {
2588                 next if $illegal{$_};
2589                 next if /^_/;
2590                 $comp->{$_} = $vref->{$_};
2591         }
2592 #::logDebug("changing slot position $pos, comp now=" . ::uneval($comp));
2593
2594         return 1;
2595 }
2596
2597 sub modify_page_control {
2598         my ($ref, $opt) = @_;
2599         my $vref = $opt->{values_ref} || \%CGI::values;
2600
2601         my $name = $vref->{code}
2602                 or return death('code', 'BLANK');
2603
2604         my @fields = split /[\0,\s]+/, $vref->{mv_data_fields};
2605         my @found = grep defined($vref->{$_}), @fields;
2606         my $vals      = $ref->{ui_values};
2607         my $scratches = $ref->{ui_scratchtype};
2608
2609         assert('page values', $vals, 'HASH')
2610                 or return undef;
2611
2612         assert('scratchtypes', $scratches, 'HASH')
2613                 or return undef;
2614
2615         for(@found) {
2616                 next if $illegal{$_};
2617                 my $f = $_;
2618                 if(s/^_scratchtype_//) {
2619                         $scratches->{$_} = $vref->{$f};
2620                 }
2621                 else {
2622                         $vals->{$_} = $vref->{$_};
2623                 }
2624         }
2625         return 1;
2626 }
2627
2628 sub modify_attribute {
2629         my ($ref, $opt) = @_;
2630         my $vref = $opt->{values_ref} || \%CGI::values;
2631
2632         my $name = $vref->{code}
2633                 or return death('code', 'BLANK');
2634
2635         if($illegal{$name}) {
2636                 return death('code', 'reserved attribute name: %s', $name);
2637         }
2638
2639         my @found = grep length($vref->{$_}), @valid_attr;
2640
2641         my $r = $ref->{$name}
2642                 or return death($name, 'Attribute %s not found', $name);
2643
2644         for(@found) {
2645                 $r->{$_} = $vref->{$_};
2646         }
2647         return 1;
2648 }
2649
2650 my %illegal_top = (
2651         default => {
2652                 ui_content_op   => 1,
2653                 ui_name         => 1,
2654                 ui_type         => 1,
2655                 ui_source       => 1,
2656                 ui_destination  => 1,
2657         },
2658 );
2659
2660 my %always_top = (
2661         default => {
2662                 ui_label   => 1,
2663         },
2664 );
2665
2666 sub modify_top_attribute {
2667         my ($ref, $opt) = @_;
2668         my $vref = $opt->{values_ref} || \%CGI::values;
2669
2670         my $illegal = $illegal_top{$ref->{ui_type}} || $illegal_top{default};
2671         my $always = $always_top{$ref->{ui_type}} || $always_top{default};
2672
2673         my @found;
2674         for(keys %$vref) {
2675 #::logDebug("checking $_ ($ref->{$_} -> $vref->{$_}) for legality");
2676                 next if $illegal->{$_};
2677                 next unless defined $ref->{$_} or $always->{$_};
2678 #::logDebug("$_ is legal and defined in ref (or is always allowed)");
2679                 push @found, $_;
2680         }
2681
2682         for(@found) {
2683 #::logDebug("modifying $_, $ref->{$_} to $vref->{$_}");
2684                 $ref->{$_} = $vref->{$_};
2685         }
2686         return 1;
2687 }
2688
2689 sub modify_body {
2690         my ($ref, $opt) = @_;
2691         my $vref = $opt->{values_ref} || \%CGI::values;
2692         my $code = $vref->{code} || 'ui_body';
2693 #::logDebug("modify body, code=$code");
2694         defined $vref->{ui_body_text}
2695                 or return death(
2696                                         $ref->{ui_name},
2697                                         'Body content not found for %s %s',
2698                                         $ref->{ui_type},
2699                                         $ref->{ui_name},
2700                                         );
2701         length $vref->{ui_body_text}
2702                 or pain(
2703                                 $ref->{ui_name},
2704                                 'Body content for %s defined but had zero length.',
2705                                 $ref->{ui_name},
2706                                 );
2707 #::logDebug("modified ui_body, length=" . length($vref->{ui_body_text}));
2708         $ref->{$code} = $vref->{ui_body_text};
2709         return 1;
2710 }
2711
2712 sub delete_attribute {
2713         my ($ref, $opt) = @_;
2714         my $vref = $opt->{values_ref} || \%CGI::values;
2715
2716         my $name = $vref->{code}
2717                 or return death('code', 'BLANK');
2718
2719         my $ary = $ref->{ui_display_order} ||= [];
2720
2721         my $i = 0;
2722         my $found;
2723         for(@$ary) {
2724                 $found = 1, last if $_ eq $name;
2725                 $i++;
2726         }
2727
2728         return death('code', 'attribute %s not found', $name)
2729                 unless $found;
2730
2731         splice @$ary, $i, 1;
2732         delete $ref->{$name};
2733 }
2734
2735 sub reorder_attribute {
2736         my ($ref, $opt) = @_;
2737         my $vref = $opt->{values_ref} || \%CGI::values;
2738
2739         my $name = $vref->{code}
2740                 or return death('code', 'BLANK');
2741
2742         my $direc = $vref->{ce_motion}
2743                 or pain('ce_motion', 'No direction specified, defaulting to %s', 'up');
2744         if($direc eq 'down') {
2745                 $direc = 1;
2746         }
2747         else {
2748                 $direc = -1;
2749         }
2750
2751         my $ary = $ref->{ui_display_order} ||= [];
2752
2753         my $idx = 0;
2754         my $found;
2755         for(@$ary) {
2756                 $found = 1, last if $_ eq $name;
2757                 $idx++;
2758         }
2759
2760         return death('code', 'attribute %s not found', $name)
2761                 unless $found;
2762
2763         my $new = $idx + $direc;
2764         if($new < 0) {
2765                 return death('ce_motion', 'cannot move %s from %s', 'up', 'first');
2766         }
2767         elsif($new >= @$ary) {
2768                 return death('ce_motion', 'cannot move %s from %s', 'down', 'last');
2769         }
2770         my $src  = $ary->[$idx];
2771         $ary->[$idx] = $ary->[$new];
2772         $ary->[$new] = $src;
2773         @$ary = grep defined $_, @$ary;
2774
2775         return $direc;
2776 }
2777
2778 my %immediate_action = (
2779         purge       => sub {
2780                                                 delete $Vend::Session->{content_edit};
2781                                                 File::Path::rmtree(preview_dir());
2782                                         },
2783 );
2784
2785 my %common_action = (
2786                 cancel              => \&cancel_edit,
2787                 motion              => \&reorder_attribute,
2788                 modify_top                      => \&modify_top_attribute,
2789                 modify              => \&modify_attribute,
2790                 modify_body         => \&modify_body,
2791                 delete              => \&delete_attribute,
2792                 add                 => \&add_attribute,
2793 );
2794
2795 my %specific_action = (
2796         page => {
2797                 preview                         => \&preview_page,
2798                 publish                         => \&publish_page,
2799                 modify                          => \&modify_top_attribute,
2800                 modify_control          => \&modify_page_control,
2801                 modify_component        => \&modify_component,
2802                 modify_slots            => \&modify_slots,
2803         },
2804         template => {
2805                 publish                         => \&publish_template,
2806         },
2807         component => {
2808                 publish                         => \&publish_component,
2809         },
2810 );
2811
2812 sub content_modify {
2813         my($ops, $name, $type, $opt) = @_;
2814
2815         $opt ||= {};
2816         my $vref = $opt->{values_ref} || \%CGI::values;
2817         $ops ||= $vref->{ui_content_op};
2818
2819         my $sub;
2820         if($sub = $immediate_action{$ops}) {
2821 #::logDebug("content modify immediate action");
2822                 return $sub->(undef, $opt);
2823         }
2824 #::logDebug("content_modify: called, name=$name type=$type ops=$ops");
2825
2826         $type ||= $vref->{ui_type}
2827                 or return death('ui_type', "Must specify a type");
2828
2829         $name ||= $vref->{ui_name}
2830                 or return death('ui_name', "Must specify a name for %s", $type);
2831 #::logDebug("content_modify: called, name=$name type=$type");
2832
2833         my(@ops) = split /[\s,\0]+/, $ops;
2834 #::logDebug("content_modify: ops=" . join(",", @ops) . " vref=$vref");
2835
2836         my $ref = get_store($type,$name)
2837                 or return death('content_modify', "%s %s not found", $type, $name);
2838
2839        #in case of an alternative component name
2840        if ($vref->{ui_destination} ne "") {
2841            $name = $ref->{ui_name} = $vref->{ui_destination};
2842        }
2843
2844
2845         foreach my $op (@ops) {
2846 #::logDebug("content_modify: doing name=$name type=$type op=$op");
2847 #::logDebug("content_modify: doing name=$name type=$type op=$op ref=" . uneval($ref));
2848
2849                 $sub = $specific_action{$type}{$op} || $common_action{$op};
2850
2851                 if(! $sub) {
2852                         return death('ui_content_op', "%s %s not found", 'operation', $op );
2853                 }
2854
2855 #::logDebug("ref before modify, code=$vref->{code}=" . uneval($ref));
2856                 if(! $sub->($ref, $opt) ) {
2857                         pain('content_modify', "op %s failed for %s %s.", $op, $type, $name);
2858                 }
2859 #::logDebug("ref AFTER modify=, code=$vref->{code}" . uneval($ref));
2860
2861         }
2862         return 1;
2863 }
2864
2865 sub page_editor {
2866         my($name, $opt, $form_template) = @_;
2867
2868         my $source;
2869
2870         $opt->{page_edit} = 1;
2871
2872 #::logDebug("in page_editor, name=$name");
2873         my $pref = read_page($name, $opt);
2874
2875         if(ref($pref) ne 'HASH') {
2876                 return death('page_editor', "Invalid page: %s", uneval($pref));
2877         }
2878         else {
2879                 $pref = get_store('page', $name) || $pref;
2880         }
2881
2882         save_store('page', $name, $pref);
2883
2884         parse_page($pref, $opt);
2885
2886         publish_page($pref, $opt) if $opt->{new};
2887
2888 #::logDebug("found a template name=$pref->{ui_name} store=$name: " . uneval($pref));
2889
2890         my ($overall, $comp) = page_region($pref, $opt);
2891
2892         my $to_run = [
2893                                         $opt->{list_prefix}     || 'pages',
2894                                         $opt->{prefix}          || 'page',
2895                                         [$overall],
2896                                         $opt->{comp_list_prefix} || 'components',
2897                                         $opt->{comp_prefix}       || 'comp',
2898                                         $comp,
2899                                 ];
2900
2901         my $bref = $form_template ? \$form_template : \$Template{page_standard} ;
2902 #::logDebug("table-editor records: " . uneval($pref));
2903 #::logDebug("table-editor overall: " . uneval($overall));
2904         return run_templates($overall, $to_run, $bref);
2905 }
2906
2907 sub template_editor {
2908         my($name, $opt, $form_template) = @_;
2909 #::logDebug("template editor called, name=$name, opt=" . uneval($opt));
2910         my $source;
2911
2912         $opt->{template_edit} = 1;
2913
2914         my $tref = get_store('template', $name) || read_template($name, $opt);
2915         save_store('template', $name, $tref);
2916
2917         parse_template($tref, $opt);
2918
2919         my ($overall, $reg, $comp, $cont) = template_region($tref, $opt);
2920         my $to_run = [
2921                                         $opt->{list_prefix}     || 'templates',
2922                                         $opt->{prefix}          || 'tem',
2923                                         [$tref],
2924                                         $opt->{region_list_prefix} || 'regions',
2925                                         $opt->{region_prefix}     || 'reg',
2926                                         $reg,
2927                                         $opt->{comp_list_prefix} || 'components',
2928                                         $opt->{comp_prefix}       || 'comp',
2929                                         $comp,
2930                                         $opt->{cont_list_prefix} || 'controls',
2931                                         $opt->{cont_prefix}       || 'cont',
2932                                         $cont,
2933                                 ];
2934
2935         my $bref = $form_template ? \$form_template : \$Template{template_standard} ;
2936 #::logDebug("table-editor records: " . uneval($tref));
2937 #::logDebug("table-editor overall: " . uneval($overall));
2938         return run_templates($overall, $to_run, $bref);
2939 }
2940
2941 sub component_editor {
2942         my($name, $opt, $form_template) = @_;
2943 #::logDebug("component editor called, cref=$cref opt=" . uneval($opt));
2944
2945         $opt->{component_edit} = 1;
2946
2947         my $cref = read_component($name, $opt);
2948         if(! ref($cref) eq 'HASH') {
2949                 return death('component_editor', "Invalid component: %s", uneval($cref));
2950         }
2951
2952         $cref = get_store('component', $name) || $cref;
2953
2954         save_store('component', $name,$cref);
2955
2956         my ($overall, $tref) = component_region($cref, $opt);
2957         my $to_run = ['components', 'comp', $tref];
2958
2959         my $bref = $form_template ? \$form_template : \$Template{component_standard} ;
2960 #::logDebug("table-editor records: " . uneval($tref));
2961 #::logDebug("table-editor overall: " . uneval($overall));
2962         return run_templates($overall, $to_run, $bref);
2963 }
2964
2965 my %display_remap = qw/
2966         type    widget
2967         label   description
2968 /;
2969
2970 sub remap_opts {
2971         my $opt = shift;
2972         my $name;
2973         $name = shift and $opt->{name} = $name;
2974         while( my($k,$v) = each %display_remap ) {
2975                 delete $opt->{$v}, next if defined $opt->{$k};
2976                 next unless defined $opt->{$v};
2977                 $opt->{$k} = delete $opt->{$v};
2978         }
2979         return $opt;
2980 }
2981
2982 sub run_templates {
2983         my ($opt, $to_run, $bref) = @_;
2984 #::logDebug("event_array=" . ::uneval($to_run));
2985
2986         my %todo = qw/
2987                 components      1
2988                 regions         1
2989                 pages           1
2990                 templates       1
2991         /;
2992         my $region;
2993         my $prefix;
2994         my $ary;
2995         my @things = @$to_run;
2996         while( $region = shift  @things ) {
2997                 $prefix = shift @things;
2998                 $ary    = shift @things;
2999
3000                 delete $todo{$region};
3001 #::logDebug("run_template region=$region prefix=$prefix ary=$ary from=$opt->{from_session}");
3002                 $region =~ s/[-_]/[-_]/g;
3003
3004                 next unless $$bref =~ m{\[$region\](.*?)\[/$region\]}is;
3005                 my $run = $1;
3006
3007                 if( $run !~ /\S/ or (! $ary and $run !~ /no[-_]match\]/i) ) {
3008                         $$bref =~ s{\[$region\](.*?)\[/$region\]}{}sgi;
3009                         next;
3010                 }
3011                 $opt->{prefix} = $prefix;
3012                 $opt->{object} = {
3013                                                         mv_results => $ary,
3014                                                         matches => scalar(@$ary),
3015                                                         mv_matchlimit => $opt->{ml} || 100,
3016                                                 };
3017                 $$bref =~ s{\[$region\](.*?)\[/$region\]}
3018                                    {Vend::Interpolate::region($opt, $1)}eisg;
3019         }
3020         for(keys %todo) {
3021                 $$bref =~ s,\[$region\](.*?)\[/$region\],,igs;
3022         }
3023         return $$bref;
3024 }
3025
3026 sub editor {
3027         my ($item, $opt, $form_template) = @_;
3028
3029         $::Scratch->{ce_modify} = '[content-modify]';
3030         if($opt->{type} eq 'page') {
3031                 return page_editor($opt->{name}, $opt, $form_template);
3032         }
3033         elsif ($opt->{type} eq 'template') {
3034                 return template_editor($opt->{name}, $opt, $form_template);
3035         }
3036         elsif ($opt->{type} eq 'component') {
3037                 return component_editor($opt->{name}, $opt, $form_template);
3038         }
3039         else {
3040                 return errmsg("Don't know how to edit type '%s'.\n", $opt->{type});
3041         }
3042 }
3043
3044 $Template{component_standard} = <<'EOF';
3045 EOF
3046
3047 $Template{page_standard} = <<EOF;
3048 <script language=JavaScript>
3049 function visible (index) {
3050         var vis = new Array;
3051         var xi;
3052         var dosel;
3053         var selnam = 'dynform' + index;
3054
3055         for( xi = 1; ; xi++) {
3056                 nam = 'dynform' + xi;
3057                 var el = document.getElementById(nam);
3058                 if(el == undefined) break;
3059
3060                 el.style.visibility = 'Hidden';
3061
3062         }
3063         var element = document.getElementById(selnam);
3064         element.style.visibility = 'Visible';
3065         return;
3066 }
3067 </script>
3068
3069 <FORM METHOD=POST ACTION="[editor-param url]" ENCTYPE="[editor-param enctype]">
3070 <table width="[editor-param table_width]" [editor-param table_extra]>
3071 <tr>
3072         <td width="[editor-param left_width]" [editor-param left_extra]>
3073 [component-links]
3074         <ul>
3075         [list]
3076         <li> <A HREF="javascript:void(0)"
3077                         onClick="visible([clink-increment])"
3078                 >[clink-param label]</A></li>
3079         [/list]
3080 [/component-links]
3081         </td>
3082 [component-menus]
3083         <td>
3084 <div
3085         style="
3086                         Position:Relative;
3087                         Left:0; Top:0; Height:504; Width:404;
3088                         Visibility:Visible;
3089                         z-index:0;
3090                 "
3091 >
3092 [cmenu-on-match]
3093 <div
3094         style="
3095                         Position:Absolute;
3096                         Left:0; Top:0; Height:504; Width:404;
3097                         Visibility:Visible;
3098                         z-index:0;
3099                         background-color: [cmenu-param bordercolor]
3100                 "
3101 >&nbsp;</div>
3102 <div
3103         style="
3104                         Position:Absolute;
3105                         Left:2; Top:2; Height:500; Width:400;
3106                         Visibility:Visible;
3107                         z-index:1;
3108                         background-color: [cmenu-param bgcolor]
3109                 "
3110 >&nbsp;</div>
3111 [/cmenu-on-match]
3112 [cmenu-list]
3113 <div
3114         id=dynform[loop-code]
3115         style="
3116                         Position:Absolute;
3117                         Left:2; Top:2; Width:300; Height: 300;
3118                         Visibility:[loop-change 1][condition]1[/condition]Visible[else]Hidden[/else][/loop-change 1];
3119                         z-index:2;
3120                 "
3121 >Element [loop-code] <select name=dynform[loop-code]widget>
3122 <OPTION>A
3123 <OPTION [selected cgi=1 name=dynform[loop-code]widget value=B]>B
3124 <OPTION [selected cgi=1 name=dynform[loop-code]widget value=C]>C
3125 </select>
3126 </div>
3127 [/cmenu-list]
3128 </div>
3129 [/component-menus]
3130         </td>
3131
3132 </tr>
3133
3134 <tr>
3135   <td width="[editor-param left_width]" [editor-param left_extra]>
3136
3137 [content-edit]
3138         <h2>Content edit</h2>
3139         [content-list]
3140         [if-content-param label]<h2>[content-param label]<br>[/if-content-param]
3141         <textarea
3142                 name="[content-var]"
3143                 ROWS="[content-param vsize]" COLS="[content-param hsize]">
3144         [/content-list]
3145 [/content-edit]
3146
3147   </td>
3148
3149   <td>
3150         Global menu
3151   </td>
3152 </tr>
3153 </table>
3154 </form>
3155
3156 EOF
3157
3158 sub write_xml_component {
3159         my ($c) = @_;
3160
3161         return undef unless ref($c) eq 'HASH';
3162
3163         my $type;
3164
3165         for(qw/component template page/) {
3166 #::logDebug("check for component type=$_");
3167                 if(exists $c->{"ui_$_"}) {
3168                         $type = $_;
3169                         last;
3170                 }
3171         }
3172 #::logDebug("component type=$type");
3173
3174         if(! $type) {
3175                 logError("unrecognized template:\n%s", uneval($c) );
3176         }
3177
3178         my $out = qq{<?xml version="1.0"?>\n};
3179
3180         my $body  = delete $c->{ui_body};
3181         my $order = delete $c->{ui_display_order} || [];
3182         delete $c->{ui_definition};
3183
3184         my @keys = keys %$c;
3185         my @ui_keys = grep /^ui_/, @keys;
3186
3187         my %ui_key;
3188
3189         my %cattr;
3190         for(@ui_keys) {
3191                 $ui_key{$_} = 1;
3192                 my $val = delete $c->{$_};
3193                 if($_ eq "ui_$type") {
3194                         $cattr{name} ||= $c->{$_};
3195                         next;
3196                 }
3197                 s/^ui_//;
3198                 $cattr{$_} = $val;
3199         }
3200
3201         $out .= "<$type ";
3202
3203         my @ao; # attributes out
3204         while (my ($k, $v) = each %cattr) {
3205                 HTML::Entities::encode($v);
3206                 push @ao, qq{$k="$v"};
3207         }
3208
3209         $out .= join " ", @ao;
3210
3211         $out .= ">\n";
3212
3213         my %wattr;
3214
3215
3216         for my $w (@keys) {
3217                 my $ref = $c->{$w} or next;
3218                 next unless ref($ref) eq 'HASH';
3219                 for(keys %$ref) {
3220                         $wattr{$w} ||= {};
3221                         $wattr{$w}{$_} = $ref->{$_};
3222                 }
3223         }
3224
3225         for my $w (@$order) {
3226                 $out .= qq{\t<attr name="$w">\n};
3227                 for(keys %{$wattr{$w}} ) {
3228                         $out .= "\t\t<$_>$wattr{$w}{$_}</$_>\n";
3229                 }
3230                 $out .= qq{\t</attr>\n};
3231         }
3232
3233         HTML::Entities::encode($body);
3234         $out .= "\t<body>$body</body>\n";
3235         $out .= "</$type>\n";
3236
3237         return $out;
3238 }
3239
3240 sub read_xml_component {
3241         my ($thing, $source) = @_;
3242
3243         require XML::Parser;
3244         my $xml;
3245         my $body;
3246         $thing =~ m{\[comment\]\s*(.*?)\[/comment\](.*)}s
3247                 and $xml = $1
3248                         and $body = $2;
3249
3250         HTML::Entities::encode($body) if $body;
3251
3252         $xml ||= $thing;
3253
3254         $xml =~ s:<body>ENCODED</body>:<body>$body</body>:;
3255         my $p = new XML::Parser Style => 'Tree';
3256         my $tree;
3257
3258         eval {
3259                 $tree = $p->parse($xml);
3260         };
3261         if($@) {
3262                 die "$@\n";
3263         }
3264
3265         my %recognized = qw/ component 1 template 1 page 1/;
3266         my $type = shift @$tree;
3267
3268         if(! $recognized{$type}) {
3269                 logError("unrecognized template type '%s'", $type);
3270                 return undef;
3271         }
3272
3273         my $ref = shift @$tree;
3274         my $comphash = shift @$ref;
3275
3276
3277         my $el = {
3278                         "ui_$type" => $comphash->{name} || 'Yes',
3279                         ui_display_order => [],
3280                         "ui_${type}_source" => $source,
3281                         };
3282
3283         while (my ($k, $v) = each %$comphash ) {
3284                 $el->{"ui_$type" . "_$k"} = $v;
3285         }
3286
3287         my %get = ( attr => 1, body => 1 );
3288
3289         while( my($t, $v) = splice(@$ref, 0, 2) ) {
3290 #Debug("found param=$t");
3291                 next unless $t;
3292                 if(!  defined $get{$t} ) {
3293                         logError('%s: unrecognized %s element %s', 'xml_component_read', $type, $t);
3294                 }
3295                 if($t eq 'attr') {
3296                         my $hash = shift @$v;
3297                         my $name = $hash->{name} || 'unknown';
3298                         push @{$el->{ui_display_order}}, $name;
3299
3300                         while( my ($setting, $ary) = splice(@$v, 0, 2) ) {
3301                                 next unless $setting;
3302                                 $el->{$name}{$setting} = $ary->[2];
3303                         }
3304                 }
3305                 elsif ($t eq 'body') {
3306                         $el->{ui_body} = $v->[2];
3307                 }
3308         }
3309
3310   return $el;
3311
3312 }
3313
3314 1;