site/cgi-bin/modules/BSE/API.pm

   1 package BSE::API;
   2 use strict;
   3 use vars qw(@ISA @EXPORT_OK);
   4 use BSE::Util::SQL qw(sql_datetime now_sqldatetime);
   5 use BSE::Cfg;
   6 require Exporter;
   7 @ISA = qw(Exporter);
   8 @EXPORT_OK = qw(bse_cfg bse_make_product bse_make_catalog bse_encoding bse_add_image bse_add_step_child bse_add_owned_file bse_delete_owned_file bse_replace_owned_file);
   9 use Carp qw(confess croak);
  10 use Fcntl qw(:seek);
  11
  12 my %acticle_defaults =
  13   (
  14    titleImage => '',
  15    thumbImage => '',
  16    thumbWidth => 0,
  17    thumbHeight => 0,
  18    imagePos => 'tr',
  19    release => sql_datetime(time - 86_400),
  20    expire => '2999-12-31',
  21    keyword => '',
  22    template => 'common/default.tmpl',
  23    link => '', # needs to be set
  24    admin => '', # needs to be set
  25    threshold => 5,
  26    summaryLength => 100,
  27    generator => 'Generate::Article',
  28    # level => undef, # needs to be set
  29    listed => 1,
  30    #lastModified => undef, # needs to be set
  31    flags => '',
  32    lastModifiedBy => '',
  33    # created => undef # needs to be set
  34    createdBy => '',
  35    force_dynamic => 0,
  36    cached_dynamic => 0,
  37    inherit_siteuser_rights => 1,
  38    metaDescription => '',
  39    metaKeywords => '',
  40    summary => '',
  41    pageTitle => '',
  42    author => '',
  43    menu => '',
  44    titleAlias => '',
  45    linkAlias => '',
  46   );
  47
  48 my %product_defaults =
  49   (
  50    template => 'shopitem.tmpl',
  51    parentid => 4,
  52    generator => 'Generate::Product',
  53    wholesalePrice => 0,
  54    gst => 0,
  55    leadTime => 0,
  56    options => '',
  57    subscription_id => -1,
  58    subscription_period => 1,
  59    subscription_usage => 3,
  60    subscription_required => -1,
  61    product_code => '',
  62    weight => 0,
  63    length => 0,
  64    height => 0,
  65    width => 0,
  66   );
  67
  68 my %catalog_defaults =
  69   (
  70    template => 'catalog.tmpl',
  71    parentid => 3,
  72    generator => 'Generate::Catalog',
  73   );
  74
  75 sub _set_dynamic {
  76   my ($cfg, $article) = @_;
  77
  78   if ($article->{parentid} == -1) {
  79     $article->{level} = 1;
  80   }
  81   else {
  82     require Articles;
  83     my $parent = Articles->getByPkey($article->{parentid})
  84       or confess "Invalid parent $article->{parentid}\n";
  85     $article->{level} = $parent->{level} + 1;
  86   }
  87
  88   $article->{lastModified} = $article->{created} = now_sqldatetime();
  89 }
  90
  91 sub _finalize_article {
  92   my ($cfg, $article, $editor_class) = @_;
  93
  94   my $editor = $editor_class->new(cfg => $cfg, db => BSE::DB->single);
  95
  96   $article->update_dynamic($cfg);
  97   $article->setAdmin("/cgi-bin/admin/admin.pl?id=$article->{id}");
  98   $article->setLink($editor->make_link($article));
  99   $article->save();
 100 }
 101
 102 {
 103   my $order;
 104   sub _next_display_order {
 105     unless ($order) {
 106       my ($row) = BSE::DB->query("bse_MaxArticleDisplayOrder");
 107       $order = $row->{displayOrder} + 1;
 108     }
 109
 110     return $order++;
 111   }
 112 }
 113
 114 sub bse_cfg {
 115   my $cfg = BSE::Cfg->new;
 116   $cfg->entry('site', 'url')
 117     or confess "Could not load configuration";
 118
 119   return $cfg;
 120 }
 121
 122 sub bse_make_product {
 123   my (%opts) = @_;
 124
 125   my $cfg = delete $opts{cfg}
 126     or confess "cfg option missing";
 127
 128   require Products;
 129
 130   defined $opts{title} && length $opts{title}
 131     or confess "Missing title option\n";
 132   defined $opts{body} && length $opts{body}
 133     or confess "Missing body option\n";
 134   defined $opts{retailPrice} && $opts{retailPrice} =~ /^\d+$/
 135     or confess "Missing or invalid retailPrice\n";
 136
 137   $opts{summary} ||= $opts{title};
 138   $opts{description} ||= $opts{title};
 139   unless ($opts{displayOrder}) {
 140     $opts{displayOrder} = _next_display_order();
 141   }
 142
 143   %opts =
 144     (
 145      %acticle_defaults,
 146      %product_defaults,
 147      %opts
 148     );
 149
 150   _set_dynamic($cfg, \%opts);
 151
 152   my @cols = Product->columns;
 153   shift @cols;
 154   my $product = Products->add(@opts{@cols});
 155
 156   require BSE::Edit::Product;
 157   _finalize_article($cfg, $product, 'BSE::Edit::Product');
 158
 159   return $product;
 160 }
 161
 162 sub bse_make_catalog {
 163   my (%opts) = @_;
 164
 165   my $cfg = delete $opts{cfg}
 166     or confess "cfg option missing";
 167
 168   require Articles;
 169
 170   defined $opts{title} && length $opts{title}
 171     or confess "Missing title option\n";
 172   defined $opts{body} && length $opts{body}
 173     or confess "Missing body option\n";
 174
 175   $opts{summary} ||= $opts{title};
 176   unless ($opts{displayOrder}) {
 177     $opts{displayOrder} = _next_display_order();
 178   }
 179
 180   %opts =
 181     (
 182      %acticle_defaults,
 183      %catalog_defaults,
 184      %opts
 185     );
 186
 187   _set_dynamic($cfg, \%opts);
 188
 189   my @cols = Article->columns;
 190   shift @cols;
 191   my $catalog = Articles->add(@opts{@cols});
 192
 193   require BSE::Edit::Catalog;
 194   _finalize_article($cfg, $catalog, 'BSE::Edit::Catalog');
 195
 196   return $catalog;
 197 }
 198
 199 my %other_parent_defaults =
 200   (
 201    release => sql_datetime(time - 86_400),
 202    expire => '2999-12-31',
 203   );
 204
 205 sub bse_add_step_child {
 206   my (%opts) = @_;
 207
 208   my $cfg = delete $opts{cfg}
 209     or confess "cfg option missing";
 210
 211   require OtherParents;
 212
 213   my $parent = delete $opts{parent}
 214     or confess "parent option missing";
 215   my $child = delete $opts{child}
 216     or confess "child option missing";
 217   %opts =
 218     (
 219      %other_parent_defaults,
 220      parentId => $parent->{id},
 221      childId => $child->{id},
 222      %opts
 223     );
 224   $opts{parentDisplayOrder} ||= _next_display_order();
 225   $opts{childDisplayOrder} ||= _next_display_order();
 226
 227   my @cols = OtherParent->columns;
 228   shift @cols;
 229
 230   return OtherParents->add(@opts{@cols});
 231 }
 232
 233 sub bse_encoding {
 234   my ($cfg) = @_;
 235
 236   $cfg && $cfg->can('entry')
 237     or confess "bse_encoding: Missing cfg parameter\n";
 238
 239   return $cfg->entry('html', 'charset', 'iso-8859-1');
 240 }
 241
 242 sub bse_add_image {
 243   my ($cfg, $article, %opts) = @_;
 244
 245   my $editor;
 246   ($editor, $article) = _load_editor_class($article, $cfg);
 247
 248   my %image;
 249   my $file = delete $opts{file};
 250   $file
 251     or croak "Missing image filename";
 252   open IN, "< $file"
 253     or croak "Failed opening image file $file: $!";
 254   binmode IN;
 255   my %errors;
 256
 257   $editor->do_add_image
 258     (
 259      $cfg,
 260      $article,
 261      *IN,
 262      %opts,
 263      errors => \%errors,
 264      filename => $file,
 265     );
 266 }
 267
 268 sub _load_editor_class {
 269   my ($article, $cfg) = @_;
 270
 271   require BSE::Edit::Base;
 272   return BSE::Edit::Base->article_class($article, 'Articles', $cfg);
 273 }
 274
 275 # File::Copy doesn't like CGI.pm's fake fhs
 276 sub _copy_file_from_fh {
 277   my ($in_fh, $out_fh) = @_;
 278
 279   binmode $out_fh;
 280   binmode $in_fh;
 281   seek $in_fh, 0, SEEK_SET;
 282   my $data;
 283   local $/ = \8192;
 284   while (defined ($data = <$in_fh>)) {
 285     print $out_fh $data;
 286   }
 287
 288   1;
 289 }
 290
 291 sub bse_add_owned_file {
 292   my ($cfg, $owner, %opts) = @_;
 293
 294   defined $opts{display_name} && $opts{display_name} =~ /\S/
 295     or croak "bse_add_owned_file: display_name must be non-blank";
 296
 297   defined $opts{title} && $opts{title} =~ /\S/
 298     or $opts{title} = $opts{display_name};
 299
 300   unless ($opts{content_type}) {
 301     require BSE::Util::ContentType;
 302     $opts{content_type} = BSE::Util::ContentType::content_type($cfg, $opts{display_name});
 303   }
 304
 305   my $file = delete $opts{file}
 306     or die "No source file provided\n";;
 307
 308   # copy the file to the right place
 309   require DevHelp::FileUpload;
 310   my $file_dir = $cfg->entryVar('paths', 'downloads');
 311   my $msg;
 312   my ($saved_name, $out_fh) = DevHelp::FileUpload->
 313     make_img_filename($file_dir, $opts{display_name}, \$msg)
 314     or die "$msg\n";
 315   _copy_file_from_fh($file, $out_fh)
 316     or die "$!\n";
 317   unless (close $out_fh) {
 318     die "Error saving file: $!\n";
 319   }
 320
 321   $opts{owner_type} = $owner->file_owner_type;
 322   $opts{size_in_bytes} = -s "$file_dir/$saved_name";
 323   $opts{owner_id} = $owner->id;
 324   $opts{category} ||= '';
 325   $opts{filename} = $saved_name;
 326
 327   require BSE::TB::OwnedFiles;
 328   my $result = BSE::TB::OwnedFiles->make(%opts);
 329
 330   if ($cfg->entry('notify_files', 'active', 0)) {
 331     BSE::DB->run(bseAddOwnedFileNotification => $result->id, $owner->file_owner_type, $owner->id);
 332   }
 333
 334   return $result;
 335 }
 336
 337 sub bse_delete_owned_file {
 338   my ($cfg, $owned_file) = @_;
 339
 340   my $file_dir = $cfg->entryVar('paths', 'downloads');
 341   unlink "$file_dir/$owned_file->{filename}";
 342   $owned_file->remove;
 343 }
 344
 345 sub bse_replace_owned_file {
 346   my ($cfg, $owned_file, %opts) = @_;
 347
 348   my $file_dir = $cfg->entryVar('paths', 'downloads');
 349   my $old_name;
 350   if ($opts{file}) {
 351     my $msg;
 352     require DevHelp::FileUpload;
 353     my ($saved_name, $out_fh) = DevHelp::FileUpload->
 354       make_img_filename($file_dir, $opts{display_name}, \$msg)
 355         or die "$msg\n";
 356     _copy_file_from_fh($opts{file}, $out_fh)
 357         or die "$!\n";
 358     unless (close $out_fh) {
 359       die "Error saving file: $!\n";
 360     }
 361     $old_name = $owned_file->{filename};
 362     $owned_file->{filename} = $saved_name;
 363     $owned_file->{size_in_bytes} = -s "$file_dir/$saved_name";
 364   }
 365
 366   for my $field (qw/category display_name content_type download title body modwhen size_in_bytes/) {
 367     defined $opts{$field}
 368       and $owned_file->{$field} = $opts{$field};
 369   }
 370   $owned_file->save;
 371   $old_name
 372     and unlink "$file_dir/$old_name";
 373
 374   1;
 375 }
 376
 377 1;