Generator.pm 1.3 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849
  1. package Logos::Generator;
  2. use strict;
  3. use Logos::Generator::Thunk;
  4. use Scalar::Util qw(blessed);
  5. use Module::Load::Conditional qw(can_load);
  6. $Module::Load::Conditional::VERBOSE = 1;
  7. our $GeneratorPackage = "";
  8. my %cache;
  9. sub for {
  10. my $object = shift;
  11. my $dequalified = undef;
  12. my $cachekey;
  13. if(defined $object) {
  14. $cachekey = $object;
  15. my $class = blessed($object);
  16. ($dequalified = $class) =~ s/.*::// if defined $class
  17. }
  18. $cachekey = "-" if !$cachekey;
  19. $dequalified .= "Generator" if !defined $dequalified;
  20. return $cache{$cachekey} if $cache{$cachekey};
  21. my $qualified = $GeneratorPackage."::".$dequalified;
  22. my $fallback = "Logos::Generator::Base::".$dequalified;
  23. my $shouldFallBack = 0;
  24. can_load(modules=>{$qualified=>undef},verbose=>0) || ($shouldFallBack = 1);
  25. can_load(modules=>{$fallback=>undef},verbose=>1) if $shouldFallBack;
  26. my $thunk = Logos::Generator::Thunk->for(($shouldFallBack ? $fallback : $qualified), $object);
  27. $cache{$cachekey} = $thunk;
  28. return $thunk;
  29. }
  30. sub use {
  31. my $generatorName = shift;
  32. if($generatorName =~ /^(\w+)@(.+)$/) {
  33. $generatorName = $1;
  34. unshift @INC, $2;
  35. }
  36. $GeneratorPackage = "Logos::Generator::".$generatorName;
  37. ::fileError(-1, "I can't find the $generatorName Generator!") if(!can_load(modules => {
  38. $GeneratorPackage."::Generator" => undef
  39. }));
  40. }
  41. 1;