view release on metacpan or  search on metacpan

lib/SWF/NeedsRecompile.pm  view on Meta::CPAN

         {
            _log(2, "do deps for $checkfile");
            $depends{$checkfile} = [];
            my $content = File::Slurp::read_file($checkfile);
            my %imported_files;
            my %seen;

            if ($checkfile =~ m/[.]fla\z/ixms)
            {
               # HACK: use C regexp because the ECMAScript regexp can
               # cause an infinite loop on some .fla files.
               # See BUGS AND LIMITATIONS
               $content =~ s/$RE{comment}{C}//gxms;
            }
            else
            {
               $content =~ s/$RE{comment}{ECMAScript}//gxms;
            }

            # check for include and import statements and instantiations via "new"
            my @deps = (
               _get_includes($checkfile, \$content, \%seen),
               _get_imports($checkfile, \$content, \@paths, \%imported_files, \%seen),
               _get_instantiations($checkfile, \$content, \@paths, \%imported_files, \%seen),
            );
            my @problems = map { @{$_} } grep { ref $_ } @deps;
            if (@problems > 0)
            {
               _log(1, "Failed to locate dependencies in $checkfile: @problems");
               $up_to_date = 0;
               last;
            }
            $depends{$checkfile} = \@deps;
         }
         push @check, @{$depends{$checkfile}};
      }

      if (!$up_to_date)
      {
         push @needs_recompile, $file;
      }
   }
   return @needs_recompile;
}

sub _get_fla_classpaths
{
   my $fla = shift;

   my @paths;
   if (-f $fla && (my $content = File::Slurp::read_file($fla, binmode => ':raw')))
   {
      # Limitation: the path must be purely ASCII or this doesn't work
      my @matches = $content =~ m/V\0e\0c\0t\0o\0r\0:\0:\0P\0a\0c\0k\0a\0g\0e\0[ ]\0P\0a\0t\0h\0s\0....((?:[^\0]\0)*)/gxms;
      my %seen;
      for my $match (@matches)
      {
         # Hack: downgrade unicode to ascii
         $match =~ s/\0//gxms;
         next if q{} eq $match;
         my @search_paths = split m/;/xms, $match;
         require File::Spec;
         for my $path (@search_paths)
         {
            if (!File::Spec->file_name_is_absolute($path))
            {
               my $root = [File::Spec->splitpath($fla)]->[1];
               if ($root)
               {
                  $path = File::Spec->rel2abs($path, $root);
               }
            }
            next if ($seen{$path}++);
            push @paths, $path;
         }
      }
      _log(2, "FLA Paths: @paths");
   }
   return @paths;
}

sub _get_includes
{
   my $checkfile   = shift;
   my $content_ref = shift;
   my $seen_ref    = shift;

   my @deps;

   # Check both ascii and ascii-unicode, supporting Flash MX and 2004 .fla files
   # This will fail for non-ascii filenames
   my @matches = ${$content_ref} =~ m/\#\0?i\0?n\0?c\0?l\0?u\0?d\0?e\0?(?:\s\0?)+["]\0?([^"\r\n]+?)["]/gxms; ## no critic (EscapedMeta)
   foreach my $inc (@matches)
   {
      next if ($seen_ref->{$inc}++); # speedup
      # This is a hack.  Strip real Unicode down to ASCII
      $inc =~ s/\0//gxms;
      if ($inc)
      {
         my $file = $inc;
         if (! -f $file)
         {
            if (! File::Spec->file_name_is_absolute($file))
            {
               my $dir = [File::Spec->splitpath($checkfile)]->[1];
               if ($dir)
               {
                  $file = File::Spec->rel2abs($file, $dir);
               }
            }
            return [$inc] if (! -f $file);
         }
         push @deps, $file;
         _log(2, "#include $inc from $checkfile");
      }
   }
   return @deps;
}

sub _get_imports
{
   my $checkfile         = shift;
   my $content_ref       = shift;
   my $fla_path_ref      = shift;
   my $imported_file_ref = shift;
   my $seen_ref          = shift;

   my @deps;
   my @matches = ${$content_ref} =~ m/i\0?m\0?p\0?o\0?r\0?t\0?(?:\s\0?)+((?:[^\;\0\s]\0?)+);/gxms;
   foreach my $imp (@matches)
   {
      next if ($seen_ref->{$imp}++);    # speedup
      # This is a hack.  Strip real Unicode down to ASCII
      $imp =~ s/\0//gxms;
      _log(2, "import $imp from $checkfile");
      my $found = 0;
      foreach my $dir (@{$fla_path_ref}, as_classpath())
      {
         my $f = File::Spec->catdir(File::Spec->splitdir($dir), split m/[.]/xms, $imp);
         if ($f =~ m/[*]\z/xms)
         {
            my @d = File::Spec->splitdir($f);
            pop @d;
            $f = File::Spec->catdir(@d);
            if (-d $f)
            {
               my @as = grep { m/[.]as\z/xms } File::Slurp::read_dir($f);

               for my $file (@as)
               {
                  $imported_file_ref->{$file} = 1;
               }
               @as = map { File::Spec->catfile($f, $_) } @as;

               for my $file (@as)
               {
                  _log(2, "  import $file from $checkfile");
               }
               push @deps, @as;
            }
            $found = 1;
         }
         else
         {
            $f .= '.as';
            if (-f $f)
            {
               my @p = split m/[.]/xms, $imp;
               $imported_file_ref->{$p[-1] . '.as'} = 1;
               _log(2, "  import $f from $checkfile");
               push @deps, $f;
               $found = 1;
               last;
            }
         }
      }
      return [$imp] if (!$found);
   }
   return @deps;
}

sub _get_instantiations
{
   my $checkfile         = shift;
   my $content_ref       = shift;
   my $fla_path_ref      = shift;
   my $imported_file_ref = shift;
   my $seen_ref          = shift;

   # Get a list of all classes defined in this file
   my @classes;
   my @class_matches = ${$content_ref} =~ m/c\0?l\0?a\0?s\0?s\0?(?:\s\0?)+((?:[^;\s\0]\0?)+)/gxms;
   for my $class_match (@class_matches)
   {
      $class_match =~ s/\0//gxms;
      push @classes, $class_match;
   }

   my @deps;
   my @matches = ${$content_ref} =~ m/n\0?e\0?w\0?(?:\s\0?)+((?:[\w.]\0?)+)[(]/gxms;
   foreach my $imp (@matches)
   {
      next if ($seen_ref->{$imp}++); # speedup
      # This is a hack.  Strip real Unicode down to ASCII
      $imp =~ s/\0//gxms;
      next if ($exceptions{$imp});
      _log(2, "instance $imp from $checkfile");
      next if ($imported_file_ref->{$imp . '.as'});
      # Is this class implemented in this very file?
      next if any { $_ eq $imp || m/[.]\Q$imp\E\z/xms } @classes;
      my $found = 0;
      foreach my $dir (@{$fla_path_ref}, as_classpath())
      {
         my $f = File::Spec->catdir(File::Spec->splitdir($dir), split m/[.]/xms, $imp);
         $f .= '.as';
         if (-f $f)
         {
            _log(2, "  instance $f from $checkfile");
            push @deps, $f;
            $found = 1;
            last;
         }
      }
      return [$imp] if (!$found);
   }
   return @deps;
}

=item $pkg->as_classpath()

Returns a list of Classpath directories specified globally in Flash.

=cut

sub as_classpath
{
   if (!$cached_as_classpath)
   {
      my $prefs_file = flash_prefs_path();
      if (!$prefs_file || ! -f $prefs_file)
      {
         #_log(2, 'Failed to locate the Flash prefs file');
         return q{.};
      }

      my $conf_dir = flash_config_path();
      for (File::Slurp::read_file($prefs_file))
      {
         if (m/<Package_Paths>(.*?)<\/Package_Paths>/xms)
         {
            my $cp = $1;
            my @dirs = split /;/xms, $cp;
            for (@dirs)
            {
               if (!$conf_dir)
               {
                  _log(2, "Failed to identify the UserConfig dir for '$_'");
               }
               else
               {
                  s/[$][(]UserConfig[)]/$conf_dir/xms;
               }
            }
            $cached_as_classpath = \@dirs;
            _log(2, "Classpath: @{$cached_as_classpath}");
            last;
         }
      }
   }
   return @{$cached_as_classpath};
}

=item $pkg->flash_prefs_path()